Changes On Branch 5aa764a7959cbf9b
Not logged in

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

Changes In Branch core-8-branch Through [5aa764a795] Excluding Merge-Ins

This is equivalent to a diff from 725330314f to 5aa764a795

2020-11-16
12:55
Merge 8.6 check-in: 855fa5fea3 user: jan.nijtmans tags: core-8-branch
11:05
Merge 8.7 check-in: dc11880006 user: jan.nijtmans tags: trunk, main
10:53
TIP #586 implementation: C String Parsing Support for binary scan check-in: 5aa764a795 user: jan.nijtmans tags: core-8-branch
10:06
Merge 8.6 check-in: c2dc6753fa user: dkf tags: core-8-branch
2020-10-30
15:13
Merge 8.7 Closed-Leaf check-in: 2c1ee70bdc user: jan.nijtmans tags: tip-586-binary-scan-c-string
2020-09-25
12:10
Merge 8.7 check-in: cfcf76d616 user: jan.nijtmans tags: trunk
2020-09-22
12:25
Merge trunk. Use utf-8 explicitly when reading/writing script files check-in: 73bbb847d6 user: jan.nijtmans tags: tip-587
12:20
Merge 8.7 check-in: 725330314f user: jan.nijtmans tags: trunk
12:18
When writing script files (like pkgIndex.tcl), always use -translation lf, so they don't cause prob... check-in: 2edbd187f0 user: jan.nijtmans tags: core-8-branch
2020-09-20
21:44
Merge 8.7 check-in: 2d03f95be1 user: jan.nijtmans tags: trunk

Added .github/workflows/linux-build.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
name: Linux Build and Test
on: [push]
jobs:
  gcc:
    runs-on: ubuntu-latest
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
          - "all"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Configure (symbols=${{ matrix.symbols }})
        run: |
          mkdir "${HOME}/install dir"
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-symbols=${{ matrix.symbols }}
      - name: Prepare
        run: touch tclStubInit.c tclOOStubInit.c
        working-directory: generic
      - name: Build
        run: |
          make all
      - name: Build Test Harness
        run: |
          make tcltest
      - name: Run Tests
        run: |
          make test
      - name: Test-Drive Installation
        run: |
          make install
      - name: Create Distribution Package
        run: |
          make dist
      - name: Convert Documentation to HTML
        run: |
          make html-tcl
Added .github/workflows/mac-build.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
name: macOS Build and Test
on: [push]
jobs:
  with-Xcode:
    runs-on: macos-latest
    defaults:
      run:
        shell: bash
        working-directory: macosx
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Prepare
        run: touch tclStubInit.c tclOOStubInit.c
        working-directory: generic
      - name: Build
        run: make all
      - name: Run Tests
        run: make test styles=develop
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
  Unix-like:
    runs-on: macos-latest
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
        dtrace:
          - "no"
          - "yes"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c
          mkdir "$HOME/install dir"
        working-directory: generic
      - name: Configure (symbols=${{ matrix.symbols }} dtrace=${{ matrix.dtrace }})
        # Note that macOS is always a 64 bit platform
        run: ./configure --enable-64bit ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-symbols=${{ matrix.symbols }} --enable-dtrace=${{ matrix.dtrace }}
      - name: Build
        run: |
          make all tcltest
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
      - name: Trial Installation
        run: |
          make install
Added .github/workflows/win-build.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
name: Windows Build and Test
on: [push]
jobs:
  MSVC:
    runs-on: windows-latest
    defaults:
      run:
        shell: powershell
        working-directory: win
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Init MSVC
        uses: ilammy/msvc-dev-cmd@v1
      - name: Build
        run: |
          &nmake -f makefile.vc all
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Build Test Harness
        run: |
          &nmake -f makefile.vc tcltest
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Run Tests
        run: |
          &nmake -f makefile.vc test
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        env:
          ERROR_ON_FAILURES: 1
          CI_BUILD_WITH_MSVC: 1
  MSYS-gcc:
    runs-on: windows-latest
    defaults:
      run:
        shell: bash
        working-directory: win
    strategy:
      matrix:
        symbols:
          - "no"
          - "mem"
          - "all"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/checkout@v2
      - name: Install MSYS2 and Make
        run: choco install msys2 make
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c
          mkdir "${HOME}/install dir"
        working-directory: generic
      - name: Configure (symbols=${{ matrix.symbols }})
        run: |
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-64bit --enable-symbols=${{ matrix.symbols }}
      - name: Build
        run: make all
      - name: Build Test Harness
        run: make tcltest
      - name: Run Tests
        run: make test
        env:
          ERROR_ON_FAILURES: 1

# If you add builds with Wine, be sure to define the environment variable
# CI_USING_WINE when running them so that broken tests know not to run.
Changes to .project.
1
2
3
4
5
6
7












8
9



10
11
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl9</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>












	</buildSpec>
	<natures>



	</natures>
</projectDescription>


|




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


>
>
>


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl8</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>
		<buildCommand>
			<name>org.eclipse.cdt.managedbuilder.core.genmakebuilder</name>
			<triggers>clean,full,incremental,</triggers>
			<arguments>
			</arguments>
		</buildCommand>
		<buildCommand>
			<name>org.eclipse.cdt.managedbuilder.core.ScannerConfigBuilder</name>
			<triggers>full,incremental,</triggers>
			<arguments>
			</arguments>
		</buildCommand>
	</buildSpec>
	<natures>
		<nature>org.eclipse.cdt.core.cnature</nature>
		<nature>org.eclipse.cdt.managedbuilder.core.managedBuildNature</nature>
		<nature>org.eclipse.cdt.managedbuilder.core.ScannerConfigNature</nature>
	</natures>
</projectDescription>
Changes to .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
language: c
addons:
  apt:


    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 with various compilers
    - 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"



>
>










|






|





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
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=4"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=4
    - name: "Linux/GCC/Shared: NO_DEPRECATED"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107







108
109
110
111
112
113
114
    - name: "Linux/G++/Shared"
      os: linux
      dist: focal
      compiler: g++
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register"
# Older versions of GCC...
    - name: "Linux/GCC 7/Shared"
      os: linux
      dist: focal
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 6/Shared"
      os: linux
      dist: bionic
      compiler: gcc-6
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-6
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 5/Shared"
      os: linux
      dist: bionic
      compiler: gcc-5
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-5
      env:
        - BUILD_DIR=unix
# 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







|
|


|


<
<

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








<
<




|






>
>
>
>
>
>
>







59
60
61
62
63
64
65
66
67
68
69
70
71
72


73
74












75
76
77
78
79
80
81
82


83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
    - 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/Shared:NO_DEPRECATED"
      os: linux
      dist: xenial
      compiler: clang
      env:
        - BUILD_DIR=unix
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
    - name: "Linux/Clang/Static"
      os: linux
      dist: focal
      compiler: clang
      env:
        - CFGOPT="--disable-shared"
        - BUILD_DIR=unix
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163








164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
      os: linux
      dist: focal
      compiler: clang
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"
# Testing on Mac, various styles
    - name: "macOS/Clang/Xcode 11.7/Shared"
      os: osx
      osx_image: xcode11.7
      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 11.7/Shared/Unix-like"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix

    - name: "macOS/Clang/Xcode 11.7/Shared/libtommath"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
      addons:
        homebrew:
          packages:
            - libtommath
    - name: "macOS/Clang++/Xcode 11.7/Shared"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=clang++ --enable-framework CFLAGS=-Dregister=dont+use+register CPPFLAGS=-D__private_extern__=extern"
      script:
        - make all tcltest








# Older MacOS versions
    - name: "macOS/Clang/Xcode 11/Shared"
      os: osx
      osx_image: xcode11
      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.2
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
    - name: "macOS/Clang/Xcode 8/Shared"
      os: osx
      osx_image: xcode8.3







|

|







|

|


>
|

|








|

|


|


>
>
>
>
>
>
>
>



|













|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
      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
218
219
220
221
222
223
224


225
226
227
228
229
230









231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248









249
250
251
252
253
254
255
    - 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


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







>
>






>
>
>
>
>
>
>
>
>


















>
>
>
>
>
>
>
>
>







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    - 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: UTF_MAX=4"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=utfmax' '-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/StaticPackage"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,staticpkg,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
270
271
272
273
274
275
276









277
278
279
280
281
282
283
      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:







>
>
>
>
>
>
>
>
>







292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
      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: UTF_MAX=4"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=utfmax' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
314
315
316
317
318
319
320


321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst


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







>
>


|




|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
    - 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=4"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=4"
      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"
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
# 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"







|




|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
# 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=4"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_UTF_MAX=4"
      before_install: *makepreinst
    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
421
422
423
424
425
426
427


428
429
430
431
432
433
434
435
436
437
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:


  - 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
  - make test
  - make install







>
>







|


454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
      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.2001.
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 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:







|







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







|







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

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







|







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







|







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







|







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.
	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 README.md.
1
2
3
4
5
6
7











8


9
10
11
12
13
14
15
# README:  Tcl

This is the **Tcl 9.0a2** 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)



## Contents
 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)


|




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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# README:  Tcl

This is the **Tcl 8.7a4** source distribution.

You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).

8.6.10
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-6-branch)
<br>
8.7a4
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Acore-8-branch)
<br>
9.0a2
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows+Build+and+Test%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS%20Build%20and%20Test/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS+Build+and+Test%22+branch%3Amain)

## 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
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).
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/).

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







|









|
|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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/8.7.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 8.7 is [online,
here](https://www.tcl-lang.org/man/tcl8.7/).

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







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
9116
9117
9118
9119
9120
9121
9122




















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 compat/opendir.c.
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));
    if (dirp == NULL) {
	/* unreachable? */
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;







|







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 *) 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
void
closedir(
    DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    Tcl_Free(dirp);
}







|

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;
    ckfree(dirp);
}
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
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 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 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);







<

<
<
<

|





|







17
18
19
20
21
22
23

24



25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 * 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>


extern void *		memchr(const void *s, int c, size_t n);



extern int		memcmp(const void *s1, const void *s2, size_t n);
extern void *		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 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);
Changes to compat/waitpid.c.
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);
	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







|







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;
	}
	ckfree(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
    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->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;
    }
}







|









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 *) ckalloc(sizeof(WaitInfo));
	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;
    }
}
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
'\"
'\" 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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_GetReturnOptions\fR(\fIinterp, code\fR)
.sp
int
\fBTcl_SetReturnOptions\fR(\fIinterp, options\fR)
.sp
\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
.sp
\fBTcl_AppendObjToErrorInfo\fR(\fIinterp, objPtr\fR)
.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)
.sp
const char *
\fBTcl_PosixError\fR(\fIinterp\fR)











|



















>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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) 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_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_GetReturnOptions\fR(\fIinterp, code\fR)
.sp
int
\fBTcl_SetReturnOptions\fR(\fIinterp, options\fR)
.sp
\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
.sp
\fBTcl_AppendObjToErrorInfo\fR(\fIinterp, objPtr\fR)
.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_SetErrorCodeVA\fR(\fIinterp, argList\fR)
.sp
\fBTcl_GetErrorLine\fR(\fIinterp\fR)
.sp
\fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR)
.sp
const char *
\fBTcl_PosixError\fR(\fIinterp\fR)
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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.
.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.
.AP size_t 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.
.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







|


|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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.
.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.
.AP int length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
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
238
239
240
241
242
243
244






245
246
247
248
249
250
251
\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
\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
sets the \fB\-errorline\fR return option value.
.PP
\fBTcl_PosixError\fR







>
>
>
>
>
>







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
\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
\fBTcl_SetObjErrorCode\fR in behavior.
.PP
\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
instead of taking a variable number of arguments it takes an argument list.
Interfaces using argument lists have been found to be nonportable in practice.
This function is deprecated and will be removed in Tcl 9.0.

.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
sets the \fB\-errorline\fR return option value.
.PP
\fBTcl_PosixError\fR
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
'\"
'\" 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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char *
\fBTcl_Alloc\fR(\fIsize\fR)
.sp
void
\fBTcl_Free\fR(\fIptr\fR)
.sp
void *
\fBTcl_Realloc\fR(\fIptr, size\fR)
.sp
void *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
.sp






void *



\fBTcl_AttemptRealloc\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.
.BE










|










|


|


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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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) 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, 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
char *
\fBTcl_Realloc\fR(\fIptr, size\fR)
.sp
char *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
.sp
char *
\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
.sp
char *
\fBckalloc\fR(\fIsize\fR)
.sp
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.
.BE
60
61
62
63
64
65
66




67
68
69
70


71
72
73
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




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.



.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG







>
>
>
>
|
<
<
|
>
>



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


87
88
89
90
91
92
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
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.

.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG
Changes to doc/AllowExc.3.
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
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.

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







|
>







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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, \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.
Changes to doc/AssocData.3.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
.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 *
\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
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







|

















|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
.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
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 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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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,
        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







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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(
        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
Changes to doc/Async.3.
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
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.







|







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 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.
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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,
        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.







|







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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(
        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.
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/ByteArrObj.3.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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
even if \fIlength\fR is non-zero.
.AP size_t length in
The length of the array of bytes.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value 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.
.AP int *lengthPtr out







|
|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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
even if \fIlength\fR is non-zero.
.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
byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value 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.
.AP int *lengthPtr out
Changes to doc/CallDel.3.
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
\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
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,
        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







|














|







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
\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 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(
        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
Changes to doc/Cancel.3.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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 ClientData 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
Changes to doc/ChnlStack.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
59
60
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
.AP "const Tcl_ChannelType" *typePtr in
The new channel I/O procedures to use for \fIchannel\fR.
.AP void *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 \fBTcl_ChannelType\fR version currently supported is

\fBTCL_CHANNEL_VERSION_5\fR.  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







|
















>
>
|
>
|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
.AP "const Tcl_ChannelType" *typePtr in
The new channel I/O procedures to use for \fIchannel\fR.
.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
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
Changes to doc/Class.3.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
.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.







|




|









|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
.sp
Tcl_Object
\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
.sp
int
\fBTcl_ObjectDeleted\fR(\fIobject\fR)
.sp
ClientData
\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
.sp
\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
.sp
ClientData
\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 ClientData 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.
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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







|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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 ClientData 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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
.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







|












|
|







181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
.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(
        ClientData \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,
        ClientData \fIsrcMetadata\fR,
        ClientData *\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
Changes to 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
'\"
'\" 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










|













>
>
>
>
>
>



>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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) 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_CreateSlave, Tcl_GetChild, Tcl_GetSlave, Tcl_GetParent, 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_CreateChild\fR(\fIinterp, name, isSafe\fR)
.sp
Tcl_Interp *
\fBTcl_CreateSlave\fR(\fIinterp, name, isSafe\fR)
.sp
Tcl_Interp *
\fBTcl_GetSlave\fR(\fIinterp, name\fR)
.sp
Tcl_Interp *
\fBTcl_GetChild\fR(\fIinterp, name\fR)
.sp
Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
Tcl_Interp *
\fBTcl_GetParent\fR(\fIinterp\fR)
.sp
int
\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
.sp
int
129
130
131
132
133
134
135


136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155


156
157
158
159


160
161
162
163
164
165
166
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.







>
>




















>
>




>
>







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
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_CreateSlave\fR is a synonym for \fBTcl_CreateChild\fR.
.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_GetSlave\fR is a synonym for \fBTcl_GetChild\fR.
.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_GetMaster\fR is a synonym for \fBTcl_GetParent\fR.
.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.
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
'\"
'\" 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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Channel
\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
.sp
void *
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
const Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)











|







|







1
2
3
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) 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_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
ClientData
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
const Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)
71
72
73
74
75
76
77



78
79
80
81
82
83
84
85
86



87
88
89
90
91
92
93
.sp
Tcl_ChannelTypeVersion
\fBTcl_ChannelVersion\fR(\fItypePtr\fR)
.sp
Tcl_DriverBlockModeProc *
\fBTcl_ChannelBlockModeProc\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_DriverWideSeekProc *
\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverThreadActionProc *
\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverTruncateProc *







>
>
>









>
>
>







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
.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
Tcl_DriverTruncateProc *
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
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
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
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
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







|










|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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
of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR),
the assigned channel name will be the name of the standard channel.
.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 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
276
277
278
279
280
281
282
283

284
285
286
287
288


289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
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.
Also notifies the driver if

\fBTcl_DriverThreadActionProc\fR is defined for it.
.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.


Also notifies the driver if \fBTcl_DriverThreadActionProc\fR is defined for it.
.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;
        Tcl_ChannelTypeVersion \fIversion\fR;
        void *\fIcloseProc\fR; /* Not used any more*/
        Tcl_DriverInputProc *\fIinputProc\fR;
        Tcl_DriverOutputProc *\fIoutputProc\fR;
        void *\fIseekProc\fR; /* Not used any more */
        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;







|
>





>
>
|



















|


|







282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
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.
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.
.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.
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.
.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;
        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;
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348
349
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_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR,
\fBTcl_ChannelTruncateProc\fR,
\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







|
>
|







343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
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_ChannelCloseProc\fR,
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
\fBTcl_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR,
\fBTcl_ChannelTruncateProc\fR,
\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
358
359
360
361
362
363
364
365











366
367





368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
.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.











.PP
This value can be retrieved with \fBTcl_ChannelVersion\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,
        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







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

|
>
>
>
>
>








|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
.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_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).
\fBTCL_CHANNEL_VERSION_5\fR must be set to specify the
\fItruncateProc\fR members (includes
\fIwideSeekProc\fR and \fIthreadActionProc\fR).
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, which returns
one of
\fBTCL_CHANNEL_VERSION_5\fR,
\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(
        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
.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"
.PP
The \fIclose2Proc\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:
.PP
.CS
typedef int \fBTcl_DriverClose2Proc\fR(
        void *\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
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
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.
.PP

The \fIclose2Proc\fR value can be retrieved with \fBTcl_ChannelClose2Proc\fR,
which returns a pointer to the 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,
        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







|

|

|


|
|
|
<


|
|
|
|








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




|
>
>
>
>
|
|
|
|

>
|
|








|







422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
.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 "CLOSEPROC AND CLOSE2PROC"
.PP
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. \fICloseProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverCloseProc\fR(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR);

.CE
.PP
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 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 \fBTcl_DriverClose2Proc\fR(
        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.  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
\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(
        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
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
.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,
        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







|







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
.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(
        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
.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"
.PP
The \fIwideSeekProc\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
prototype:
.PP
.CS
typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
        void *\fIinstanceData\fR,
        Tcl_WideInt \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




















The \fIwideSseekProc\fR value can be retrieved with


\fBTcl_ChannelWideSeekProc\fR, which returns a pointer to the function.
.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,
        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







|

|

|



|
|
|


















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








|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
.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 "SEEKPROC AND WIDESEEKPROC"
.PP
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. \fISeekProc\fR must match the following
prototype:
.PP
.CS
typedef int \fBTcl_DriverSeekProc\fR(
        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 \fBTcl_DriverWideSeekProc\fR(
        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 \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(
        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
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
.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,
        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







|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
.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(
        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
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
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,
        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







|







697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
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(
        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
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
.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,
        int \fIdirection\fR,
        void **\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.







|

|







728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
.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(
        ClientData \fIinstanceData\fR,
        int \fIdirection\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.
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
.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);
.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,
        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.







|














|







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
.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(
        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(
        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.
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 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);
.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,
        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







|
















|







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
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(
        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(
        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
804
805
806
807
808
809
810




















































811
812
813
814
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 "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







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




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
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 {
    const 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;
} \fBTcl_ChannelType\fR;
.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 {
    const 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;
} \fBTcl_ChannelType\fR;
.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
.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
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,
        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







|















|







28
29
30
31
32
33
34
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 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(
        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
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
.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
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);
.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







|











|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
.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 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(
        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
Changes to doc/CrtCommand.3.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
.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
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







|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
.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 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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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,
        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







|







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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(
        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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\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);
.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
.SH KEYWORDS
bind, command, create, delete, interpreter, namespace







|









127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\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(
        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
.SH KEYWORDS
bind, command, create, delete, interpreter, namespace
Changes to doc/CrtFileHdlr.3.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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
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







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
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 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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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,
        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







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
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(
        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
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
157
158
159
160
161
162
'\"
'\" 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 "NOTICE OF EVENTUAL DEPRECATION"
.PP
The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
are rendered somewhat obsolete by the ability to create functions for
expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
as described in the \fBmathfunc\fR manual page; the API described on
this page is not expected to be maintained indefinitely.
.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:
.PP
.CS
typedef int \fBTcl_MathProc\fR(
        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:
.PP
.CS
typedef struct Tcl_Value {
    Tcl_ValueType \fItype\fR;
    long \fIintValue\fR;
    double \fIdoubleValue\fR;
    Tcl_WideInt \fIwideValue\fR;
} \fBTcl_Value\fR;
.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 value containing a list of all
the math functions defined in the interpreter whose name matches
\fIpattern\fR.  The returned value 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.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
.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
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.







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
.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 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.
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
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,
        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







|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
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(
        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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
\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);
.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







|







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
\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(
        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
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
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;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
} \fBTcl_CmdInfo\fR;
.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.







|

|

|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
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;
    ClientData \fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    ClientData \fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    ClientData \fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
} \fBTcl_CmdInfo\fR;
.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.
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
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
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.
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
command's deletion procedure to be given a different value than the
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.







|













|















|

|







243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
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
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.
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
command's deletion procedure to be given a different value than the
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.
Changes to doc/CrtTimerHdlr.3.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
\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
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







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
\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 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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
\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);
.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







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
\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(
        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
Changes to doc/CrtTrace.3.
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
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







|







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 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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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,
        \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[]);
.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
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







|










|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
interpreter.
.PP
\fIobjProc\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc\fR:
.PP
.CS
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[]);
.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
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
140
141
142
143
144
145
146
147
148
149
150
151
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 \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);
.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,
        Tcl_Interp *\fIinterp\fR,
        int \fIlevel\fR,
        char *\fIcommand\fR,
        Tcl_CmdProc *\fIcmdProc\fR,
        void *\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







|















|




|







140
141
142
143
144
145
146
147
148
149
150
151
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 \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(
        \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(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIlevel\fR,
        char *\fIcommand\fR,
        Tcl_CmdProc *\fIcmdProc\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
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
'\"
'\" 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
.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
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\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,
add all characters up to null terminating character.
.AP size_t 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












|
















|






>
>














|
|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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_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
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 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 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
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_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







>
>
>
>







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/DoWhenIdle.3.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\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
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







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\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 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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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);
.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







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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(
        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
Changes to doc/DumpActiveMemory.3.
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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
\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
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
at any point.

.SH "SEE ALSO"
TCL_MEM_DEBUG, memory

.SH KEYWORDS
memory, debug







|











|
|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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
\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 \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 \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
'\"
'\" 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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Encoding
\fBTcl_GetEncoding\fR(\fIinterp, name\fR)
.sp










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" 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, 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
32
33
34
35
36
37
38






39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58






59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
\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






const char *
\fBTcl_GetEncodingName\fR(\fIencoding\fR)
.sp
int
\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
.sp
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
.sp
void
\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
.sp
Tcl_Encoding
\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetEncodingSearchPath\fR()
.sp
int
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\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
NULL, the current system encoding is used.
.AP Tcl_Obj *objPtr in
Name of encoding to get token for.
.AP Tcl_Encoding *encodingPtr out
Points to storage where encoding token is to be written.
.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.
.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
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.







>
>
>
>
>
>




















>
>
>
>
>
>

















|



|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
\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
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
.sp
void
\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
.sp
Tcl_Encoding
\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetEncodingSearchPath\fR()
.sp
int
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
.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
NULL, the current system encoding is used.
.AP Tcl_Obj *objPtr in
Name of encoding to get token for.
.AP Tcl_Encoding *encodingPtr out
Points to storage where encoding token is to be written.
.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 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 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.
238
239
240
241
242
243
244












245
246
247
248
249
250
251
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_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
\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
\fIencoding\fR is deleted.  The caller must not modify this string.
.PP







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







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
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
based on the TCHAR type which is by convention a Unicode character on
Windows NT. Those functions are deprecated. You can use
\fBTcl_UtfToWCharDString\fR resp. \fBTcl_WCharToUtfDString\fR as replacement.
If you want compatibility with earlier Tcl releases than 8.7, use
\fBTcl_UtfToUniCharDString\fR resp. \fBTcl_UniCharToUtfDString\fR as
replacement, and make sure you compile your extension with -DTCL_UTF_MAX=3.
Beware: Those replacement functions don't initialize their Tcl_DString (you'll
have to do that yourself), and \fBTcl_UniCharToUtfDString\fR from Tcl 8.6
doesn't accept -1 as length parameter.
.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
\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
\fIencoding\fR is deleted.  The caller must not modify this string.
.PP
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
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.
.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
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







|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
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.
.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_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
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
.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;
.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







|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
.PP
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    ClientData \fIclientData\fR;
    int \fInullSize\fR;
} \fBTcl_EncodingType\fR;
.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
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
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,
        Tcl_EncodingState *\fIstatePtr\fR,
        char *\fIdst\fR,
        int \fIdstLen\fR,
        int *\fIsrcReadPtr\fR,







|







347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
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(
        ClientData \fIclientData\fR,
        const char *\fIsrc\fR,
        int \fIsrcLen\fR,
        int \fIflags\fR,
        Tcl_EncodingState *\fIstatePtr\fR,
        char *\fIdst\fR,
        int \fIdstLen\fR,
        int *\fIsrcReadPtr\fR,
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
procedure will be a non-NULL location.
.PP
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);
.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.
.PP
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR







|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
procedure will be a non-NULL location.
.PP
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
\fBTcl_EncodingFreeProc\fR:
.PP
.CS
typedef void \fBTcl_EncodingFreeProc\fR(
        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.
.PP
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR
380
381
382
383
384
385
386









387
388
389
390
391
392
393
\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.









.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







>
>
>
>
>
>
>
>
>







404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
\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.
.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
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
'\"
'\" 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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR)
.sp












|







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, 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
\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)



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







>
>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
\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.
60
61
62
63
64
65
66



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



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







>
>
>







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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.
118
119
120
121
122
123
124
125




126
127
128


129
130
131
132
133
134
135
136
137
138
139
140
141
142
143





144
145
146
147
148
149
150
\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.




.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
additional arguments \fInumBytes\fR and \fIflags\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.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments.  \fBTcl_VarEval\fR is now 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







|
>
>
>
>


|
>
>















>
>
>
>
>







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
\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.  Note: for backward compatibility with versions before
Tcl 8.0, \fBTcl_Eval\fR copies the value 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.  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.
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. Interfaces using argument lists have been found to be nonportable
in practice. This function is deprecated and will be removed in Tcl 9.0.

.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
Changes to doc/Exit.3.
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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
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







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
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 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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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.
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
exit handler should not return control to Tcl.
.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.







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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.
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 ClientData); the application
exit handler should not return control to Tcl.
.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.
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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);
.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







|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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(
        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
129
130
131
132
133
134
135
136
137
138

139
140
141
142
\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.

.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread







|

|
>




129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\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 ClientData value.
.PP
\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread
Changes to doc/FileSystem.3.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
.sp
int
\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
.sp
int
\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
.sp
void *
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
.sp
int
\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
.sp
int
\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
.sp
ClientData
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
.sp
Tcl_Obj *
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
.sp
void *
\fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR)
.sp
const char *
\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)







|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
.sp
Tcl_Obj *
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
.sp
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)
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
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.
.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 Tcl_Obj *firstPtr in
The first of two path values to compare. The value 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
to \fBpath\fR type.







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
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.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error
messages.
.AP ClientData clientData in
The native description of the path value to create.
.AP Tcl_Obj *firstPtr in
The first of two path values to compare. The value 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
to \fBpath\fR type.
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
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
Filled with the clientData value to pass to this code's unload
function when it is called.
.AP Tcl_LoadHandle *loadHandlePtr 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







|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
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 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
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
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
accumulates the return values in a list which is returned to the
caller (with a reference count of 0).
.PP
\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
\fBTcl_EvalObjEx\fR.
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 system encoding
when reading the file.
.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
function (most virtual filesystems will not, because of OS limitations







|















|







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
accumulates the return values in a list which is returned to the
caller (with a reference count of 0).
.PP
\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
\fBTcl_EvalObjEx\fR.
If \fIencodingName\fR is NULL, the utf-8 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
when reading the file.
.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
function (most virtual filesystems will not, because of OS limitations
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\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
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
is to be used at the Tcl level, then calling this function is an







|







712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\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 \fBckfree\fR to ensure it is freed. Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\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
is to be used at the Tcl level, then calling this function is an
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
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.
.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







|







779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
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 \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
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
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.
.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 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
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.







|







827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
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.
.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 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
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.
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
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(
        Tcl_Obj *\fIpathPtr\fR,
        void **\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
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
.CS
typedef void *\fBTcl_FSDupInternalRepProc\fR(
        void *\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
internal representation is generated), but may otherwise be NULL.
.PP
.CS
typedef void \fBTcl_FSFreeInternalRepProc\fR(
        void *\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
representation is the normalized path.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
        void *\fIclientData\fR);
.CE
.SS CREATEINTERNALREPPROC
.PP
Function to take a path value, 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
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
.CS
typedef void *\fBTcl_FSCreateInternalRepProc\fR(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
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







|









|
|








|










|










|







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
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(
        Tcl_Obj *\fIpathPtr\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
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
.CS
typedef ClientData \fBTcl_FSDupInternalRepProc\fR(
        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
internal representation is generated), but may otherwise be NULL.
.PP
.CS
typedef void \fBTcl_FSFreeInternalRepProc\fR(
        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
representation is the normalized path.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
        ClientData \fIclientData\fR);
.CE
.SS CREATEINTERNALREPPROC
.PP
Function to take a path value, 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
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
.CS
typedef ClientData \fBTcl_FSCreateInternalRepProc\fR(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
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
Changes to doc/FindExec.3.
55
56
57
58
59
60
61
62

63
64
\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







|
>


55
56
57
58
59
60
61
62
63
64
65
\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. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
binary, executable file
Changes to doc/GetInt.3.
60
61
62
63
64
65
66



67
68
69
70
71
72
73
74
75
76
.QW \fB0d\fR
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
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 ;







>
>
>

|
|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
.QW \fB0d\fR
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,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
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 ;
Changes to doc/GetOpnFl.3.
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
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







|







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 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/GetTime.3.
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
.AP Tcl_Time *timePtr out
Points to memory in which to store the date and time information.
.AP Tcl_GetTimeProc getProc in
Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
.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
Value passed through to the two handler functions.
.AP Tcl_GetTimeProc *getProcPtr out
Pointer to place the currently registered get handler function into.
.AP Tcl_ScaleTimeProc *scaleProcPtr out
Pointer to place the currently registered scale handler function into.
.AP void **clientDataPtr out
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:







|





|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
.AP Tcl_Time *timePtr out
Points to memory in which to store the date and time information.
.AP Tcl_GetTimeProc getProc in
Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
.AP Tcl_ScaleTimeProc scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
.AP ClientData clientData in
Value passed through to the two handler functions.
.AP Tcl_GetTimeProc *getProcPtr out
Pointer to place the currently registered get handler function into.
.AP Tcl_ScaleTimeProc *scaleProcPtr out
Pointer to place the currently registered scale handler function into.
.AP ClientData *clientDataPtr out
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:
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
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







|


|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
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,
        ClientData \fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        ClientData \fIclientData\fR);
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
\fIclientData\fR fields contain a pointer supplied at the time the handler
functions were registered.
.PP
Any handler pair specified has to return data which is consistent between
Changes to doc/Hash.3.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
.sp
void *
\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
void *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
.sp
ClientData
\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
void *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp
62
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
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 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







|
|
>







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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 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
181
182
183
184
185
186
187





188
189
190
191
192
193
194
.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.





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







>
>
>
>
>







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







|







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
\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 \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
Changes to doc/InitStubs.3.
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Call \fBTcl_InitStubs\fR in the extension before calling any other
Tcl functions.
.IP 2) 5
Define the \fBUSE_TCL_STUBS\fR symbol.  Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library.  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.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
with the Tk stubs libraries.  See the \fBTk_InitStubs\fR page for
more information.
.SH DESCRIPTION
\fBTcl_InitStubs\fR attempts to initialize the stub table pointers







|
|
|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Call \fBTcl_InitStubs\fR in the extension before calling any other
Tcl functions.
.IP 2) 5
Define the \fBUSE_TCL_STUBS\fR symbol.  Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library.  For example, to use the Tcl 8.6 ABI on Unix platforms,
the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the
library name is \fItclstub86.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
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
'\"
'\" 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 8.7 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;			/* NO LONGER AVAILABLE */
    Tcl_FreeProc *\fIfreeProc\fR;	/* NO LONGER AVAILABLE */
    int \fIerrorLine\fR;		/* NO LONGER AVAILABLE */
} \fBTcl_Interp\fR;

typedef void \fBTcl_FreeProc\fR(
        char *\fIblockPtr\fR);
.BE
.SH DESCRIPTION
.PP
The \fBTcl_CreateInterp\fR procedure returns a pointer to a \fBTcl_Interp\fR
structure.  Callers of \fBTcl_CreateInterp\fR should use this pointer
as an opaque token, suitable for nothing other than passing back to
other routines in the Tcl interface from the same thread that called
\fBTcl_CreateInterp\fR.  The \fBTcl_Interp\fR struct no longer has any
supported client-visible fields.  Supported public routines such as
\fBTcl_SetResult\fR, \fBTcl_GetResult\fR, \fBTcl_SetErrorLine\fR,
\fBTcl_GetErrorLine\fR must be used instead.
.PP
Any legacy programs and extensions trying to access the fields above
in their source code will need conversion to compile for Tcl 8.7 and later.

.SH KEYWORDS
interpreter, result
Changes to doc/Limit.3.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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
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







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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 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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
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,
        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);
.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







|
















|










158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
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(
        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(
        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.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.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.
.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







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.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.
.AP int 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
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
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.
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.







|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
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 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.
Changes to doc/Method.3.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
.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







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
int
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS ClientData 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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
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







|


|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
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 ClientData clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP ClientData *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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
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







|




















|













|
|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
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(
        ClientData \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(
        ClientData \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,
        ClientData \fIoldClientData\fR,
        ClientData *\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
Changes to doc/NRE.3.
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
.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.







|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
.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 ClientData 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.
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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







|
|
|
|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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 ClientData data0 in
.AP ClientData data1 in
.AP ClientData data2 in
.AP ClientData 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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
.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;








|















|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
.PP
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR.  The signature for
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
\fBTcl_NRPostProc\fR(
        \fBClientData\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(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
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







|












|




















|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
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(
    ClientData 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
    ClientData 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(
    ClientData 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
Changes to doc/Namespace.3.
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
.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
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







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
.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 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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
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(
        void *\fIclientData\fR);
.CE
.PP
\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
\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







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
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(
        ClientData \fIclientData\fR);
.CE
.PP
\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
\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
Changes to doc/Notifier.3.
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 *
\fBTcl_InitNotifier\fR()
.sp
void
\fBTcl_FinalizeNotifier\fR(\fIclientData\fR)
.sp
int
\fBTcl_WaitForEvent\fR(\fItimePtr\fR)







|







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
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
.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
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
.AP "const 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.
.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.







|










|







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
.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 ClientData clientData in
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
.AP "const 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 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.
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
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,
        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







|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
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(
        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
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
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,
        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







|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
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(
        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
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
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)
before calling \fBTcl_QueueEvent\fR, but it
will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
.PP
Calling \fBTcl_QueueEvent\fR adds 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







|







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
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 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
Calling \fBTcl_QueueEvent\fR adds 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
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
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(
        Tcl_Event *\fIevPtr\fR,
        void *\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







|







415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
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(
        Tcl_Event *\fIevPtr\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
Changes to doc/Object.3.
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value 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 {







|

|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    int \fIrefCount\fR;
    char *\fIbytes\fR;
    int \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {
Changes to doc/ObjectType.3.
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
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
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
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.







|
|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
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
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
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.
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
.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
size_t
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
size_t
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
size_t
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
size_t
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
size_t
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)







|


|


|


|


|


|


|


|







49
50
51
52
53
54
55
56
57
58
59
60
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
int
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
int
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
int
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
int
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
int
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
int
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\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
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.
.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
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
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.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP size_t 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
channel.  The line read will be appended to the current value of the
value.
.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
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.
.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
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







|



















|








|












|










|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
\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 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.
.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
channel.
.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.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.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
channel.  The line read will be appended to the current value of the
value.
.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 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.
.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 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
Changes to doc/OpenTcp.3.
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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
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
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







|




|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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 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 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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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,
        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







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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(
        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
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
'\"
'\" 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
.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)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
.SH ARGUMENTS









|







>
>
>







1
2
3
4
5
6
7
8
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.
'\"
.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_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- 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_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
.SH ARGUMENTS
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94




95
96
97
98
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.
.PP
\fBTcl_SetPanicProc\fR can not be used safely by stub-enabled extensions, so its
symbol is not included in the stub table.
.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




.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)
.SH KEYWORDS
abort, fatal, error







|
|







>
>
>
>




82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
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.
.PP
\fBTcl_SetPanicProc\fR can not be used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.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. Interfaces
using argument lists have been found to be nonportable in practice. This
function is deprecated and will be removed in Tcl 9.0.
.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)
.SH KEYWORDS
abort, fatal, error
Changes to doc/ParseArgs.3.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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 \fBckfree\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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
.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







|







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
.CS
typedef struct {
    int \fItype\fR;
    const char *\fIkeyStr\fR;
    void *\fIsrcPtr\fR;
    void *\fIdstPtr\fR;
    const char *\fIhelpStr\fR;
    ClientData \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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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)(
        ClientData \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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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







|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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)(
        ClientData \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
Changes to doc/ParseCmd.3.
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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_ParseCommand\fR(\fIinterp, start, numBytes, nested, parsePtr\fR)
.sp










|







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



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;
if NULL, then no error messages are left after errors.

For \fBTcl_EvalTokensStandard\fR, 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







>
>
>





|
|

>
|
|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
\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, \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,
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
183
184
185
186
187
188
189










190
191
192
193
194
195
196
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.










.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







>
>
>
>
>
>
>
>
>
>







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
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 value returned as result has been
incremented, so the caller must
invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
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
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
    int \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    size_t \fIsize\fR;
    size_t \fInumComponents\fR;
} \fBTcl_Token\fR;
.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







|
|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    int \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    int \fIsize\fR;
    int \fInumComponents\fR;
} \fBTcl_Token\fR;
.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
Changes to doc/Preserve.3.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\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
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







|







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
\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 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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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,
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







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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, \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
Changes to doc/PrintDbl.3.
14
15
16
17
18
19
20

21


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


41
42
43
44
45
46
.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

This argument is ignored.


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


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.
.SH KEYWORDS
conversion, double-precision, floating-point, string







>
|
>
>



















>
>
|





14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
.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
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 .
.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 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.
.SH KEYWORDS
conversion, double-precision, floating-point, string
Changes to doc/RecEvalObj.3.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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.
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value 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







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value 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
Changes to doc/RegExp.3.
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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
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
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
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
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







|















|



|


|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
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 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 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 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 \-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
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
\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;
.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;
.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







|

|















|
|







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
\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 {
    int \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    long \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
.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 {
    long \fIstart\fR;
    long \fIend\fR;
} \fBTcl_RegExpIndices\fR;
.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
Changes to doc/SetChanErr.3.
83
84
85
86
87
88
89


90
91
92


93
94
95
96
97
98
99
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 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.


.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_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.
.IP \fBTcl_DriverGetOptionProc\fR







>
>



>
>







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
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 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.
.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.
.IP \fBTcl_DriverGetOptionProc\fR
Changes to doc/SetRecLmt.3.
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.
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,







|







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_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
'\"
'\" 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"
.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
.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_ResetResult\fR(\fIinterp\fR)
.sp
\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)


.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp 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.
.AP char *result 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
'\"
'\" 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"
.so man.macros
.BS
.SH NAME
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, 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)
.sp
\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.sp
\fBTcl_FreeResult\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp 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.
.AP char *result in
134
135
136
137
138
139
140





141
142
143
144
145
146
147
storage management issues associated with managing \fIinterp\fR's
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







>
>
>
>
>







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
storage management issues associated with managing \fIinterp\fR's
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_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
instead of taking a variable number of arguments it takes an argument list.
Interfaces using argument lists have been found to be nonportable in practice.
This function is deprecated and will be removed in Tcl 9.0.
.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
171
172
173
174
175
176
177
















178
179
180
181
182
183
184
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.
















.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\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







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







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
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.
.SS "DIRECT ACCESS TO INTERP->RESULT"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
to manipulate the interpreter result.  The Tcl headers no longer
permit this access. C code still doing this must
be updated to use supported routines \fBTcl_GetObjResult\fR,
\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\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
Changes to doc/SplitList.3.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
size_t
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
size_t
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
size_t
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
size_t
\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







|


|


|


|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
int
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
int
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
int
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
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
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
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







|







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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 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
Changes to doc/StaticPkg.3.
61
62
63
64
65
66
67
68
69
70
71
72
73
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)







|
|




61
62
63
64
65
66
67
68
69
70
71
72
73
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 used in stub-enabled extensions. Its symbol
entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
load(n), package(n), Tcl_PkgRequire(3)
Changes to doc/StringObj.3.
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
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
.sp










|







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_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
.sp
54
55
56
57
58
59
60



61
62
63
64
65
66
67
.sp
void
\fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR)
.sp
void
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
.sp



void
\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
.sp
Tcl_Obj *
\fBTcl_Format\fR(\fIinterp, format, objc, objv\fR)
.sp
int







>
>
>







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
.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)
.sp
void
\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
.sp
Tcl_Obj *
\fBTcl_Format\fR(\fIinterp, format, objc, objv\fR)
.sp
int
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
\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.
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
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP size_t 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.
.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.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP size_t 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
The index of the Unicode character to return.
.AP size_t 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
The index of the last Unicode character in the Unicode range to be
returned as a new value.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value 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.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP size_t limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
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
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
be manipulated as string values.  They use the internal representation







|



|


|





|


|
|

|


|














|












|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
\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.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e300\e200\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP int length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
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.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP int numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
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 int first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
.AP int last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value 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.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
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 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
be manipulated as string values.  They use the internal representation
239
240
241
242
243
244
245






246
247
248
249
250
251
252
.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_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.







>
>
>
>
>
>







242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
.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.  Interfaces using argument lists have been found to be
nonportable in practice. This function is deprecated and will be removed
in Tcl 9.0.
.PP
\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.
Changes to doc/TCL_MEM_DEBUG.3.
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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
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
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.
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.
.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
\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
.SH KEYWORDS
memory, debug







|









|








|












|


|





|


30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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 \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 \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 \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
\fBckalloc\fR, again, at a large performance impact.
.PP
If you are desperate and validating memory on every call to
\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"
ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
.SH KEYWORDS
memory, debug
Changes to doc/TclZlib.3.
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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.







|


















|
|
|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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 int 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 int count in
The maximum number of bytes to get from the stream, or -1 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.
Changes to doc/Thread.3.
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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
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 int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out







|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
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
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP ClientData clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
.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;

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







|














|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
.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(
    ClientData 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;
ClientData limitData = (void*)((intptr_t) limit);
Tcl_ThreadId id;    \fI/* holds identity of thread created */\fR
int result;

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
Changes to doc/TraceCmd.3.
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
.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 *
\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
Arbitrary argument to pass to \fIproc\fR.
.AP void *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







|


















|

|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
.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
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 ClientData clientData in
Arbitrary argument to pass to \fIproc\fR.
.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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.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,
        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
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







|








|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
.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(
        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
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
'\"
'\" 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"
.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 *
\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
.sp
void *
\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
.SH ARGUMENTS
.AS void *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
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
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







|


















|


|


|















|







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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 8.7 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
ClientData
\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
.sp
ClientData
\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
.SH ARGUMENTS
.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 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 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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
\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,
        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
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.







|
















|









|







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
\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(
        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
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.
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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







|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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 \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
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
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.







<
|







329
330
331
332
333
334
335

336
337
338
339
340
341
342
343
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 any supported code should 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.
Changes to doc/Utf.3.
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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)
.sp
int
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR)
.sp
int
\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
.sp
int
\fBTcl_UtfNcmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp







|


|





|


|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
wchar_t *
\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
.sp
int
\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
size_t
\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.
.AP int ch in







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
.sp
int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
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.
.AP int ch in
122
123
124
125
126
127
128
129
130
131
132
133
134
135


136
137
138
139
140
141
142
143
144
145
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
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 "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.


.AP "const char" *start in
Pointer to the beginning of a UTF-8 string.
.AP size_t 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.







|


|



>
>


|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
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 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 int uniLength in
The length of the Unicode string in characters.
.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 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.
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
\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
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
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







|













|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
\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 \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 \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
279
280
281
282
283
284
285
286
287
288
289
290
291
292



293
294
295
296
297
298
299
300
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
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
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,



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.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number
of bytes in the backslash sequence, including the backslash character.







|





|
>
>
>
|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
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
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.  If a negative \fIindex\fR is given or \fIindex\fR points
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, except if that would return
a pointer to the second byte of a valid 4-byte UTF-8 sequence, in which
case, \fBTcl_UtfToUniChar\fR will be called once more to find the end
of the sequence. If a negative \fIindex\fR is given, the returned 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.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number
of bytes in the backslash sequence, including the backslash character.
Changes to doc/binary.n.
758
759
760
761
762
763
764









765
766
767
768
769
770
771
.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







>
>
>
>
>
>
>
>
>







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
.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 \fBC\fR 5
This form is similar to \fBA\fR, except that it scans the data from start
and terminates at the first null (C string semantics). For example,
.RS
.CS
\fBbinary scan\fR "abc\e000efghi" C* var1
.CE
will return \fB1\fR with \fBabc\fR stored in \fIvar1\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
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/define.n.
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
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"
}







|







584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
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 the subcommands of them.
.PP
.CS
oo::class create c
c create o
\fBoo::define\fR c \fBmethod\fR foo {} {
    puts "world"
}
Changes to doc/expr.n.
37
38
39
40
41
42
43






44
45
46
47
48
49
50
non-numeric operands, string comparisons, and 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.
.PP
An operand may be specified in any of the following ways:







>
>
>
>
>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
non-numeric operands, string comparisons, and 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.
.PP
.VS "TIP 582"
You can use \fB#\fR at any point in the expression (except inside double
quotes or braces) to start a comment. Comments last to the end of the line or
the end of the expression, whichever comes first.
.VE "TIP 582"
.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.
.PP
An operand may be specified in any of the following ways:
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97


98
99
100
101
102
103
104
.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.
.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







|
|
|










>
>







84
85
86
87
88
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
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.
.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
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
interpreted as an octal integer even if the second character is not \fBo\fR.
.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
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
.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,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]







|







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
.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,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]
481
482
483
484
485
486
487

488

489
490
491
492
493
494
495
.CE
.PP
Set a variable indicating whether an environment variable is defined and has
value of true:
.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







>

>







489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
.CE
.PP
Set a variable indicating whether an environment variable is defined and has
value of true:
.PP
.CS
set isTrue [\fBexpr\fR {
    # Does the environment variable exist, and...
    [info exists ::env(SOME_ENV_VAR)] &&
    # ...does it contain a proper true value?
    [string is true -strict $::env(SOME_ENV_VAR)]
}]
.CE
.PP
Generate a random integer in the range 0..99 inclusive:
.PP
.CS
504
505
506
507
508
509
510

511
.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.
.fi
'\" Local Variables:
'\" mode: nroff

'\" End:







>

514
515
516
517
518
519
520
521
522
.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.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:
Changes to doc/interp.n.
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
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
.QW \fBa\fR
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a child







|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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.
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
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
.QW \fBa\fR
is a child of the current interpreter and it has a child
.QW \fBa1\fR ,
which in turn has a child
371
372
373
374
375
376
377




378
379
380
381
382
383
384
.TP
\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
.
Returns a Tcl list of the names of all the child 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







>
>
>
>







371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
.TP
\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
.
Returns a Tcl list of the names of all the child interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
.
Synonym for . \fBinterp\fR \fBchildren\fR ?\fIpath\fR?
.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
Changes to doc/load.n.
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
.SH EXAMPLE
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(void *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;







|







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
.SH EXAMPLE
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
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;
Changes to doc/lsearch.n.
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
.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.
.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







|
|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
.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 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
Changes to doc/lset.n.
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
\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







<
<







112
113
114
115
116
117
118


119
120
121
122
123
124
125
\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\(-> 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
Changes to doc/mathfunc.n.
120
121
122
123
124
125
126
127



128
129
130
131
132
133
134
\fBsqrt\fR	\fBsrand\fR	\fBtan\fR	\fBtanh\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.



.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







|
>
>
>







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
\fBsqrt\fR	\fBsrand\fR	\fBtan\fR	\fBtanh\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.  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
Changes to doc/memory.n.
21
22
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
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
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
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.







|









|
|







21
22
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, \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
Tcl began, the current packets allocated (the current
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
.
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
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.
.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
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
.CE
.PP
Calls to \fBTcl_Free\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.
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
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
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
checked for every piece of memory currently in existence that was
allocated by \fBTcl_Alloc\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
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
.SH KEYWORDS
memory, debug
'\"Local Variables:
'\"mode: nroff
'\"End:







|




|




|
|





|


|




|

|










|

|


|
|



|





55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
.
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 \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 \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 \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
ckalloc 40e478 98 tclProc.c 1406
.CE
.PP
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 \fBckalloc\fRs have been performed.
For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
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
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 \fBckalloc\fR or \fBckfree\fR, the guard zones are
checked for every piece of memory currently in existence that was
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 \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"
ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
.SH KEYWORDS
memory, debug
'\"Local Variables:
'\"mode: nroff
'\"End:
Changes to doc/re_syntax.n.
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
for a Unicode extension up to 21 bits. The digits are parsed until the
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
.TP
\fB\ex\fIhh\fR
.
(where \fIhh\fR is one or two hexadecimal digits) the character
whose hexadecimal value is \fB0x\fIhh\fR.
.TP
\fB\e0\fR







|







371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
for a Unicode extension up to 21 bits. The digits are parsed until the
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 are all available.
.TP
\fB\ex\fIhh\fR
.
(where \fIhh\fR is one or two hexadecimal digits) the character
whose hexadecimal value is \fB0x\fIhh\fR.
.TP
\fB\e0\fR
Changes to doc/scan.n.
220
221
222
223
224
225
226
227


228
229
230
231
232
233
234
235
236
237
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:


.PP
.CS
set string "08:08"
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
    error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
    error "invalid number of minutes"
}







|
>
>


|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
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, noting that this avoids problems with
octal numbers by forcing interpretation as decimals (if we did not
care, we would use the \fB%i\fR conversion instead):
.PP
.CS
set string "08:08"   ;# *Not* octal!
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
    error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
    error "invalid number of minutes"
}
Changes to doc/source.n.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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).
.PP
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 system encoding is assumed.
.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







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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).
.PP
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.
.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
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
'\"
'\" 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
.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












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
'\"
'\" 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_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- 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
349
350
351
352
353
354
355
































































356
357
358
359
360
361
362
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.)
.RE
































































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







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







349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
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.)
.RE
.TP
\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.
Changes to generic/regc_lex.c.
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
	    FAILW(REG_EESCAPE);
	}

	/*
	 * Ugly heuristic (first test is "exactly 1 digit?")
	 */

	if (v->now - save == 0 || ((int) c > 0 && (size_t)c <= v->nsubexp)) {
	    NOTE(REG_UBACKREF);
	    RETV(BACKREF, (chr)c);
	}

	/*
	 * Oops, doesn't look like it's a backref after all...
	 */







|







890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
	    FAILW(REG_EESCAPE);
	}

	/*
	 * Ugly heuristic (first test is "exactly 1 digit?")
	 */

	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...
	 */
Changes to generic/regc_locale.c.
801
802
803
804
805
806
807


808
809
810
811
812
813
814
};

#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))

/*
 *	End of auto-generated Unicode character ranges declarations.
 */



/*
 - element - map collating-element name to celt
 ^ static celt element(struct vars *, const chr *, const chr *);
 */
static celt
element(







>
>







801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
};

#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(
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
    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);
	if (c != lc) {
	    addchr(cv, lc);
	}
	if (c != uc) {
	    addchr(cv, uc);
	}
	if (c != tc && tc != uc) {







|
|
|







895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
    nchrs = (b - a + 1)*2 + 4;

    cv = getcvec(v, nchrs, 0);
    NOERRN();

    for (c=a; c<=b; c++) {
	addchr(cv, 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

    /*
     * Crude fake equivalence class for testing.
     */

    if ((v->cflags&REG_FAKE) && c == 'x') {
	cv = getcvec(v, 4, 0);
	addchr(cv, 'x');
	addchr(cv, 'y');
	if (cases) {
	    addchr(cv, 'X');
	    addchr(cv, 'Y');
	}
	return cv;
    }

    /*
     * Otherwise, none.
     */

    if (cases) {
	return allcases(v, c);
    }
    cv = getcvec(v, 1, 0);
    assert(cv != NULL);
    addchr(cv, 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;

    /*
     * The following arrays define the valid character class names.
     */

    static const char *const classNames[] = {
	"alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",







|
|

|
|













|




















<
|







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

    /*
     * Crude fake equivalence class for testing.
     */

    if ((v->cflags&REG_FAKE) && c == 'x') {
	cv = getcvec(v, 4, 0);
	addchr(cv, (chr)'x');
	addchr(cv, (chr)'y');
	if (cases) {
	    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, (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;

    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

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);

    /*
     * Map the name to the corresponding enumerated value.
     */

    index = -1;
    for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {







|







1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022

    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&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
     * 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++) {
		addchr(cv, alphaCharTable[i]);
	    }
	    for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
		addrange(cv, controlRangeTable[i].start,
			controlRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
		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++) {
		addrange(cv, punctRangeTable[i].start,
			punctRangeTable[i].end);
	    }
	    for (i=0 ; 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







|


|



|








|



|


















|



|







|








|



|







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
     * 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 ; (size_t)i<NUM_ALPHA_CHAR ; i++) {
		addchr(cv, alphaCharTable[i]);
	    }
	    for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    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 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    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 ; (size_t)i<NUM_CONTROL_RANGE ; i++) {
		addrange(cv, controlRangeTable[i].start,
			controlRangeTable[i].end);
	    }
	    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 ; (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 ; (size_t)i<NUM_PUNCT_RANGE ; i++) {
		addrange(cv, punctRangeTable[i].start,
			punctRangeTable[i].end);
	    }
	    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
	    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++) {
		addrange(cv, spaceRangeTable[i].start,
			spaceRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
		addrange(cv, lowerRangeTable[i].start,
			lowerRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
		addrange(cv, upperRangeTable[i].start,
			upperRangeTable[i].end);
	    }
	    for (i=0 ; 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++) {
    		addrange(cv, spaceRangeTable[i].start,
    				spaceRangeTable[i].end);
    	    }
    	    for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
    		addchr(cv, spaceCharTable[i]);
    	    }
    	    for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
    		addrange(cv, graphRangeTable[i].start,
    				graphRangeTable[i].end);
    	    }
    	    for (i=0 ; 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++) {
		addrange(cv, graphRangeTable[i].start,
			graphRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
		addchr(cv, graphCharTable[i]);
	    }
	}
	break;
    }
    if (cv == NULL) {
	ERR(REG_ESPACE);







|



|







|



|







|



|







|



|


|



|







|



|







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
	    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 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
		addrange(cv, spaceRangeTable[i].start,
			spaceRangeTable[i].end);
	    }
	    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 ; (size_t)i<NUM_LOWER_RANGE ; i++) {
		addrange(cv, lowerRangeTable[i].start,
			lowerRangeTable[i].end);
	    }
	    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 ; (size_t)i<NUM_UPPER_RANGE ; i++) {
		addrange(cv, upperRangeTable[i].start,
			upperRangeTable[i].end);
	    }
	    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 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
    		addrange(cv, spaceRangeTable[i].start,
    				spaceRangeTable[i].end);
    	    }
    	    for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) {
    		addchr(cv, spaceCharTable[i]);
    	    }
    	    for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
    		addrange(cv, graphRangeTable[i].start,
    				graphRangeTable[i].end);
    	    }
    	    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 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
		addrange(cv, graphRangeTable[i].start,
			graphRangeTable[i].end);
	    }
	    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
    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);

    if (tc != uc) {
	cv = getcvec(v, 3, 0);
	addchr(cv, tc);
    } else {
	cv = getcvec(v, 2, 0);
    }







|
|
|







1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
    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((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);
    }
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
/*
 * 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 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 *subre(struct vars *, int, int, struct state *, struct state *);
static void freesubre(struct vars *, struct subre *);
static void freesrnode(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 *);







|
















|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
/*
 * 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 *, 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 void freesubre(struct vars *, struct subre *);
static void freesrnode(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 *);
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    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 */
    int lexcon;			/* lexical context type (see lex.c) */
    size_t 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 */
    struct cvec *cv;		/* interface cvec */
    struct cvec *cv2;		/* utility cvec */
    struct subre *lacons;	/* lookahead-constraint vector */
    size_t 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 */







|

|

|












|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    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 */
    int nextvalue;		/* value (if any) of next token */
    int lexcon;			/* lexical context type (see lex.c) */
    int nsubexp;		/* subexpression count */
    struct subre **subs;	/* subRE pointer vector */
    int 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 */
    struct cvec *cv;		/* interface cvec */
    struct cvec *cv2;		/* utility cvec */
    struct subre *lacons;	/* lookahead-constraint vector */
    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 */
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
    regex_t *re,
    const chr *string,
    size_t len,
    int flags)
{
    AllocVars(v);
    struct guts *g;
    size_t i, j;
    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }

    /*
     * Sanity checks.
     */








|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
    regex_t *re,
    const chr *string,
    size_t len,
    int flags)
{
    AllocVars(v);
    struct guts *g;
    int i, j;
    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }

    /*
     * Sanity checks.
     */

334
335
336
337
338
339
340

341
342
343
344
345
346
347
    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_guts = NULL;
    re->re_fns = (void*)(&functions);

    /*
     * More complex setup, malloced things.
     */








>







334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
    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);

    /*
     * More complex setup, malloced things.
     */

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
     */

    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);
	}
	nfanode(v, &v->lacons[i], debug);
    }
    CNOERR();
    if (v->tree->flags&SHORTER) {
	NOTE(REG_USHORTEST);
    }







|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
     */

    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%d ==========\n", i);
	}
	nfanode(v, &v->lacons[i], debug);
    }
    CNOERR();
    if (v->tree->flags&SHORTER) {
	NOTE(REG_USHORTEST);
    }
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484

    assert(v->err == 0);
    return freev(v, 0);
}

/*
 - moresubs - enlarge subRE vector
 ^ static void moresubs(struct vars *, size_t);
 */
static void
moresubs(
    struct vars *v,
    size_t wanted)			/* want enough room for this one */
{
    struct subre **p;
    size_t n;

    assert(wanted > 0 && wanted >= v->nsubs);
    n = 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 *));







|




|


|







463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485

    assert(v->err == 0);
    return freev(v, 0);
}

/*
 - moresubs - enlarge subRE vector
 ^ static void moresubs(struct vars *, int);
 */
static void
moresubs(
    struct vars *v,
    int wanted)			/* want enough room for this one */
{
    struct subre **p;
    int n;

    assert(wanted > 0 && wanted >= v->nsubs);
    n = 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 *));
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
    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 = subre(v, '|', LONGER, init, final);
    NOERRN();
    branch = branches;
    firstbranch = 1;
    do {	/* a branch */
	if (!firstbranch) {
	    /*
	     * Need a place to hang the branch.
	     */

	    branch->right = subre(v, '|', LONGER, init, final);
	    NOERRN();
	    branch = branch->right;
	}
	firstbranch = 0;
	left = newstate(v->nfa);
	right = newstate(v->nfa);
	NOERRN();







|









|







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
    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);
    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);
	    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
{
    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 = 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);
	}







|







740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
{
    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 */
    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
    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 atomtype;
    int qprefer;		/* quantifier short/long preference */
    int f;
    struct subre **atomp;	/* where the pointer to atom is */

    /*
     * Initial bookkeeping.







|







791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
    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? */
    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.
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
	NOERR();
	atom = parse(v, ')', PLAIN, s, s2);
	assert(SEE(')') || ISERR());
	NEXT();
	NOERR();
	if (cap) {
	    v->subs[subno] = atom;
	    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 = subre(v, 'b', BACKR, lp, rp);
	NOERR();
	subno = v->nextvalue;
	atom->subno = subno;
	EMPTYARC(lp, rp);	/* temporarily, so there's something */
	NEXT();
	break;
    }







|

















|







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
	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);
	    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);
	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
     */

    /*
     * Now we'll need a subre for the contents even if they're boring.
     */

    if (atom == NULL) {
	atom = subre(v, '=', 0, lp, rp);
	NOERR();
    }

    /*
     * Prepare a general-purpose state skeleton.
     *
     * In the no-backrefs case, we want this:







|







1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
     */

    /*
     * Now we'll need a subre for the contents even if they're boring.
     */

    if (atom == NULL) {
	atom = sub_re(v, '=', 0, lp, rp);
	NOERR();
    }

    /*
     * Prepare a general-purpose state skeleton.
     *
     * In the no-backrefs case, we want this:
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
    EMPTYARC(lp, s);
    NOERR();

    /*
     * Break remaining subRE into x{...} and what follows.
     */

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







|













|







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
    EMPTYARC(lp, s);
    NOERR();

    /*
     * Break remaining subRE into x{...} and what follows.
     */

    t = sub_re(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);
    NOERR();
    top->op = '.';
    top->right = t;

    /*
     * If it's a backref, now is the time to replicate the subNFA.
     */
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
	 * we don't really care where its submatches are.
	 */

	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 = subre(v, '.', f, s, atom->end);	/* prefix and atom */
	NOERR();
	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 = subre(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);
    } else {
	EMPTYARC(s2, rp);
	t->right = subre(v, '=', 0, s2, rp);
    }
    NOERR();
    assert(SEE('|') || SEE(stopper) || SEE(EOS));
    t->flags |= COMBINE(t->flags, t->right->flags);
    top->flags |= COMBINE(top->flags, t->flags);
}








|

|














|

















|







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
	 * we don't really care where its submatches are.
	 */

	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 */
	NOERR();
	t->left = sub_re(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);
    } else {
	EMPTYARC(s2, rp);
	t->right = sub_re(v, '=', 0, s2, rp);
    }
    NOERR();
    assert(SEE('|') || SEE(stopper) || SEE(EOS));
    t->flags |= COMBINE(t->flags, t->right->flags);
    top->flags |= COMBINE(top->flags, t->flags);
}

1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
    assert((v->savenow != NULL && SEE(']')) || ISERR());
    NEXT();
    NOERR();
    v->wordchrs = left;
}

/*
 - subre - allocate a subre
 ^ static struct subre *subre(struct vars *, int, int, struct state *,
 ^	struct state *);
 */
static struct subre *
subre(
    struct vars *v,
    int op,
    int flags,
    struct state *begin,
    struct state *end)
{
    struct subre *ret = v->treefree;







|
|



|







1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
    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 *,
 ^	struct state *);
 */
static struct subre *
sub_re(
    struct vars *v,
    int op,
    int flags,
    struct state *begin,
    struct state *end)
{
    struct subre *ret = v->treefree;
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
    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);

    dumpcolors(&g->cmap, f);
    if (!NULLCNFA(g->search)) {
	fprintf(f, "\nsearch:\n");
	dumpcnfa(&g->search, f);
    }
    for (i = 1; i < g->nlacons; i++) {







|
|







2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
    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 %d, info 0%lo, csize %d, ntree %d\n",
	    (int) 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++) {
Changes to generic/regcustom.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
61
62
63
64
65
66

67
68
69
70
71
72
73

#include "regex.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	MALLOC(n)		Tcl_AttemptAlloc(n)
#define	FREE(p)			Tcl_Free(p)
#define	REALLOC(p,n)		Tcl_AttemptRealloc(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_NOFRONT
#undef __REG_NOFRONT
#endif
#ifdef __REG_NOCHAR
#undef __REG_NOCHAR
#endif
/* Interface types */
#define	__REG_WIDE_T	Tcl_UniChar

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







|
|
|

















>
>
>








>







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
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 "regex.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	MALLOC(n)		(void*)(attemptckalloc(n))
#define	FREE(p)			ckfree((void*)(p))
#define	REALLOC(p,n)		(void*)(attemptckrealloc((void*)(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_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... */
/* 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
Changes to generic/regerror.c.
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
	    if (r->code == icode) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->name;
	} else {		/* Unknown; tell him the number */
	    sprintf(convbuf, "REG_%u", icode);
	    msg = convbuf;
	}
	break;
    default:			/* A real, normal error code */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == code) {
		break;







|







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
	    if (r->code == icode) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->name;
	} else {		/* Unknown; tell him the number */
	    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/regex.h.
85
86
87
88
89
90
91



92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107
108
109
110
111
112











113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
#endif
#ifdef __REG_WIDE_COMPILE
#undef __REG_WIDE_COMPILE
#endif
#ifdef __REG_WIDE_EXEC
#undef __REG_WIDE_EXEC
#endif



#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
#ifdef __REG_NOCHAR
#undef __REG_NOCHAR
#endif
/* interface types */
#define	__REG_WIDE_T	Tcl_UniChar

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












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

#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

    char *re_endp;		/* backward compatibility kludge */
    /* the rest is opaque pointers to hidden innards */
    void *re_guts;
    void *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 */
} regmatch_t;

/* supplementary control and reporting */
typedef struct {
    regmatch_t rm_extend;	/* see REG_EXPECT */
} rm_detail_t;








>
>
>








>













>
>
>
>
>
>
>
>
>
>
>







<

>














>








|
|







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
#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_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... */
/* 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

/*
 * other interface types
 */

/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
    int re_magic;		/* magic number */

    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;
} regex_t;

/* result reporting (may acquire more fields later) */
typedef struct {
    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;

Changes to generic/regexec.c.
181
182
183
184
185
186
187




188
189
190
191
192
193
194
    /*
     * Sanity checks.
     */

    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
	FreeVars(v);
	return REG_INVARG;




    }

    /*
     * Setup.
     */

    v->re = re;







>
>
>
>







181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    /*
     * 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;
Changes to generic/tcl.decls.
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110

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

127
128
129
130
131
132
133
134
135
136
137
138
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
    void *Tcl_Alloc(size_t size)
}
declare 4 {
    void Tcl_Free(void *ptr)
}
declare 5 {
    void *Tcl_Realloc(void *ptr, size_t size)
}
declare 6 {
    void *Tcl_DbCkalloc(size_t size, const char *file, int line)
}
declare 7 {
    void Tcl_DbCkfree(void *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, size_t 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)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
}
declare 13 {
    int Tcl_WaitForEvent(const 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)
}
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)
}
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 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t 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 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length,
	    const char *file, int line)
}
declare 29 {
    Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
declare 30 {
    void TclFreeObj(Tcl_Obj *objPtr)







|


|


|


|


|


|









|




















|

















<
|
|
<
>

|










<
|
|
<
>




|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108

109
110
111
112
113
114
115
116
117
118
119
120
121

122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
}
declare 3 {
    char *Tcl_Alloc(unsigned int size)
}
declare 4 {
    void Tcl_Free(char *ptr)
}
declare 5 {
    char *Tcl_Realloc(char *ptr, unsigned int size)
}
declare 6 {
    char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
}
declare 7 {
    void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
declare 8 {
    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,
	    ClientData clientData)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
}
declare 13 {
    int Tcl_WaitForEvent(const 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, 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)
}
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)
}

declare 22 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)

}
declare 23 {
    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)
}

declare 26 {deprecated {No longer in use, changed to macro}} {
    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, int length,
	    const char *file, int line)
}
declare 29 {
    Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
declare 30 {
    void TclFreeObj(Tcl_Obj *objPtr)
150
151
152
153
154
155
156
157
158
159
160
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
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 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)
}
declare 41 {
    char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}







<
|
|
|
<
>










|







148
149
150
151
152
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 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)
}

declare 36 {deprecated {No longer in use, changed to macro}} {
    int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const char *const *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 {
    CONST86 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
    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 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t 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 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 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
#    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
#}

declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    size_t length)
}
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 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 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length)
}
# Removed in 9.0, replaced by macro.
#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 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)
}
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)
#}
# Removed in 9.0:

#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)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
}
# Removed in 9.0:
#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)
}
declare 84 {
    size_t Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    size_t Tcl_ConvertCountedElement(const char *src, size_t 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)
}
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)
}
declare 89 {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
	    Tcl_ChannelProc *proc, void *clientData)
}
declare 90 {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *clientData)
}
declare 91 {
    Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdProc *proc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 92 {
    void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *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 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc *proc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
    Tcl_Interp *Tcl_CreateChild(Tcl_Interp *interp, const char *name,
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, void *clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    Tcl_CmdTraceProc *proc, void *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)
}
declare 102 {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *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)
}
declare 106 {
    void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
}
declare 107 {
    void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData)
}
declare 108 {
    void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
}
declare 109 {
    void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}







<
|
|
<
>

|




<
|
|
<
>



<
|
|
<
>




|

<
|
|
<
>

|



|




<
|
|
<
>



<
|
|
<
>

|


|

<
|
|
<
<
>
|
|
|
<
>











|













<
|
|
<
<
>
|
|
<
>






|


|

<
|
|
<
>







|


|














|



|



|



|




|


|




<
|
|
|
|
<
>



|








|



|






|



|








|



|


|







194
195
196
197
198
199
200

201
202

203
204
205
206
207
208
209

210
211

212
213
214
215

216
217

218
219
220
221
222
223
224

225
226

227
228
229
230
231
232
233
234
235
236
237

238
239

240
241
242
243

244
245

246
247
248
249
250
251
252

253
254


255
256
257
258

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

285
286


287
288
289

290
291
292
293
294
295
296
297
298
299
300
301

302
303

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

355
356
357
358

359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
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[])
}

declare 49 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewBooleanObj(int boolValue)

}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}

declare 52 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewIntObj(int intValue)

}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}

declare 54 {deprecated {No longer in use, changed to macro}} {
    Tcl_Obj *Tcl_NewLongObj(long longValue)

}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}

declare 57 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)

}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    int length)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}

declare 61 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)

}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}

declare 63 {deprecated {No longer in use, changed to macro}} {
    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)

}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}

declare 66 {deprecated {No longer in use, changed to macro}} {
    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)


}
declare 67 {deprecated {No longer in use, changed to macro}} {
    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,
	    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)
}

declare 76 {deprecated {No longer in use, changed to macro}} {
    void Tcl_BackgroundError(Tcl_Interp *interp)


}
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
    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,
	    ClientData clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}

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)
}
declare 84 {
    int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    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)
}
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, ClientData instanceData, int mask)
}
declare 89 {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
	    Tcl_ChannelProc *proc, ClientData clientData)
}
declare 90 {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    ClientData clientData)
}
declare 91 {
    Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdProc *proc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 92 {
    void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}

declare 95 {deprecated {}} {
    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, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
    Tcl_Interp *Tcl_CreateChild(Tcl_Interp *interp, const char *name,
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, ClientData clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    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,
	    ClientData clientData)
}
declare 102 {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    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, ClientData clientData)
}
declare 106 {
    void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 107 {
    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
    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)
}
declare 115 {
    int Tcl_DoOneEvent(int flags)
}
declare 116 {
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData)
}
declare 117 {
    char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t 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)
}
declare 125 {
    void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
    int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
    const char *Tcl_ErrnoId(void)
}
declare 128 {
    const char *Tcl_ErrnoMsg(int err)
}
# Removed in 9.0, replaced by macro.
#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 132 {
    void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
    int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
	    const char *cmdName)







|





|


|




















|













<
|
|
<
>



<
|
|
<
>

|







418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468

469
470

471
472
473
474

475
476

477
478
479
480
481
482
483
484
485
486
    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, ClientData clientData)
}
declare 115 {
    int Tcl_DoOneEvent(int flags)
}
declare 116 {
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
}
declare 117 {
    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, 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)
}
declare 128 {
    const char *Tcl_ErrnoMsg(int err)
}

declare 129 {
    int Tcl_Eval(Tcl_Interp *interp, const char *script)

}
declare 130 {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}

declare 131 {deprecated {No longer in use, changed to macro}} {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)

}
declare 132 {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
}
declare 134 {
    int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
	    const char *cmdName)
526
527
528
529
530
531
532
533
534
535
536

537
538
539
540
541
542
543
544
545
546
547

548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
}
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 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 148 {
    int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *argcPtr, const char ***argvPtr)
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    void *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)
}
declare 154 {
    void *Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    const 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)
}
declare 159 {
    int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdInfo *infoPtr)
}
declare 160 {
    const char *Tcl_GetCommandName(Tcl_Interp *interp,







<
|
|
<
>







<
|
|
<
>











|











|


|












|







509
510
511
512
513
514
515

516
517

518
519
520
521
522
523
524
525

526
527

528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
}
declare 142 {
    int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
    void Tcl_Finalize(void)
}

declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
    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)
}

declare 147 {deprecated {see TIP #559. Use Tcl_ResetResult}} {
    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)
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    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,
	    ClientData *handlePtr)
}
declare 154 {
    ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    const 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 {
    CONST86 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,
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
}

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

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
	    int checkUsage, void **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)
}
declare 170 {
    size_t 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)
}
declare 173 {
    Tcl_Channel Tcl_GetStdChannel(int type)
}
# Removed in 9.0, replaced by macro.
#declare 174 {
#    const 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 176 {
    const 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)
#}
# Removed in 9.0, replaced by macro.

#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)
}







|







|


|










<
|
|
<
<
>
|
|
|
<
>




<
|
|
<
<
>
|
|
<
>







595
596
597
598
599
600
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
}

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

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
	    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 {
    int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
declare 170 {
    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)
}
declare 173 {
    Tcl_Channel Tcl_GetStdChannel(int type)
}

declare 174 {
    const char *Tcl_GetStringResult(Tcl_Interp *interp)


}
declare 175 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
	    int flags)

}
declare 176 {
    const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}

declare 177 {
    int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)


}
declare 178 {deprecated {No longer in use, changed to macro}} {
    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)
}
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode)
}
declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}







|





|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
}
declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
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
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int async)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
}
declare 201 {
    void Tcl_Preserve(void *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)
}
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)
}
declare 207 {
    void Tcl_ReapDetachedProcs(void)
}
declare 208 {
    int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags)
}







|


|














|







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
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int async)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    ClientData callbackData)
}
declare 201 {
    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)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
    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)
}
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
	    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)
}
declare 216 {
    void Tcl_Release(void *clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    size_t Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr)
}
# Removed in 9.0:
#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)
}
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)







|



|





|


|

<
|
|
<
>








|







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
	    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, int index,
	    const char **startPtr, const char **endPtr)
}
declare 216 {
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}

declare 220 {deprecated {}} {
    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, 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)
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
}
declare 228 {
    void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
# Removed in 9.0 (stub entry only)
#declare 230 {
#    void Tcl_SetPanicProc(TCL_NORETURN1 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 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 238 {
    const 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)
}







<
|
|
<
>



<
|
|
|
<
>












<
|
|
|
<
>







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
}
declare 228 {
    void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}

declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
    void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)

}
declare 231 {
    int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}

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

declare 237 {deprecated {No longer in use, changed to macro}} {
    const 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,
	    const char *part2, const char *newValue, int flags)
}
declare 239 {
    const char *Tcl_SignalId(int sig)
}
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
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, const 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)
#}
# Removed in 9.0 (stub entry only)

#declare 245 {
#    int Tcl_StringMatch(const char *str, const char *pattern)
#}
# Removed in 9.0:

#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 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, void *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)
}
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 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 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    void *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 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 262 {
    void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    void *prevClientData)
}
declare 263 {
    size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t 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)
#}
# Removed in 9.0:

#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)
}
# 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 272 {
    const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}
# Removed in 9.0, replaced by macro.
#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)
#}
# Removed in 9.0:

#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 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 279 {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
declare 280 {
    void Tcl_InitMemory(Tcl_Interp *interp)
}








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


|






|







<
|
|
<
>




<
|
|
|
<
>



|




<
|
|
|
<
>







<
|
|
|
<
>

|

|


|











<
|
|
<
<
>
|
|
<
>







<
|
|
|
<
>





<
|
|
|
<
>

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



<
|
|
<
>







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
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	    const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}

declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)


}
declare 245 {deprecated {No longer in use, changed to macro}} {
    int Tcl_StringMatch(const char *str, const char *pattern)


}
declare 246 {deprecated {}} {
    int Tcl_TellOld(Tcl_Channel chan)


}
declare 247 {deprecated {No longer in use, changed to macro}} {
    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, ClientData clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    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)
}

declare 253 {deprecated {No longer in use, changed to macro}} {
    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)
}

declare 255 {deprecated {No longer in use, changed to macro}} {
    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,
	    ClientData clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}

declare 258 {deprecated {No longer in use, changed to macro}} {
    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, ...)
}

declare 261 {deprecated {No longer in use, changed to macro}} {
    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)

}
declare 262 {
    ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    ClientData prevClientData)
}
declare 263 {
    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)
}

declare 267 {deprecated {see TIP #422}} {
    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)


}
declare 268 {deprecated {see TIP #422}} {
    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)
}

declare 271 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)

}
declare 272 {
    const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
}

declare 273 {deprecated {No longer in use, changed to macro}} {
    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
	    const char *version)

}
# TIP #268: The internally used new Require function is in slot 573.

declare 274 {deprecated {No longer in use, changed to macro}} {
    const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)


}
declare 275 {deprecated {see TIP #422}} {
    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)


}
declare 276 {deprecated {see TIP #422}} {
    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)

}
declare 277 {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}

declare 278 {deprecated {see TIP #422}} {
    TCL_NORETURN 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
# 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,
	    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)







|







1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
# 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, 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
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)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
}
# Removed in 9.0, replaced by macro.
#declare 290 {
#    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}

declare 291 {
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t 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)
}
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,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 296 {
    char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
	    const char *src, size_t srcLen, Tcl_DString *dsPtr)
}
declare 297 {
    void Tcl_FinalizeThread(void)
}
declare 298 {
    void Tcl_FinalizeNotifier(void *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)
}
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,
	    int *indexPtr)
}
declare 305 {
    void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size)
}
declare 306 {
    Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
declare 307 {
    void *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)
}
declare 312 {
    size_t Tcl_NumUtfChars(const char *src, size_t length)
}
declare 313 {
    size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
	    size_t charsToRead, int appendFlag)
}
# Removed in 9.0, replaced by macro.
#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 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)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
}
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int 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)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, size_t length)
}
declare 327 {
    size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    const char *Tcl_UtfNext(const char *src)
}
declare 331 {
    const 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,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, size_t 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)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen)
}
declare 339 {
    size_t 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)
#}
# Removed in 9.0:

#declare 342 {
#    void Tcl_SetDefaultEncodingDir(const char *path)
#}

declare 343 {
    void Tcl_AlertNotifier(void *clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 {
    int Tcl_UniCharIsAlnum(int ch)
}







|


|

<
|
|
<
>

|














|
|




|





|


















|



|






|















|


|
|

<
|
|
<
<
>
|
|
<
>















|














|


|


|















|
|




|














|


|




<
|
|
<
<
>
|
|
<
>

|







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
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, ClientData clientData)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}

declare 290 {
    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)

}
declare 291 {
    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)
}
declare 295 {
    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)
}
declare 296 {
    char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
	    const char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 297 {
    void Tcl_FinalizeThread(void)
}
declare 298 {
    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)
}
declare 303 {
    void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
    int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const void *tablePtr, int offset, const char *msg, int flags,
	    int *indexPtr)
}
declare 305 {
    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 {
    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)
}
declare 312 {
    int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
    int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
	    int appendFlag)
}

declare 314 {
    void Tcl_RestoreResult(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, int index)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
}
declare 322 {
    int Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, int length)
}
declare 327 {
    int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    const char *Tcl_UtfNext(const char *src)
}
declare 331 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
    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)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    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)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen)
}
declare 339 {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}

declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
    const char *Tcl_GetDefaultEncodingDir(void)


}
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
    void Tcl_SetDefaultEncodingDir(const char *path)

}
declare 343 {
    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
}
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)
#}
# Removed in 9.0:

#declare 353 {
#    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
#	    size_t numChars)
#}

declare 354 {
    char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
	    size_t uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    unsigned short *Tcl_UtfToChar16DString(const char *src,
	    size_t 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 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, size_t length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start,
	    size_t numBytes, int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t 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)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start,
	    size_t 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)
}
declare 370 {
    int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t 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)
}
declare 377 {
    void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
    Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    size_t numChars)
}
declare 380 {
    size_t Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index)
}
# Removed in 9.0, replaced by macro.
#declare 382 {
#    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
#}

declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
# Removed in 9.0
#declare 384 {
#    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
#	    size_t 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 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)
}

# Introduced in 8.3.2
declare 394 {
    size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead)
}
declare 395 {
    size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t 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)
}
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 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 406 {
    Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 407 {
    Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)







<
|
|
<
<
>
|
|
|
<
>


|



|





<
|
|
|
<
>





|


|
|
<


|
|


|




|



|
|
















|


|


















|





|



|


|


|

<
|
|
<
>

|

<
|
|
|
<
>

















|










|




|


|


















<
|
|
|
<
>












<
|
|
|
<
>







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
}
declare 350 {
    int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}

declare 352 {deprecated {Use Tcl_GetCharLength}} {
    int Tcl_UniCharLen(const Tcl_UniChar *uniStr)


}
declare 353 {deprecated {Use Tcl_UtfNcmp}} {
    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)

}
declare 354 {
    char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    unsigned short *Tcl_UtfToChar16DString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}

declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
    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, int length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
	    Tcl_Parse *parsePtr, int append, const char **termPtr)

}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
	    int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    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,
	    int numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, 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, unsigned long n)
}
declare 370 {
    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, 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, int numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    int numChars)
}
declare 380 {
    int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}

declare 382 {deprecated {No longer in use, changed to macro}} {
    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)

}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}

declare 384 {deprecated {Use Tcl_AppendStringsToObj}} {
    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(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,
	    ClientData clientData, int stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead)
}
declare 395 {
    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)
}
declare 399 {
    Tcl_ChannelTypeVersion Tcl_ChannelVersion(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 400 {
    Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
	    const Tcl_ChannelType *chanTypePtr)
}

declare 401 {deprecated {Use Tcl_ChannelClose2Proc}} {
    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)
}

declare 405 {deprecated {Use Tcl_ChannelWideSeekProc}} {
    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
}
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)
#}
# Removed in 9.0:

#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)
#}
# 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 423 {
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
declare 425 {
    void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *procPtr,
	    void *prevClientData)
}
declare 426 {
    int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_CommandTraceProc *proc, void *clientData)
}
declare 427 {
    void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *proc, void *clientData)
}
declare 428 {
    void *Tcl_AttemptAlloc(size_t size)
}
declare 429 {
    void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line)
}
declare 430 {
    void *Tcl_AttemptRealloc(void *ptr, size_t size)
}
declare 431 {
    void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
	    const char *file, int line)
}
declare 432 {
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t 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)
#}
# Removed in 9.0:

#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







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








|

|



|



|


|


|


|


|



|













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







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
}
declare 417 {
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}

declare 419 {deprecated {Use Tcl_UtfNcasecmp}} {
    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)


}
declare 420 {deprecated {Use Tcl_StringCaseMatch}} {
    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
	    const Tcl_UniChar *uniPattern, int nocase)


}
declare 421 {
    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)


}
declare 422 {
    Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
	    const void *key, int *newPtr)

}
declare 423 {
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
declare 425 {
    ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *procPtr,
	    ClientData prevClientData)
}
declare 426 {
    int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 427 {
    void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 428 {
    char *Tcl_AttemptAlloc(unsigned int size)
}
declare 429 {
    char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line)
}
declare 430 {
    char *Tcl_AttemptRealloc(char *ptr, unsigned int size)
}
declare 431 {
    char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}
declare 432 {
    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

declare 435 {deprecated {}} {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)


}
declare 436 {deprecated {}} {
    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
	    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,
	    Tcl_Obj **objPtrRef)
}
declare 454 {
    int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
declare 455 {
    int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)







|







1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
	    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 *CONST86 *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
    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)
}
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)
}
declare 469 {
    const void *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)
}
declare 474 {
    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
}
declare 475 {
    void *Tcl_FSData(const 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)
}
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)
}

# TIP#56 (evaluate a parsed script) msofer
declare 481 {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    size_t 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_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
    int Tcl_SetCommandInfoFromToken(Tcl_Command token,







|










|














|





|






|
















|










|







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
    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 {
    ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
	    const 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,
	    ClientData clientData)
}
declare 469 {
    const void *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(ClientData clientData, const Tcl_Filesystem *fsPtr)
}
declare 474 {
    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
}
declare 475 {
    ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
}
declare 476 {
    const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr)
}
declare 477 {
    CONST86 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)
}

# TIP#56 (evaluate a parsed script) msofer
declare 481 {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    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, ClientData clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
    int Tcl_SetCommandInfoFromToken(Tcl_Command token,
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
	    const 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)
}
declare 507 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 508 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)







|







1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
	    const 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,
	    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

# 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#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
declare 521 {
    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData)
}
declare 522 {
    int Tcl_LimitReady(Tcl_Interp *interp)
}
declare 523 {
    int Tcl_LimitCheck(Tcl_Interp *interp)
}







|
|
|
<
>




|




|







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

# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
declare 518 {
    int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
	    const char *encodingName)
}

# TIP#121 (exit handler) dkf for Joe Mistachkin
declare 519 {nostub {Don't use this function in a stub-enabled extension}} {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)

}

# TIP#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
declare 521 {
    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
	    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
	    Tcl_Namespace **namespacePtrPtr)
}

# TIP#233 (virtualized time) akupries
declare 552 {
    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
	    Tcl_ScaleTimeProc *scaleProc,
	    void *clientData)
}
declare 553 {
    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
	    Tcl_ScaleTimeProc **scaleProc,
	    void **clientData)
}

# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
declare 554 {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
	    const Tcl_ChannelType *chanTypePtr)
}







|




|







1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
	    Tcl_Namespace **namespacePtrPtr)
}

# TIP#233 (virtualized time) akupries
declare 552 {
    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
	    Tcl_ScaleTimeProc *scaleProc,
	    ClientData clientData)
}
declare 553 {
    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
	    Tcl_ScaleTimeProc **scaleProc,
	    ClientData *clientData)
}

# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
declare 554 {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
	    const Tcl_ChannelType *chanTypePtr)
}
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
}

# 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)
}
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,







|
|







2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
}

# 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, 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,
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
}

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







|















|






|
|







|
|





|







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
}

# ----- BASELINE -- FOR -- 8.5.0 ----- #

# TIP #285 (script cancellation support) jmistachkin
declare 580 {
    int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
	    ClientData 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, ClientData 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,
	    ClientData data0, ClientData data1, ClientData data2,
	    ClientData 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,
	    ClientData 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 {
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
# 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 {
    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)
}







|



|



|


















|
<







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
# 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,
	    int buffersize, Tcl_Obj *gzipHeaderDictObj)
}
declare 612 {
    unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
	    int len)
}
declare 613 {
    unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
	    int len)
}
declare 614 {
    int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
	    int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
}
declare 615 {
    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, int count)

}
declare 620 {
    int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
}
declare 621 {
    int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
}
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400

# ----- BASELINE -- FOR -- 8.6.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)
}







|







2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337

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

# TIP #456
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
	    ClientData callbackData)
}

# TIP #430
declare 632 {
    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
	    const char *zipname, const char *passwd)
}
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425

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







|







2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362

# TIP #445
declare 636 {
    void Tcl_FreeIntRep(Tcl_Obj *objPtr)
}
declare 637 {
    char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
	    unsigned int 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)
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
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)

#declare 0 win {
#    TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr)
#}

#declare 1 win {
#    char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr)
#}


################################
# 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 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, size_t maxPathLen, char *libraryPath)
}

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

# Public functions that are not accessible via the stubs table.




export {
    void Tcl_MainEx(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)







|




|








|



|


















|

|
|
<
>
|
|
<
>




<
|
|
|
|
<
>



|






>
>
>







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
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, int size)
}

declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int endValue, int *indexPtr)
}

# TIP #548
declare 646 {
    int Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {
    char *Tcl_UniCharToUtfDString(const int *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 648 {
    int *Tcl_UtfToUniCharDString(const char *src,
	    int 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

declare 0 win {
    TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)

}
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)

}

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


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

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

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

# Public functions that are not accessible via the stubs table.

export {
    void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
}
export {
    void Tcl_MainEx(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)
Changes to generic/tcl.h.
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58






59









60
61
62
63
64
65
66
67
68
69
70
71
72



73

74
75
76
77
78
79
80
 * README		(sections 0 and 2, with and without separator)
 * 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)
 */

#define TCL_MAJOR_VERSION   9
#define TCL_MINOR_VERSION   0
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  2

#define TCL_VERSION	    "9.0"
#define TCL_PATCH_LEVEL	    "9.0a2"







#if defined(RC_INVOKED)









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







|
|

|

|
|

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













>
>
>
|
>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
 * README		(sections 0 and 2, with and without separator)
 * 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)
 */

#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   7
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  4

#define TCL_VERSION	    "8.7"
#define TCL_PATCH_LEVEL	    "8.7a4"

#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
 *----------------------------------------------------------------------------
 * The following definitions set up the proper options for Windows compilers.
 * We use this method because there is no autoconf equivalent.
 */

#ifdef _WIN32
#   ifndef __WIN32__
#	define __WIN32__
#   endif
#   ifndef WIN32
#	define WIN32
#   endif
#endif

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

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

/*
 * A special definition used to allow this header file to be included from
 * windows resource files so that they can obtain version information.
 * RC_INVOKED is defined by default by the windows RC tool.
 *
 * Resource compilers don't like all the C stuff, like typedefs and function
97
98
99
100
101
102
103

















104
105
106
107

108



109
110
111
112
113
114
115
 * 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 */







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




>
|
>
>
>







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
 * 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>

/*
 *----------------------------------------------------------------------------
 * Support for functions with a variable number of arguments.
 *
 * 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.
 */

#include <stdarg.h>
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#    define TCL_VARARGS(type, name) (type name, ...)
#    define TCL_VARARGS_DEF(type, name) (type name, ...)
#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#endif /* !TCL_NO_DEPRECATED */
#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))
#   if defined(BUILD_tcl) || defined(BUILD_tk)
#	define TCL_NORETURN1 __attribute__ ((noreturn))
#   else
#	define TCL_NORETURN1 /* nothing */
#   endif
#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 */
197
198
199
200
201
202
203








204


















205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222



























223
224
225

226


227
228
229
230
231
232
233
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif









#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)


















#      define CONST86 const
#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

/*



























 * Miscellaneous declarations.
 */


typedef void *ClientData;



/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__







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


















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



>
|
>
>







237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

/*
 * The following _ANSI_ARGS_ macro is to support old extensions
 * written for older versions of Tcl where it permitted support
 * for compilers written in the pre-prototype era of C.
 *
 * New code should use prototypes.
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   undef _ANSI_ARGS_
#   define _ANSI_ARGS_(x)	x

/*
 * Definitions that allow this header file to be used either with or without
 * ANSI C features.
 */

#ifndef INLINE
#   define INLINE
#endif
#ifndef CONST
#   define CONST const
#endif

#endif /* !TCL_NO_DEPRECATED */

#ifndef CONST86
#      define CONST86 const
#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(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#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__
#   define VOID void
#endif
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */

/*
 * Miscellaneous declarations.
 */

#ifndef _CLIENTDATA
    typedef void *ClientData;
#   define _CLIENTDATA
#endif

/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
 *
 * 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(_MSC_VER) || defined(_WIN32)
#      define TCL_WIDE_INT_TYPE __int64
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#   elif defined(__GNUC__)
#      define TCL_Z_MODIFIER	"z"







|







357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
 *
 * 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)
#      define TCL_WIDE_INT_TYPE __int64
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#   elif defined(__GNUC__)
#      define TCL_Z_MODIFIER	"z"
304
305
306
307
308
309
310



311





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

327
328
329
330
331
332
333
#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;

    } Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
    typedef struct stat64 Tcl_StatBuf;
#else
    typedef struct stat Tcl_StatBuf;
#endif








>
>
>
|
>
>
>
>
>












|
|
|
>







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
#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)
#   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
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif /* _MSC_VER < 1400 */
#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 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

347
348
349
350
351
352
353
354










355
356
357
358
359
360
361
 * "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_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;







|
>
>
>
>
>
>
>
>
>
>







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
 * "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
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
    char *resultDontUse; /* Don't use in extensions! */
    void (*freeProcDontUse) (char *); /* Don't use in extensions! */
    int errorLineDontUse; /* Don't use in extensions! */
}
#endif /* !TCL_NO_DEPRECATED */
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;
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
 *----------------------------------------------------------------------------
 * 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);
#else
typedef void (Tcl_ThreadCreateProc) (void *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.
 */







|

|







493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 *----------------------------------------------------------------------------
 * 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) (ClientData clientData);
#else
typedef void (Tcl_ThreadCreateProc) (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.
 */
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
/*
 * 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
				 * match. */
    size_t end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    size_t 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
				 * might begin. */

} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */








|

|




|


|

>







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
/*
 * 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 {
    long start;			/* Character offset of first character in
				 * match. */
    long end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    int nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    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.
 */

495
496
497
498
499
500
501




502
503
504
505
506
507
508
509
510
511





















512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556


557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585

#define TCL_OK			0
#define TCL_ERROR		1
#define TCL_RETURN		2
#define TCL_BREAK		3
#define TCL_CONTINUE		4





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






















/*
 * 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);

/*
 *----------------------------------------------------------------------------
 * 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.







>
>
>
>










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













|

|
|
|
|

|

|
|


|


|


|

|
|
|
|
|
|

|
|
|

>
>
|
|




|

|


|

|


|

|

|
|







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

#define TCL_OK			0
#define TCL_ERROR		1
#define TCL_RETURN		2
#define TCL_BREAK		3
#define TCL_CONTINUE		4

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE		200
#endif

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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
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;
#else
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
#endif

/*
 * 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) (ClientData clientData, Tcl_Interp *interp,
	int code);
typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
typedef void (Tcl_CloseProc) (ClientData data);
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	ClientData cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (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) (ClientData clientData);
typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags);
typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData);
typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags);
typedef void (Tcl_ExitProc) (ClientData clientData);
typedef void (Tcl_FileProc) (ClientData clientData, int mask);
typedef void (Tcl_FileFreeProc) (ClientData clientData);
typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
typedef void (Tcl_FreeProc) (char *blockPtr);
typedef void (Tcl_IdleProc) (ClientData clientData);
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
	Tcl_Interp *interp);
typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
	Tcl_Value *args, Tcl_Value *resultPtr);
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
typedef int (Tcl_ObjCmdProc) (ClientData 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) (ClientData callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (ClientData clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
	const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
	const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
	ClientData clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (ClientData clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef ClientData (Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
typedef void (Tcl_MainLoopProc) (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.
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
/*
 * 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. */
    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
				 * 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
				 * including the terminating null. */
    const 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: */
} Tcl_Obj;


/*
 *----------------------------------------------------------------------------
 * The following type contains the state needed by Tcl_SaveResult. It

 * is typically allocated on the stack.
 */









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







|





|





|











|
>
|


>
>
>
>
>
>
>
>
|















|







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
/*
 * 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 {
    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 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. */
    int length;			/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const 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: */
} Tcl_Obj;


/*
 *----------------------------------------------------------------------------
 * 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[200+1];
} 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 ::. */
    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
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

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. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    void *clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    void *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
				 * string. */
    size_t 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)




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

#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







|

|



|



















|

|








>
>
>



|
|







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

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. */
    ClientData objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    ClientData clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    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. */
    int length;			/* Number of non-NULL characters in the
				 * string. */
    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)
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   define Tcl_DStringTrunc Tcl_DStringSetLength
#endif /* !TCL_NO_DEPRECATED */

/*
 * Definitions for the maximum number of digits of precision that may be
 * 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
875
876
877
878
879
880
881




882
883
884
885
886
887
888
#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_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif







>
>
>
>







1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
#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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_INTERP_DESTROYED	 0x100
#endif

#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif
903
904
905
906
907
908
909











910
911
912
913
914
915
916
 */

#define TCL_TRACE_RENAME	0x2000
#define TCL_TRACE_DELETE	0x4000

#define TCL_ALLOW_INLINE_COMPILATION 0x20000












/*
 * Types for linked variables:
 */

#define TCL_LINK_INT		1
#define TCL_LINK_DOUBLE		2
#define TCL_LINK_BOOLEAN	3







>
>
>
>
>
>
>
>
>
>
>







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

#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)
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#   define TCL_PARSE_PART1	0x400
#endif /* !TCL_NO_DEPRECATED */

/*
 * Types for linked variables:
 */

#define TCL_LINK_INT		1
#define TCL_LINK_DOUBLE		2
#define TCL_LINK_BOOLEAN	3
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950

/*
 *----------------------------------------------------------------------------
 * 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);







|







1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE unsigned
#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);
958
959
960
961
962
963
964
965


966
967
968
969
970
971
972
973
 * 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. */
    size_t hash;		/* Hash value. */


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







|
>
>
|







1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
 * 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. */
    void *hash;			/* Hash value, stored as pointer to ensure
				 * that the offsets of the fields in this
				 * structure are not changed. */
    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. */
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
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
				 * **bucketPtr. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t 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 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);
    const 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
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:







|

|

|

<



>




















|







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
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). */
    int numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */

    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);
    const 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. */
    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:
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
 * 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. */
    Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
} Tcl_DictSearch;

/*
 *----------------------------------------------------------------------------
 * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of







|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
 * dictionaries. These fields should not be accessed by code outside
 * tclDictObj.c
 */

typedef struct {
    void *next;			/* Search position for underlying hash
				 * table. */
    unsigned int epoch; 	/* Epoch marker for dictionary being searched,
				 * or 0 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
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
 */

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

/*
 * TIP #233 (Virtualized Time)
 */

typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, void *clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);

/*
 *----------------------------------------------------------------------------
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
 * indicate what sorts of events are of interest:
 */








|
|





|
|







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
 */

typedef struct Tcl_Time {
    long sec;			/* Seconds. */
    long usec;			/* Microseconds. */
} Tcl_Time;

typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);

/*
 * TIP #233 (Virtualized Time)
 */

typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, ClientData clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);

/*
 *----------------------------------------------------------------------------
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
 * indicate what sorts of events are of interest:
 */

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
#define TCL_CLOSE_WRITE		(1<<2)

/*
 * Value to use as the closeProc for a channel that supports the close2Proc
 * interface.
 */

#define TCL_CLOSE2PROC		NULL

/*
 * Channel version tag. This was introduced in 8.3.2/8.4.
 */







#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);
/*
 * TIP #218, Channel Thread Actions
 */
typedef void	(Tcl_DriverThreadActionProc) (void *instanceData,
			int action);
/*
 * TIP #208, File Truncation (etc.)
 */
typedef int	(Tcl_DriverTruncateProc) (void *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
				 * commands. This storage is owned by channel
				 * type. */
    Tcl_ChannelTypeVersion version;
				/* Version of the channel type. */
    void *closeProc;


				/* Not used any more. */
    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_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. */



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



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




    Tcl_DriverThreadActionProc *threadActionProc;
				/* Function to call to notify the driver of
				 * thread specific activity for a channel. May
				 * be NULL. */




    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;

/*







|





>
>
>
>
>
>













|
|
>
|

|

|

|
>
|


|


|
|
|
|
|

|




|




|



















|
>
>
|




|
>
|

















>
>
>







>
>
>





>
>
>
>




>
>
>
>







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
#define TCL_CLOSE_WRITE		(1<<2)

/*
 * Value to use as the closeProc for a channel that supports the close2Proc
 * interface.
 */

#define TCL_CLOSE2PROC		((Tcl_DriverCloseProc *) 1)

/*
 * Channel version tag. This was introduced in 8.3.2/8.4.
 */

#ifndef TCL_NO_DEPRECATED
#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)
#endif
#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) (ClientData instanceData, int mode);
typedef int	(Tcl_DriverCloseProc) (ClientData instanceData,
			Tcl_Interp *interp);
typedef int	(Tcl_DriverClose2Proc) (ClientData instanceData,
			Tcl_Interp *interp, int flags);
typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
			int toRead, int *errorCodePtr);
typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
			const char *buf, int toWrite, int *errorCodePtr);
typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
			int mode, int *errorCodePtr);
typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, const char *optionName,
			const char *value);
typedef int	(Tcl_DriverGetOptionProc) (ClientData instanceData,
			Tcl_Interp *interp, const char *optionName,
			Tcl_DString *dsPtr);
typedef void	(Tcl_DriverWatchProc) (ClientData instanceData, int mask);
typedef int	(Tcl_DriverGetHandleProc) (ClientData instanceData,
			int direction, ClientData *handlePtr);
typedef int	(Tcl_DriverFlushProc) (ClientData instanceData);
typedef int	(Tcl_DriverHandlerProc) (ClientData instanceData,
			int interestMask);
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData,
			Tcl_WideInt offset, int mode, int *errorCodePtr);
/*
 * TIP #218, Channel Thread Actions
 */
typedef void	(Tcl_DriverThreadActionProc) (ClientData instanceData,
			int action);
/*
 * TIP #208, File Truncation (etc.)
 */
typedef int	(Tcl_DriverTruncateProc) (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
				 * commands. This storage is owned by channel
				 * type. */
    Tcl_ChannelTypeVersion version;
				/* Version of the channel type. */
    Tcl_DriverCloseProc *closeProc;
				/* Function to call to close the channel, or
				 * NULL 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. */
    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;

/*
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
/* 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 struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 */







|








|


|
|
|
|







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
/* 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 *CONST86 * (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,
	ClientData *clientDataPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData);
typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData);
typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData);
typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);

typedef struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 */
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
 * 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
				 * compatibility can be assured. */
    Tcl_FSVersion version;	/* Version of the filesystem type. */
    Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
				/* Determines whether the pathname is in this
				 * filesystem. This is the most important
				 * filesystem function. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;







|







1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
 * 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. */
    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
				 * filesystem. This is the most important
				 * filesystem function. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
 * 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,
				 * this field tells how many of them there are
				 * (including components of components, etc.).
				 * The component tokens immediately follow
				 * this one. */
} Tcl_Token;

/*







|
|







1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
 * 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. */
    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;

/*
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceeded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is







|







1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
 *				is described by a TCL_TOKEN_SUB_EXPR token
 *				followed by the TCL_TOKEN_OPERATOR token for
 *				the operator, then TCL_TOKEN_SUB_EXPR tokens
 *				for the left then the right operands.
 * TCL_TOKEN_OPERATOR -		The token describes one expression operator.
 *				An operator might be the name of a math
 *				function such as "abs". A TCL_TOKEN_OPERATOR
 *				token is always preceded by one
 *				TCL_TOKEN_SUB_EXPR token for the operator's
 *				subexpression, and is followed by zero or more
 *				TCL_TOKEN_SUB_EXPR tokens for the operator's
 *				operands. NumComponents is always 0.
 * TCL_TOKEN_EXPAND_WORD -	This token is just like TCL_TOKEN_WORD except
 *				that it marks a word that began with the
 *				literal character prefix "{*}". This word is
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    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
				 * 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
				 * command. */
    int commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the







|







1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    const char *commentStart;	/* Pointer to # that begins the first of one
				 * or more comments preceding the command. */
    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
				 * command. */
    int commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
				 * 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;







|


|







2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
				 * 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;
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924

1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
#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.
 */

#ifndef TCL_UTF_MAX
#define TCL_UTF_MAX		4
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */








|
<
|
>
|



|







2112
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
#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 2-bytes in size (UTF-16) (the default). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UTF-16 mode
 * is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#define TCL_UTF_MAX		3
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
#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);

#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







|
|







2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
#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) (ClientData clientData, Tcl_Interp *interp);
typedef void (Tcl_LimitHandlerDeleteProc) (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
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
				 * 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;

/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */








|







2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
				 * 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. */
    ClientData clientData;	/* Word to pass to function callbacks. */
} Tcl_ArgvInfo;

/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */

2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
#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 \







|

|







2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
#define TCL_ARGV_END		23

/*
 * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
 * argument types:
 */

typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr,
	void *dstPtr);
typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *const *objv, void *dstPtr);

/*
 * Shorthand for commonly used argTable entries.
 */

#define TCL_ARGV_AUTO_HELP \
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
 *----------------------------------------------------------------------------
 * 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.
 */

#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))

/*
 * 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);
#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) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \







|


|
|
|






|








|













|

|







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
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
 */
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)

/*
 * Constants for special int-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	(-1)
#define TCL_AUTO_LENGTH	(-1)
#define TCL_INDEX_NONE	(-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables.
 */

#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);
#if defined(_WIN32)
    TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
#endif

#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
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
/*
 * 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_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(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

/*







|





<
<
<
<
<
<
<
<







2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385








2386
2387
2388
2389
2390
2391
2392
/*
 * 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 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_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);








#ifdef _WIN32
EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
#endif

/*
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
#   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.

 */


#ifndef BUILD_tcl
#   define ckalloc Tcl_Alloc

#   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))
#   else
#	define ckfree Tcl_Free
#	define ckrealloc Tcl_Realloc
#	define attemptckrealloc Tcl_AttemptRealloc
#   endif
#endif

#ifndef 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.
 */











#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)








|
|
>


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

|







>
>
>
>
>
>
>
>
>
>







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
#   define TCLAPI MODULE_SCOPE
#endif

#include "tclPlatDecls.h"

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

#   define ckalloc(x) \
    ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__))
#   define ckfree(x) \


    Tcl_DbCkfree((char *)(x), __FILE__, __LINE__)
#   define ckrealloc(x,y) \
    ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))

#   define attemptckalloc(x) \
    ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__))
#   define attemptckrealloc(x,y) \
    ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))


#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) \
    ((void *) Tcl_Alloc((unsigned)(x)))
#   define ckfree(x) \
    Tcl_Free((char *)(x))
#   define ckrealloc(x,y) \
    ((void *) Tcl_Realloc((char *)(x), (unsigned)(y)))
#   define attemptckalloc(x) \
    ((void *) Tcl_AttemptAlloc((unsigned)(x)))
#   define attemptckrealloc(x,y) \
    ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y)))
#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)

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

/*
 *----------------------------------------------------------------------------
 * 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_GetHashKey(tablePtr, h) \
	((void *) (((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:
 */


#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))

#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)

































#endif /* RC_INVOKED */

/*
 * end block for C++
 */

#ifdef __cplusplus







|











>


>



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







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

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((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))
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)

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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 * These function have been renamed. The old names are deprecated, but we
 * define these macros for backwards compatibility.
 */

#   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

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

extern Tcl_AppInitProc Tcl_AppInit;

#endif /* !TCL_NO_DEPRECATED */

#endif /* RC_INVOKED */

/*
 * end block for C++
 */

#ifdef __cplusplus
Changes to generic/tclAlloc.c.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

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

#if USE_TCLALLOC

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

#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 * 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(USE_TCLALLOC) && 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__)
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    union overhead *overPtr;
    size_t bucket;
    size_t 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);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;







|



|


















|
|







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    union overhead *overPtr;
    size_t bucket;
    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 = (struct block *) TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes, 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

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

	Tcl_MutexUnlock(allocMutexPtr);
	return (void *)(overPtr+1);
    }

    /*
     * Convert amount of memory requested into closest block size stored in
     * hash buckets which satisfies request. Account for space used per block
     * for accounting.
     */







|







300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

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

	Tcl_MutexUnlock(allocMutexPtr);
	return (char *)(overPtr+1);
    }

    /*
     * Convert amount of memory requested into closest block size stored in
     * hash buckets which satisfies request. Account for space used per block
     * for accounting.
     */
401
402
403
404
405
406
407

408
409
410
411
412
413
414
415
    size = ((size_t)1) << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);


    blockPtr = TclpSysAlloc(sizeof(struct block) + amount);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;








>
|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    size = ((size_t)1) << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc(
	    (sizeof(struct block) + amount), 1);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;








|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *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;

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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpAlloc
void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    return malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpFree
void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}







<


|




















<







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


void *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    return malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    return realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */








|







738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    return realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */

Changes to generic/tclAssembly.c.
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
				 * stack. */
};

/*
 * Source instruction type recognized by the assembler.
 */

typedef enum TalInstType {
    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_GET_DEF,		/* 'dict getwithdefault' - consumes N+2
				 * 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







|













<
<







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147


148
149
150
151
152
153
154
				 * 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
185
186
187
188
189
190
191
192
193


194
195
196
197
198
199
200
    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 */


} TalInstType;

/*
 * Description of an instruction recognized by the assembler.
 */

typedef struct TalInstDesc {







|

>
>







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    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 {
405
406
407
408
409
410
411

412
413
414
415
416
417
418
    {"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},







>







405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
    {"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},
    {"land",		ASSEM_1BYTE,	INST_LAND,		2,	1},
    {"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},
432
433
434
435
436
437
438

439
440
441
442
443
444
445
    {"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},







>







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
    {"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},
    {"lor",		ASSEM_1BYTE,	INST_LOR,		2,	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},
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
     * On failure, report error line.
     */

    if (codePtr == NULL) {
	Tcl_AddErrorInfo(interp, "\n    (\"");
	Tcl_AppendObjToErrorInfo(interp, objv[0]);
	Tcl_AddErrorInfo(interp, "\" body, line ");
	backtrace = Tcl_NewWideIntObj(Tcl_GetErrorLine(interp));
	Tcl_AppendObjToErrorInfo(interp, backtrace);
	Tcl_AddErrorInfo(interp, ")");
	return TCL_ERROR;
    }

    /*
     * Use NRE to evaluate the bytecode from the trampoline.







|







811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
     * 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.
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
    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);







|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
    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 */
    int 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);
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
     */

    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;







|







986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		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;
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
		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) {







|












|
|







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
		parsePtr->commandStart - envPtr->source);

	/*
	 * Process the line of code.
	 */

	if (parsePtr->numWords > 0) {
	    int 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("  %4ld Assembling: ",
			(long)(envPtr->codeNext - envPtr->codeStart));
		TclPrintSource(stdout, parsePtr->commandStart,
			TclMin(instLen, 55));
		printf("\n");
	    }
#endif
	    if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
		if (flags & TCL_EVAL_DIRECT) {
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
     */

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







|






|







1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
     */

    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
	if (thisBB->jumpTarget != NULL) {
	    Tcl_DecrRefCount(thisBB->jumpTarget);
	}
	if (thisBB->foreignExceptions != NULL) {
	    ckfree(thisBB->foreignExceptions);
	}
	nextBB = thisBB->successor1;
	if (thisBB->jtPtr != NULL) {
	    DeleteMirrorJumpTable(thisBB->jtPtr);
	    thisBB->jtPtr = NULL;
	}
	ckfree(thisBB);
    }

    /*
     * Dispose what's left.
     */

    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
				/* 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 */
    enum 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 */







|



|







1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
				/* 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 */
    int 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 */
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
	    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);







|







1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}

	jtPtr = (JumptableInfo*)ckalloc(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);
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
     */

    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;







|







1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
     */

    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*)ckalloc(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;
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
	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.
     */








|







1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
	return TCL_ERROR;
    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo));
    jtHashPtr = &jtPtr->hashTable;
    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);

    /*
     * Fill the keys and labels into the table.
     */

2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
	    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 --
 *







|







2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
	    entry != NULL;
	    entry = Tcl_NextHashEntry(&search)) {
	label = (Tcl_Obj*)Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(label);
	Tcl_SetHashValue(entry, NULL);
    }
    Tcl_DeleteHashTable(jtHashPtr);
    ckfree(jtPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetNextOperand --
 *
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
    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)) {







|







2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
    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;
    int 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)) {
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
 */

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;







|







2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
 */

static BasicBlock *
AllocBB(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
    BasicBlock *bb = (BasicBlock*)ckalloc(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;
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
    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");







|







2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
    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");
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
	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");







|







3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
	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");
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
	}
    }

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







|
|







3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
	}
    }

    /*
     * Allocate memory for a stack of active catches.
     */

    catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*));
    catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int));
    for (i = 0; i < maxCatchDepth; ++i) {
	catches[i] = NULL;
	catchIndices[i] = -1;
    }

    /*
     * Walk through the basic blocks and manage exception ranges.
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
    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;
}

/*
 *-----------------------------------------------------------------------------
 *







|
|







3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
    if (catchDepth != 0) {
	Tcl_Panic("unclosed catch at end of code in "
		"tclAssembly.c:BuildExceptionRanges, can't happen");
    }

    /* Free temp storage */

    ckfree(catchIndices);
    ckfree(catches);

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
    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 ");
    lineNo = Tcl_NewWideIntObj(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 {







|







4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
    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 {
Changes to generic/tclAsync.c.
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->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    asyncPtr->originTsd = tsdPtr;
    asyncPtr->originThrdId = Tcl_GetCurrentThread();








|







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*)ckalloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    asyncPtr->originTsd = tsdPtr;
    asyncPtr->originThrdId = Tcl_GetCurrentThread();

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);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *







|







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);
    ckfree(asyncPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *
Changes to generic/tclBasic.c.
73
74
75
76
77
78
79












80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

#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
 * 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
 * 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 {
    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);








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
















|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

#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

/*
 * The following structure defines the client data for a math function
 * registered with Tcl_CreateMathFunc
 */

typedef struct OldMathFuncData {
    Tcl_MathProc *proc;		/* Handler function */
    int numArgs;		/* Number of args expected */
    Tcl_ValueType *argTypes;	/* Types of the args */
    ClientData clientData;	/* Client data for the handler function */
} OldMathFuncData;

/*
 * This is the script cancellation struct and hash table. The hash table is
 * 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
 * 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 {
    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. */
    int 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);

174
175
176
177
178
179
180




181
182
183
184
185
186
187
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,







>
>
>
>







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
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;

#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc	OldMathFuncProc;
static void		OldMathFuncDeleteProc(ClientData clientData);
#endif /* !defined(TCL_NO_DEPRECATED) */
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,
268
269
270
271
272
273
274



275
276
277
278
279
280
281
    /*
     * 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},
    {"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},







>
>
>







284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    /*
     * 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},
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"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},
633
634
635
636
637
638
639
640
641
642
643




644
645
646
647
648
649
650
651
652
653
     * the Tcl_CallFrame structure (or vice versa).
     */

    if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
	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 ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 48)) {
	Tcl_Panic("<sys/stat.h> is not compatible with VS2005+");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);







|
|
|
<
>
>
>
>

|
|







652
653
654
655
656
657
658
659
660
661

662
663
664
665
666
667
668
669
670
671
672
673
674
675
     * the Tcl_CallFrame structure (or vice versa).
     */

    if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
    }

#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

     * 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 ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 40)) {
	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);
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

    /*
     * 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));
    interp = (Tcl_Interp *) iPtr;


    iPtr->legacyResult = NULL;

    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */

    iPtr->legacyFreeProc = (void (*) (void))-1;
    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.
     */

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







|


>
|
>
|
<
>
|

<
|






>
|












|
|
|
|







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

    /*
     * 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 *)ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

#ifdef TCL_NO_DEPRECATED
    iPtr->result = &tclEmptyString;
#else
    iPtr->result = iPtr->resultSpace;

#endif
    iPtr->freeProc = NULL;
    iPtr->errorLine = 0;

    TclNewObj(iPtr->objResultPtr);
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
    iPtr->extra.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.
     */

    iPtr->cmdFramePtr = NULL;
    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;
736
737
738
739
740
741
742






743
744
745
746
747
748
749
    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;







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







>
>
>
>
>
>







760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
    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;

#ifndef TCL_NO_DEPRECATED
    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;
#endif

    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) {
762
763
764
765
766
767
768
769
770
771



772
773
774
775
776
777
778
    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->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {







<
|

>
>
>







792
793
794
795
796
797
798

799
800
801
802
803
804
805
806
807
808
809
810
    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. */

    TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
#ifndef TCL_NO_DEPRECATED
    iPtr->resultSpace[0] = 0;
#endif
    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

    /*
     * 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,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;







|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844

    /*
     * 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 *)ckalloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842

    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;








|

|







858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874

    iPtr->chanMsg = NULL;

    /*
     * TIP #285, Script cancellation support.
     */

    TclNewObj(iPtr->asyncCancelMsg);

    cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;

874
875
876
877
878
879
880






881
882
883
884
885
886
887

    statsPtr->numLiteralsCreated = 0;
    statsPtr->totalLitStringBytes = 0.0;
    statsPtr->currentLitStringBytes = 0.0;
    memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */







    /*
     * Initialize the ensemble error message rewriting support.
     */

    TclResetRewriteEnsemble(interp, 1);

    /*







>
>
>
>
>
>







906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925

    statsPtr->numLiteralsCreated = 0;
    statsPtr->totalLitStringBytes = 0.0;
    statsPtr->currentLitStringBytes = 0.0;
    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);

    /*
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
		&& (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->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;







|







959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
		&& (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 *)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;
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(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);







|







1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	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);
1109
1110
1111
1112
1113
1114
1115





1116
1117
1118
1119
1120
1121
1122

    /*
     * 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);





    TclpSetVariables(interp);

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







>
>
>
>
>







1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165

    /*
     * 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);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#if TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
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
     * 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));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }

    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }
    if (TclZipfs_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    Tcl_Free(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *







|



|









|


|













|







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
     * 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", TclGetString(Tcl_GetObjResult(interp)));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }

    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }
    if (TclZipfs_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;

    ckfree(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *
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

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







|














|







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

            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_GetString(Tcl_GetObjResult(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_GetString(Tcl_GetObjResult(interp)));
            }
        }
    }

    return TCL_OK;
}

1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)Tcl_Alloc(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));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}







|






|







1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    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 *)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);
}
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    Tcl_Free(dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}

/*







|







1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    ckfree(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
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(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);
    } else {
	dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}








|






|







1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	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);
    } else {
	dPtr = (AssocData *)ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}

1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
    if (hPtr == NULL) {
	return;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    Tcl_Free(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --







|







1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
    if (hPtr == NULL) {
	return;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    ckfree(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
    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);







|

|







1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
    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) {
		ckfree(cancelInfo->result);
	    }
	    ckfree(cancelInfo);
	}

	Tcl_DeleteHashEntry(hPtr);
    }

    if (iPtr->asyncCancel != NULL) {
	Tcl_AsyncDelete(iPtr->asyncCancel);
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
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(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);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    Tcl_Free(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    Tcl_Free(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_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }







|




















|


|











|








>
>
>
>







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

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(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);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    ckfree(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.
     */

#ifndef TCL_NO_DEPRECATED
    Tcl_FreeResult(interp);
    iPtr->result = NULL;
#endif
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
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
    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }






    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);
	resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */







>
>
>
>
>
>

















|
|







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
    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }
#ifndef TCL_NO_DEPRECATED
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
	iPtr->appendResult = NULL;
    }
#endif
    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;
	ckfree(resPtr->name);
	ckfree(resPtr);
	resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */
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
	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;

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	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->loc != NULL) {
	    Tcl_Free(eclPtr->loc);
	}

	Tcl_Free(eclPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->lineBCPtr);
    Tcl_Free(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.
     */

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

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    Tcl_Free(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.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
    Tcl_Free(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);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *







|
|




|















|



|


|



|


















|












|










|







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
	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);
	    }
	    ckfree(cfPtr->line);
	    ckfree(cfPtr);
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
    ckfree(iPtr->linePBodyPtr);
    iPtr->linePBodyPtr = NULL;

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr);

	if (eclPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(eclPtr->path);
	}
	for (i=0; i< eclPtr->nuloc; i++) {
	    ckfree(eclPtr->loc[i].line);
	}

	if (eclPtr->loc != NULL) {
	    ckfree(eclPtr->loc);
	}

	ckfree(eclPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->lineBCPtr);
    ckfree(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.
     */

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

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    ckfree(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.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
    ckfree(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);

    ckfree(iPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(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







|







2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(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
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
    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).
	 */

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







|







2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
    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).
	 */

	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
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
	 * 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));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;







|







2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
	 * 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 *)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;
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
 * 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.

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







>







2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
 * 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.
 *
2619
2620
2621
2622
2623
2624
2625

















2626
2627
2628
2629
2630
2631
2632
2633
	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*

















	 * Command already exists; delete it. 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) {







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







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
	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*
	 * [***] 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;
	    return (Tcl_Command) cmdPtr;
	}

	/*
	 * 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) {
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
    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).
	 */

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







|







2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
    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).
	 */

	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
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
	 * 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));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;







|







2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
	 * 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 *)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;
2827
2828
2829
2830
2831
2832
2833







2834
2835
2836
2837
2838
2839
2840
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, argc, objv);
    }








    /*
     * 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++) {
	objPtr = objv[i];







>
>
>
>
>
>
>







2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, 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++) {
	objPtr = objv[i];
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921

    if ((newName == NULL) || (*newName == '\0')) {
	Tcl_DeleteCommandFromToken(interp, cmd);
	return TCL_OK;
    }

    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.







|







2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999

    if ((newName == NULL) || (*newName == '\0')) {
	Tcl_DeleteCommandFromToken(interp, cmd);
	return TCL_OK;
    }

    cmdNsPtr = cmdPtr->nsPtr;
    TclNewObj(oldFullName);
    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.
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
	    CommandTrace *nextPtr = tracePtr->nextPtr;

	    if (tracePtr->refCount-- <= 1) {
		Tcl_Free(tracePtr);
	    }
	    tracePtr = nextPtr;
	}
	cmdPtr->tracePtr = NULL;
    }

    /*







|







3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
	    CommandTrace *nextPtr = tracePtr->nextPtr;

	    if (tracePtr->refCount-- <= 1) {
		ckfree(tracePtr);
	    }
	    tracePtr = nextPtr;
	}
	cmdPtr->tracePtr = NULL;
    }

    /*
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
	 * 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()
	 * 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().
	 */

	cmdPtr->deleteProc(cmdPtr->deleteData);
    }

    /*
     * Don't use hPtr to delete the hash entry here, because it's possible







|

|
|







3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
	 * 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 ckalloc()
	 * macro and you are now trying to deallocate this memory with free()
	 * instead of ckfree(). You should pass a pointer to your own method
	 * that calls ckfree().
	 */

	cmdPtr->deleteProc(cmdPtr->deleteData);
    }

    /*
     * Don't use hPtr to delete the hash entry here, because it's possible
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
	if (state == NULL) {
	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
	}
	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
		oldName, newName, flags);
	cmdPtr->flags &= ~tracePtr->flags;
	if (tracePtr->refCount-- <= 1) {
	    Tcl_Free(tracePtr);
	}
    }

    if (state) {
	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }








|







3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
	if (state == NULL) {
	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
	}
	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
		oldName, newName, flags);
	cmdPtr->flags &= ~tracePtr->flags;
	if (tracePtr->refCount-- <= 1) {
	    ckfree(tracePtr);
	}
    }

    if (state) {
	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }

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

void
TclCleanupCommand(
    Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    if (cmdPtr->refCount-- <= 1) {
	Tcl_Free(cmdPtr);
    }
}










































































































































































































































































































































































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

int
TclInterpReady(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    /*
     * Reset the interpreter's result and clear out any previous error
     * information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */







|



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













|











|
|







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

void
TclCleanupCommand(
    Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    if (cmdPtr->refCount-- <= 1) {
	ckfree(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.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
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);
    TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
    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,	/* Pointer 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 = (OldMathFuncData *)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) {
	    const Tcl_ObjIntRep *irPtr
		    = TclFetchIntRep(valuePtr, &tclDoubleType);

	    if (irPtr) {
		d = irPtr->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, TclGetString(valuePtr));
	    ckfree(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 (TclGetWideIntFromObj(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(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(args);
		return TCL_ERROR;
	    }
	    valuePtr = Tcl_GetObjResult(interp);
	    TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
	    Tcl_ResetResult(interp);
	    break;
	}
    }

    /*
     * Call the function.
     */

    errno = 0;
    result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
    ckfree(args);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Return the result of the call.
     */

    if (funcResult.type == TCL_INT) {
	TclNewIntObj(valuePtr, funcResult.intValue);
    } else if (funcResult.type == TCL_WIDE_INT) {
	TclNewIntObj(valuePtr, 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 = (OldMathFuncData *)clientData;

    ckfree(dataPtr->argTypes);
    ckfree(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_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown math function \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
	*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 = (OldMathFuncData *)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 {
	TclNewObj(result);
    }
    Tcl_DecrRefCount(script);
    Tcl_RestoreInterpState(interp, state);

    return result;
}
#endif /* !defined(TCL_NO_DEPRECATED) */

/*
 *----------------------------------------------------------------------
 *
 * 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 interpreters object and string results are cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    /*
     * 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.
     */
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
    /*
     * 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) {







|







4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
    /*
     * 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;
        int length;

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    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;
    }
    cancelInfo->clientData = clientData;







|







4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;
4377
4378
4379
4380
4381
4382
4383
























4384
4385
4386
4387
4388
4389
4390
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);







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







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
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Interp *iPtr = (Interp *) interp;
#endif /* !defined(TCL_NO_DEPRECATED) */

    /*
     * 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.
     *
     * This only needs to be done for the first item in the list: all other
     * are for NR function calls, and those are Tcl_Obj based.
     */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
#endif /* !defined(TCL_NO_DEPRECATED) */

    /*
     * This is the trampoline.
     */

    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);
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
    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







|







4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int 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
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

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







|
|







5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * 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.
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
{
    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);
	}







|







5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
{
    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];
    int 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);
	}
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840


















































4841
4842
4843
4844
4845
4846
4847
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.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}



















































/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *
 *	This function evaluates a Tcl script without using the compiler or







|





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







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
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. */
    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *
 *	This function evaluates a Tcl script without using the compiler or
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
 */

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
				 * 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);
}

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







|














|







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

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. */
    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);
}

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. */
    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 */
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
{
    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;
    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







|
<







5420
5421
5422
5423
5424
5425
5426
5427

5428
5429
5430
5431
5432
5433
5434
{
    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 commandLength, bytesLeft, expandRequested, code = TCL_OK;

    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
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes == TCL_INDEX_NONE) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;







|







5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    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));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;







|
|
|







5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		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;
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
		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));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];







|
|







5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		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
			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    Tcl_Free(copy);
		}
		if (lcopy != linesStack) {
		    Tcl_Free(lcopy);
		}
	    }

	    /*
	     * Execute the command and free the objects for its words.
	     *
	     * TIP #280: Remember the command itself for 'info frame'. We







|


|







5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    ckfree(copy);
		}
		if (lcopy != linesStack) {
		    ckfree(lcopy);
		}
	    }

	    /*
	     * Execute the command and free the objects for its words.
	     *
	     * TIP #280: Remember the command itself for 'info frame'. We
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
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }
	    objectsUsed = 0;
	    if (objvSpace != stackObjArray) {
		Tcl_Free(objvSpace);
		objvSpace = stackObjArray;
		Tcl_Free(lineSpace);
		lineSpace = linesStack;
	    }

	    /*
	     * Free expand separately since objvSpace could have been
	     * reallocated above.
	     */

	    if (expand != expandStack) {
		Tcl_Free(expand);
		expand = expandStack;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 *







|

|









|







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
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }
	    objectsUsed = 0;
	    if (objvSpace != stackObjArray) {
		ckfree(objvSpace);
		objvSpace = stackObjArray;
		ckfree(lineSpace);
		lineSpace = linesStack;
	    }

	    /*
	     * Free expand separately since objvSpace could have been
	     * reallocated above.
	     */

	    if (expand != expandStack) {
		ckfree(expand);
		expand = expandStack;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 *
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
    for (i = 0; i < objectsUsed; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
	Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
	Tcl_Free(objvSpace);
	Tcl_Free(lineSpace);
    }
    if (expand != expandStack) {
	Tcl_Free(expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */







|
|


|







5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
    for (i = 0; i < objectsUsed; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
	Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
	ckfree(objvSpace);
	ckfree(lineSpace);
    }
    if (expand != expandStack) {
	ckfree(expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
	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.
	     */

	    cfwPtr = (CFWord *)Tcl_Alloc(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







|







5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
	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.
	     */

	    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
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
	}
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	Tcl_Free(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *







|







6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
	}
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	ckfree(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    size_t pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =







|







6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
    int pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
     */

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

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;







|







6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
     */

    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 *)ckalloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}

	Tcl_Free(cfwPtr);
	cfwPtr = nextPtr;
    }

    cfPtr->litarg = NULL;
}

/*







|







6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}

	ckfree(cfwPtr);
	cfwPtr = nextPtr;
    }

    cfPtr->litarg = NULL;
}

/*
5768
5769
5770
5771
5772
5773
5774













































































5775
5776
5777
5778
5779
5780
5781
		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
	*cfPtrPtr = cfwPtr->framePtr;
	*wordPtr = cfwPtr->word;
	return;
    }
}














































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjEx, TclEvalObjEx --
 *
 *	Execute Tcl commands stored in a Tcl object. These commands are
 *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is







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







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
		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
	*cfPtrPtr = cfwPtr->framePtr;
	*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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_Eval
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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjEx, TclEvalObjEx --
 *
 *	Execute Tcl commands stored in a Tcl object. These commands are
 *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	size_t numSrcBytes;

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







|







6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 */

	const char *script;
	int numSrcBytes;

	/*
	 * 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
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}








|







6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    int numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

6153
6154
6155
6156
6157
6158
6159



6160
6161
6162
6163
6164
6165
6166

	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);



    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,		/* Context in which to evaluate the







>
>
>







6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758

	*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
6179
6180
6181
6182
6183
6184
6185



6186
6187
6188
6189
6190
6191
6192
	*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. */



    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,		/* Context in which to evaluate the







>
>
>







6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
	*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
    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);








	return result;
    }
}

/*
 *--------------------------------------------------------------
 *







>
>
>
>
>
>
>
>







6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
    } 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;
    }
}

/*
 *--------------------------------------------------------------
 *
6521
6522
6523
6524
6525
6526
6527






6528
6529
6530
6531
6532
6533
6534
	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);
	}
    }






    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --







>
>
>
>
>
>







7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
	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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --
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
 *	The value of the Tcl_obj is 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_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    const char *message = TclGetStringFromObj(objPtr, &length);
    Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);



































































    /*
     * 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) {













	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_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.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_VarEval(
    Tcl_Interp *interp,
    ...)
{
    va_list argList;
    int result;
    Tcl_DString buf;
    char *string;


    va_start(argList, interp);
    /*
     * 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 Tcl_Alloc 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_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    Tcl_DStringFree(&buf);
    return result;
}








































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetRecursionLimit --
 *
 *	Set the maximum number of recursive calls that may be active for an
 *	interpreter at once.







>






<
|
<


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








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


















<



|

|






|




|



|
|
|

<
<


>

<



|
















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







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
 *	The value of the Tcl_obj is 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.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_AddObjErrorInfo
void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{

    const char *message = TclGetString(objPtr);


    Tcl_IncrRefCount(objPtr);
    Tcl_AddObjErrorInfo(interp, message, objPtr->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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    const char *message)	/* Message to record. */
{
    Tcl_AddObjErrorInfo(interp, message, -1);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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. */
{
    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 !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	if (*(iPtr->result) != 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(iPtr->result, -1);
	} else
#endif /* !defined(TCL_NO_DEPRECATED) */
	    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_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_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    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 interp->result.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_VarEval(
    Tcl_Interp *interp,
    ...)
{
    va_list argList;
    int result;

    va_start(argList, interp);
    result = Tcl_VarEvalVA(interp, argList);
    va_end(argList);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * 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
 *	out in the variable context of global level (no functions active),
 *	just as if an "uplevel #0" command were being executed.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_GlobalEval
int
Tcl_GlobalEval(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate
				 * command. */
    const char *command)	/* Command to evaluate. */
{
    Interp *iPtr = (Interp *) interp;
    int result;
    CallFrame *savedVarFramePtr;

    savedVarFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = iPtr->rootFramePtr;
    result = Tcl_EvalEx(interp, command, -1, 0);
    iPtr->varFramePtr = savedVarFramePtr;
    return result;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetRecursionLimit --
 *
 *	Set the maximum number of recursive calls that may be active for an
 *	interpreter at once.
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 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));
			return TCL_OK;
		    }







|







7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		int numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "too %s arguments for math function \"%s\"",
	    (found < expected ? "few" : "many"), name));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
}

#ifdef USE_DTRACE
/*
 *----------------------------------------------------------------------
 *







|
|







8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
	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));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
}

#ifdef USE_DTRACE
/*
 *----------------------------------------------------------------------
 *
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
	 * 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);








|







9502
9503
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
	 * 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);
	ckfree(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);

8806
8807
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
    /*
     * #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;







|







9561
9562
9563
9564
9565
9566
9567
9568
9569
9570
9571
9572
9573
9574
9575
    /*
     * #280.
     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
     * command arguments in bytecode.
     */

    Tcl_DeleteHashTable(corPtr->lineLABCPtr);
    ckfree(corPtr->lineLABCPtr);
    corPtr->lineLABCPtr = NULL;

    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
9215
            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.
     */







|







9956
9957
9958
9959
9960
9961
9962
9963
9964
9965
9966
9967
9968
9969
9970
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yieldto", -1));
        } else {
            /*
             * I don't think this is reachable...
             */

            Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj(nargs));
        }
        Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
    }

    /*
     * Call the user's script; we're in the right place.
     */
9420
9421
9422
9423
9424
9425
9426
9427
9428
9429
9430
9431
9432
9433
9434
    }

    /*
     * 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++;







|







10175
10176
10177
10178
10179
10180
10181
10182
10183
10184
10185
10186
10187
10188
10189
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
9442
9443
9444
9445
9446
9447
9448
9449
9450
9451
9452
9453
9454
9455
9456
     * 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,







|







10197
10198
10199
10200
10201
10202
10203
10204
10205
10206
10207
10208
10209
10210
10211
     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(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,
Changes to generic/tclBinary.c.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#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. */

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







|
|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
#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 -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 */
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
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 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);
/* 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[]);







|








|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
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,
			    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,
			    unsigned 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[]);
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
/*
 * 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 {
    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
				 * array. */
    size_t allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* 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)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return TclHasIntRep(objPtr, &properByteArrayType);
}








|
|


|

|










|
|







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
/*
 * 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 ByteArray {
    unsigned int bad;		/* Index of the character that is a nonbyte.
				 * If all characters are bytes, bad = used,
				 * though then we should never read it. */
    unsigned int used;		/* The number of bytes used in the byte
				 * array. */
    unsigned int allocated;	/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* 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 = (void *) (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return TclHasIntRep(objPtr, &properByteArrayType);
}

312
313
314
315
316
317
318
319

320
321
322
323
324
325
326

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

{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);







|
>







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

#undef Tcl_NewByteArrayObj

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. */
{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
 */

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

    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
				 * >= 0. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewByteArrayObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */







|
>
















|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
    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. */
    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. */
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewByteArrayObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421



422
423
424
425
426
427
428
429
 */

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. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclInvalidateStringRep(objPtr);




    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->bad = length;
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }







|










>
>
>
|







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
 */

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. */
    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");
    }
    TclInvalidateStringRep(objPtr);

    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->bad = length;
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
 *----------------------------------------------------------------------
 */

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







|



















|







454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
 *----------------------------------------------------------------------
 */

unsigned char *
TclGetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    int *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);
		nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
		TclUtfToUCS4(nonbyte, &ucs4);

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected byte sequence but character %d "
			"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
	    }
	    return NULL;
	}
    }
    baPtr = GET_BYTEARRAY(irPtr);
508
509
510
511
512
513
514
515

516
517
518


519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

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;
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);

	assert(irPtr != NULL);

	baPtr = GET_BYTEARRAY(irPtr);
	bytes = baPtr->bytes;
	numBytes = baPtr->used;
    }

    /* Macro TclGetByteArrayFromObj passes NULL for lengthPtr as
     * a trick to get around changing size. */
    if (lengthPtr) {
	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;
	    return NULL;
	} else {
	    *lengthPtr = (int) numBytes;
	}
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *







|
>
|

|
>
>
|
|
<
|

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







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528

529
530
531


532



533





534



535

536
537
538
539
540
541
542
543

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. */
{
    ByteArray *baPtr;
    const Tcl_ObjIntRep *irPtr;
    unsigned char *result = TclGetBytesFromObj(NULL, objPtr, lengthPtr);

    if (result) {
	return result;
    }

    irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);

    assert(irPtr != NULL);

    baPtr = GET_BYTEARRAY(irPtr);






    if (lengthPtr != NULL) {





	*lengthPtr = baPtr->used;



    }

    return 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
608
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t 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 (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
    byteArrayPtr->bad = length;
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * SetByteArrayFromAny --







|


>


>
>
>

















|
|
|




|
|







557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;
    unsigned newLength;
    Tcl_ObjIntRep *irPtr;

    assert(length >= 0);
    newLength = (unsigned int)length;

    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 (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    if (newLength > byteArrayPtr->allocated) {
	byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
	byteArrayPtr->allocated = newLength;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
    byteArrayPtr->bad = newLength;
    byteArrayPtr->used = newLength;
    return byteArrayPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * SetByteArrayFromAny --
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = TclGetStringFromObj(objPtr, &length);
    bad = length;
    srcEnd = src + length;

    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	if ((bad == length) && (ch > 255)) {
	    bad = dst - byteArrayPtr->bytes;
	}
	*dst++ = UCHAR(ch);
    }







|
|


|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = bad = objPtr->length;
    srcEnd = src + length;

    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	if ((bad == length) && (ch > 255)) {
	    bad = dst - byteArrayPtr->bytes;
	}
	*dst++ = UCHAR(ch);
    }
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
 *----------------------------------------------------------------------
 */

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
}

static void
FreeProperByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteArrayInternalRep --
 *







|






|







679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
 *----------------------------------------------------------------------
 */

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
}

static void
FreeProperByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ckfree(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
 */

static void
DupByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    size_t length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->bad = srcArrayPtr->bad;
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);







|






|







711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
 */

static void
DupByteArrayInternalRep(
    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, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->bad = srcArrayPtr->bad;
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
    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);







|







740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)ckalloc(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);
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
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
    unsigned char *src = byteArrayPtr->bytes;
    size_t i, length = byteArrayPtr->used;
    size_t size = length;

    /*
     * How much space will string rep need?
     */

    for (i = 0; i < length; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }




    if (size == length) {
	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);

	TclOOM(dst, size);
    } else {
	char *dst = Tcl_InitStringRep(objPtr, NULL, size);







|
|





|




>
>
>







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
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
    unsigned char *src = byteArrayPtr->bytes;
    unsigned int i, length = byteArrayPtr->used;
    unsigned int size = length;

    /*
     * How much space will string rep need?
     */

    for (i = 0; i < length && size <= INT_MAX; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }
    if (size > INT_MAX) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    if (size == length) {
	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);

	TclOOM(dst, size);
    } else {
	char *dst = Tcl_InitStringRep(objPtr, NULL, size);
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
 *----------------------------------------------------------------------
 */

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    size_t len)
{
    ByteArray *byteArrayPtr;
    size_t needed;
    Tcl_ObjIntRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len == TCL_INDEX_NONE) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
	 * Append zero bytes is a no-op.
	 */

	return;
    }



    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);

    if (len > UINT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_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;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * 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;

	    attempt = needed + growth;
	    ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
}

/*
 *----------------------------------------------------------------------
 *







|


|





|










>
>














|
|


|






|







|






|
|
|


|







|







|

|







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

void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    int len)
{
    ByteArray *byteArrayPtr;
    unsigned int length, needed;
    Tcl_ObjIntRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    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.
	 */

	return;
    }

    length = (unsigned int) len;

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);

    if (length > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    needed = byteArrayPtr->used + length;
    /*
     * If we need to, resize the allocated space in the byte array.
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	unsigned int attempt;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length);
    }
    byteArrayPtr->used += length;
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
}

/*
 *----------------------------------------------------------------------
 *
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
    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;
    }

    /*







|











|
<







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
    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. */
    int 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, length;


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

    /*
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
	     * 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') {







|







1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
	     * 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') {
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
			&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;







|







1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
			&listv) != TCL_OK) {
		    return TCL_ERROR;
		}
		arg++;

		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > listc) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "number of elements in list does not match count",
			    -1));
		    return TCL_ERROR;
		}
	    }
	    offset += count*size;
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
	    }
	    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;
    }

    /*







|


|





|















|







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

    /*
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
	}
	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);







|
|







1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
	}
	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, count);
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
	    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;







|














|







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
	    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++ = UCHAR(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;
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
	    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;
		    }







|




















|







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
	    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;
		    }
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
	    } 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;
	}







|







1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
	    } 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;
	}
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
	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) {







|







1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
	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) {
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
    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. */
    const char *errorString;
    const char *str;
    int offset, size, i;
    size_t length = 0;

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

	    /*

	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {







		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }







|








|
<












|











>
|












|








>
|


|
>
>
>
>
>
>
>







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
    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. */
    int 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. */
    const char *errorString;
    const char *str;
    int offset, size, length, i;


    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 = Tcl_GetByteArrayFromObj(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':
	case 'C': {
	    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;
		}
	    }

	    src = buffer + offset;
	    size = count;

	    /*
	     * Apply C string semantics or trim trailing
	     * nulls and spaces, if necessary.
	     */

	    if (cmd == 'C') {
		for (i = 0; i < size; i++) {
		    if (src[i] == '\0') {
			size = i;
			break;
		    }
		}
	    } else if (cmd == 'A') {
		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }
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
	    }
	    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 (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');
		}







|









|








|







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
	    }
	    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;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);

	    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');
		}
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    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];
		}







|








|







1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);

	    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];
		}
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

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

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







|














|




















|









|







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

	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;
		}
		TclNewObj(valuePtr);
		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 > offset)) {
		offset = 0;
	    } else {
		offset -= count;
	    }
	    break;
	case '@':
	    if (count == BINARY_NOCOUNT) {
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    const char **formatPtr,	/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    size_t *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {







|







1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
 *----------------------------------------------------------------------
 */

static int
GetFormatSpec(
    const char **formatPtr,	/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    int *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
 *----------------------------------------------------------------------
 */

static void
CopyNumber(
    const void *from,		/* source */
    void *to,			/* destination */
    size_t length,		/* Number of bytes to copy */
    int type)			/* What type of thing are we copying? */
{
    switch (NeedReversing(type)) {
    case 0:
	memcpy(to, from, length);
	break;
    case 1: {







|







2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
 *----------------------------------------------------------------------
 */

static void
CopyNumber(
    const void *from,		/* source */
    void *to,			/* destination */
    unsigned length,		/* Number of bytes to copy */
    int type)			/* What type of thing are we copying? */
{
    switch (NeedReversing(type)) {
    case 0:
	memcpy(to, from, length);
	break;
    case 1: {
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
    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;







|







|







2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data = NULL;
    unsigned char *cursor = NULL;
    int offset = 0, count = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(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;
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
    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;







|
<







2600
2601
2602
2603
2604
2605
2606
2607

2608
2609
2610
2611
2612
2613
2614
    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, size, pure = 1, count = 0, cut = 0, strict = 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;
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
    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;
}

/*
 *----------------------------------------------------------------------
 *







|
|







2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
    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 %d",
	    ucs4, ucs4, (int) (data - datastart - 1)));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
    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;







|
|
<







2725
2726
2727
2728
2729
2730
2731
2732
2733

2734
2735
2736
2737
2738
2739
2740
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0, purewrap = 1;

    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;
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
	}
    }
    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));








|







2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(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));

2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
    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;







|



|







2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int offset, count, rawLength, n, i, j, bits, index;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    int 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;
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
	    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':







|







2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
	    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;
		int numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
			case '\t':
			case '\v':
			case '\f':
			case '\r':
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
    /*
     * 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;

    /*







|







2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    TclNewObj(resultObj);
    offset = 0;
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
    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");







|
<







2994
2995
2996
2997
2998
2999
3000
3001

3002
3003
3004
3005
3006
3007
3008
    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, size, pure = 1, count = 0, strict = 0, lineLen;

    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");
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
  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;
}

/*
 *----------------------------------------------------------------------







|
|







3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
  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 %d",
	    ucs4, ucs4, (int) (data - datastart - 1)));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
    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;







|
<







3169
3170
3171
3172
3173
3174
3175
3176

3177
3178
3179
3180
3181
3182
3183
    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, 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;
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
	 * 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:
 */







|
|












3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
	 * 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 %d",
	    ucs4, ucs4, (int) (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.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#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
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;








|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#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 MemTag {
    size_t refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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...
 */

static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:







|







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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 ckalloc...
 */

static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284

    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,
		    (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);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u 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,
		    (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);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
		memHeaderP->length, memHeaderP->file,
		memHeaderP->line);
	Tcl_Panic("Memory validation failure");







|




|















|





|







243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284

    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 %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }
    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %p, %s %d\n",
		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,
		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 %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }

    if (guard_failed) {
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %p, %s %d\n",
		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, memHeaderP->file,
		memHeaderP->line);
	Tcl_Panic("Memory validation failure");
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkalloc - debugging Tcl_Alloc
 *
 *	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__
 *	and __LINE__.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_DbCkalloc(
    size_t 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 +
		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);
    }

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







|








|





|

|
















|
|







374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 ckalloc macro; it uses the preprocessor autodefines __FILE__
 *	and __LINE__.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DbCkalloc(
    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 +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	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.
     */
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
		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);
    }

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







|







455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"ckalloc %p %u %s %d\n",
		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);
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
    }

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

void *
Tcl_AttemptDbCkalloc(
    size_t 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 +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo(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.







|

|
















|







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

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

char *
Tcl_AttemptDbCkalloc(
    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 +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	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
		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);
    }

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







|







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"ckalloc %p %u %s %d\n",
		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);
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623

    return result->body;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkfree - debugging Tcl_Free
 *
 *	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
 *	__LINE__.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DbCkfree(
    void *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);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }








|








|







|




















|







571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623

    return result->body;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 ckfree macro; it uses the preprocessor autodefines __FILE__ and
 *	__LINE__.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DbCkfree(
    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, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
		memp->body, memp->length, file, line);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

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
    TclpFree(memp);
    Tcl_MutexUnlock(ckallocMutexPtr);
}

/*
 *--------------------------------------------------------------------
 *
 * Tcl_DbCkrealloc - debugging Tcl_Realloc
 *
 *	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 *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;








|









|

|
|







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
    TclpFree(memp);
    Tcl_MutexUnlock(ckallocMutexPtr);
}

/*
 *--------------------------------------------------------------------
 *
 * 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.
 *
 *--------------------------------------------------------------------
 */

char *
Tcl_DbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;

688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = (char *)Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

void *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;








|





|

|
|







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    struct mem_header *memp;

719
720
721
722
723
724
725
726
727
728
729
730
731
732
733

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = (char *)Tcl_AttemptDbCkalloc(size, file, line);
    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}







|







719
720
721
722
723
724
725
726
727
728
729
730
731
732
733

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, 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
 *
 * Side effects:
 *	Same as the debug versions.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_Alloc(
    size_t size)
{
    return Tcl_DbCkalloc(size, "unknown", 0);
}

void *
Tcl_AttemptAlloc(
    size_t size)
{
    return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}

void
Tcl_Free(
    void *ptr)
{
    Tcl_DbCkfree(ptr, "unknown", 0);
}

void *
Tcl_Realloc(
    void *ptr,
    size_t size)
{
    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
void *
Tcl_AttemptRealloc(
    void *ptr,
    size_t size)
{
    return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}

/*
 *----------------------------------------------------------------------
 *







|

|




|

|






|




|

|
|



|

|
|







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
 *
 * Side effects:
 *	Same as the debug versions.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Alloc(
    unsigned int size)
{
    return Tcl_DbCkalloc(size, "unknown", 0);
}

char *
Tcl_AttemptAlloc(
    unsigned int size)
{
    return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}

void
Tcl_Free(
    char *ptr)
{
    Tcl_DbCkfree(ptr, "unknown", 0);
}

char *
Tcl_Realloc(
    char *ptr,
    unsigned int size)
{
    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{
    return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}

/*
 *----------------------------------------------------------------------
 *
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
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_Alloc(
    size_t size)
{
    void *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);
    }
    return result;
}

void *
Tcl_DbCkalloc(
    size_t size,
    const char *file,
    int line)
{
    void *result = TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
		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 *
Tcl_AttemptAlloc(
    size_t size)
{
    return (char *)TclpAlloc(size);
}

void *
Tcl_AttemptDbCkalloc(
    size_t size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return (char *)TclpAlloc(size);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_Realloc(
    void *ptr,
    size_t size)
{
    void *result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size);
    }
    return result;
}

void *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    int line)
{
    void *result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
		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 *
Tcl_AttemptRealloc(
    void *ptr,
    size_t size)
{
    return (char *)TclpRealloc(ptr, size);
}

void *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return (char *)TclpRealloc(ptr, size);
}

/*
 *----------------------------------------------------------------------
 *
 * 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)
{
    TclpFree(ptr);
}

void
Tcl_DbCkfree(
    void *ptr,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    TclpFree(ptr);
}

/*







|

|

|












|




|

|



|



|
<















|

|




|

|

















|

|
|

|


|




|

|
|



|



|
<















|

|
|




|

|
|




















|






|







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
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Alloc(
    unsigned int size)
{
    char *result = (char *)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 %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkalloc(
    unsigned int size,
    const char *file,
    int line)
{
    char *result = (char *)TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", 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.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_AttemptAlloc(
    unsigned int size)
{
    return (char *)TclpAlloc(size);
}

char *
Tcl_AttemptDbCkalloc(
    unsigned int size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return (char *)TclpAlloc(size);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Realloc(
    char *ptr,
    unsigned int size)
{
    char *result = (char *)TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %u bytes", size);
    }
    return result;
}

char *
Tcl_DbCkrealloc(
    char *ptr,
    unsigned int size,
    const char *file,
    int line)
{
    char *result = (char *)TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %u bytes, %s line %d", 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.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_AttemptRealloc(
    char *ptr,
    unsigned int size)
{
    return (char *)TclpRealloc(ptr, size);
}

char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
    unsigned int size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return (char *)TclpRealloc(ptr, size);
}

/*
 *----------------------------------------------------------------------
 *
 * 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(
    char *ptr)
{
    TclpFree(ptr);
}

void
Tcl_DbCkfree(
    char *ptr,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    TclpFree(ptr);
}

/*
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
	curTagPtr = NULL;
    }
    allocHead = NULL;

    Tcl_MutexUnlock(ckallocMutexPtr);
#endif

#if USE_TCLALLOC
    TclFinalizeAllocSubsystem();
#endif
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







|













1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
	curTagPtr = NULL;
    }
    allocHead = NULL;

    Tcl_MutexUnlock(ckallocMutexPtr);
#endif

#if defined(USE_TCLALLOC) && 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.
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
    Tcl_Obj **literals;		/* Pool of object literals. */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

typedef struct {
    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 */







|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
    Tcl_Obj **literals;		/* Pool of object literals. */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

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 */
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)Tcl_Alloc(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.







|

|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = (ClockClientData *)ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    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.
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
    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);
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case CLOCK_FORMAT_FORMAT:
	    formatObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_GMT:







|







1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
    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",
		    Tcl_GetString(objv[i]), NULL);
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case CLOCK_FORMAT_FORMAT:
	    formatObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_GMT:
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050

    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);
	}
	tzWas = (char *)Tcl_Alloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------







|

|



|







2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050

    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)) {
	    ckfree(tzWas);
	}
	tzWas = (char *)ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	Tcl_Free(data->literals);
	Tcl_Free(data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
|










2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);
	ckfree(data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclCmdAH.c.
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
static inline void	ForeachCleanup(Tcl_Interp *interp,
			    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 int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
			    Tcl_StatBuf *statPtr);
static inline 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;







|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
static inline void	ForeachCleanup(Tcl_Interp *interp,
			    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 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;
127
128
129
130
131
132
133








































































































































134
135
136
137
138
139
140
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_BREAK;
}









































































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_CatchObjCmd --
 *
 *	This object-based procedure is invoked to process the "catch" Tcl
 *	command. See the user documentation for details on what it does.







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







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    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.
 *
 *----------------------------------------------------------------------
 */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
int
Tcl_CaseObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i;
    int body, result, caseObjc;
    const char *stringPtr, *arg;
    Tcl_Obj *const *caseObjv;
    Tcl_Obj *armPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string ?in? ?pattern 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;
	const char *pat, *p;

	if (i == caseObjc-1) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "extra case pattern with no body", -1));
	    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(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), Tcl_GetErrorLine(interp)));
	}
	return result;
    }

    /*
     * Nothing matched: return nothing.
     */

    return TCL_OK;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CatchObjCmd --
 *
 *	This object-based procedure is invoked to process the "catch" Tcl
 *	command. See the user documentation for details on what it does.
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    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 */
    const char *bytesPtr;	/* Pointer to the first byte of the array */

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

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) TclGetByteArrayFromObj(data, &length);
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */








|


















|







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    int length;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */

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

    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */

470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
    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);
	data = objv[1];







|







606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
    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 */
    int 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);
	data = objv[1];
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
	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;
}

/*







|







1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
	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",
		Tcl_GetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, fsInfo);
    return TCL_OK;
}

/*
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
    } else {
	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);

	if (separatorObj == 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, separatorObj);
    }
    return TCL_OK;
}








|







2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
    } else {
	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);

	if (separatorObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unrecognised path", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		    Tcl_GetString(objv[1]), NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, separatorObj);
    }
    return TCL_OK;
}

2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}

static inline int
EachloopCmd(
    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[])







|







2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}

static int
EachloopCmd(
    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[])
Changes to generic/tclCmdIL.c.
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
	const char *strValuePtr;
	Tcl_WideInt wideValue;
	double doubleValue;
	Tcl_Obj *objValuePtr;
    } collationKey;
    union {			/* 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"







|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
	const char *strValuePtr;
	Tcl_WideInt wideValue;
	double doubleValue;
	Tcl_Obj *objValuePtr;
    } collationKey;
    union {			/* Object being sorted, or its index. */
	Tcl_Obj *objPtr;
	int 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"
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
	return TCL_ERROR;
    }

    if (objc == 3) {
	incrPtr = objv[2];
    } else {
	incrPtr = Tcl_NewWideIntObj(1);
    }
    Tcl_IncrRefCount(incrPtr);
    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
	    incrPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(incrPtr);

    if (newValuePtr == NULL) {







|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
	return TCL_ERROR;
    }

    if (objc == 3) {
	incrPtr = objv[2];
    } else {
	TclNewIntObj(incrPtr, 1);
    }
    Tcl_IncrRefCount(incrPtr);
    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
	    incrPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(incrPtr);

    if (newValuePtr == NULL) {
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    Proc *procPtr;
    size_t numBytes;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);







|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    Proc *procPtr;
    int numBytes;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
    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;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {







|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
    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;
    int i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
	 * 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);
		elemObjPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);







|







687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
	 * 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);
		TclNewObj(elemObjPtr);
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    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);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);







|







738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
965
966
967
968
969
970
971
972
973

974
975
976
977
978
979
980
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr = Tcl_NewObj();


		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	    }







|

>







965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr;

		TclNewObj(nullObjPtr);
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	    }
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    size_t 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++) {







|







1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)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++) {
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
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

		if (!TclIsProc(cmdPtr)) {
		    realCmdPtr = (Command *)
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
		} else {
		procOK:
		    if (specificNsInPattern) {
			elemObjPtr = Tcl_NewObj();
			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
	    }







|




















|






|
|







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
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

		if (!TclIsProc(cmdPtr)) {
		    realCmdPtr = (Command *)
			    TclGetOriginalCommand((Tcl_Command)cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
		} else {
		procOK:
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetCommandFullName(interp, (Tcl_Command)cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
	    }
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
    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 {







|







2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
    command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe 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 {
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
int
Tcl_JoinObjCmd(
    TCL_UNUSED(ClientData),
    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;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }








|
<







2177
2178
2179
2180
2181
2182
2183
2184

2185
2186
2187
2188
2189
2190
2191
int
Tcl_JoinObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int length, listLen;

    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228

    (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) {

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







|







2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228

    (void) TclGetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	TclNewObj(resObjPtr);
	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.
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
Tcl_LinsertObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    size_t index;
    int len, result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &len);







<
|







2395
2396
2397
2398
2399
2400
2401

2402
2403
2404
2405
2406
2407
2408
2409
Tcl_LinsertObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;

    int index, len, result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &len);
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
     * 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) {
	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)) {
	/*
	 * 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,







|













|







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
     * appended to the list.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
    if (result != TCL_OK) {
	return result;
    }
    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 == 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,
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
Tcl_LrangeObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    size_t first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);







|
<







2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673
2674
Tcl_LrangeObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, first, last, result;


    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
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
 */

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

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc, listLen, prevIdx, first, num;
    size_t *idxv;
    Tcl_Obj *listObj;

    /*
     * Parse the arguments.
     */

    if (objc < 2) {







|
|















|
|







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

static int
LremoveIndexCompare(
    const void *el1Ptr,
    const void *el2Ptr)
{
    int idx1 = *((const int *) el1Ptr);
    int idx2 = *((const int *) el2Ptr);

    /*
     * This will put the larger element first.
     */

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc;
    int listLen, *idxv, prevIdx, first, num;
    Tcl_Obj *listObj;

    /*
     * Parse the arguments.
     */

    if (objc < 2) {
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
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	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;
	}
    }

    /*
     * 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)) {







|



|










|







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
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = (int *)ckalloc((objc - 2) * sizeof(int));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    ckfree(idxv);
	    return TCL_ERROR;
	}
    }

    /*
     * 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(int), LremoveIndexCompare);
    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
	    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;
}

/*
 *----------------------------------------------------------------------
 *







|







2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
	    num = 1;
	    first = idx;
	}
    }
    if (num != 0) {
	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
    }
    ckfree(idxv);
    Tcl_SetObjResult(interp, listObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
Tcl_LreplaceObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    size_t first, last;
    int listLen, numToDelete, result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
	return TCL_ERROR;
    }








<
|







2956
2957
2958
2959
2960
2961
2962

2963
2964
2965
2966
2967
2968
2969
2970
Tcl_LreplaceObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;

    int first, last, listLen, numToDelete, result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
	return TCL_ERROR;
    }

2990
2991
2992
2993
2994
2995
2996

2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
    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 + 1 <= last + 1) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we







>
|



|


|







2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    }
    if (first > listLen) {
	first = listLen;
    }

    if (last >= listLen) {
	last = listLen - 1;
    }
    if (first <= last) {
	numToDelete = last - first + 1;
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we
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
Tcl_LsearchObjCmd(
    TCL_UNUSED(ClientData),
    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;
    size_t length = 0, elemLen, start, groupSize, groupOffset, lower, upper;
    int allocatedIndexVector = 0;
    int dataType, isIncreasing;
    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;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
	"-subindices", NULL
    };
    enum options {
	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 datatypes {







|
<

|
|













|







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
Tcl_LsearchObjCmd(
    TCL_UNUSED(ClientData),
    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, length, elemLen, bisect;

    int allocatedIndexVector = 0;
    int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
    Tcl_WideInt patWide, objWide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
	"-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 datatypes {
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218

    for (i = 1; i < objc-2; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
		!= TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	switch ((enum options) index) {
	case LSEARCH_ALL:		/* -all */
	    allMatches = 1;
	    break;
	case LSEARCH_ASCII:		/* -ascii */
	    dataType = ASCII;
	    break;
	case LSEARCH_BISECT:		/* -bisect */







|







3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215

    for (i = 1; i < objc-2; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
		!= TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	switch ((enum lsearchoptions) index) {
	case LSEARCH_ALL:		/* -all */
	    allMatches = 1;
	    break;
	case LSEARCH_ASCII:		/* -ascii */
	    dataType = ASCII;
	    break;
	case LSEARCH_BISECT:		/* -bisect */
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
		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) {







|



|







<







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
		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_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (groupSize < 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;
	    }

	    i++;
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    int j;

	    if (allocatedIndexVector) {
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
	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", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
		goto done;







|







3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
	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 < 0 || 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;
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
	}

	/*
	 * 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 (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIndexObj(itemPtr, -1);
		Tcl_SetObjResult(interp, itemPtr);
	    }
	    goto done;
	}

	/*
	 * If start points within a group, it points to the start of the group.







|



|







3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
	}

	/*
	 * 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 > listc-1) {
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIntObj(itemPtr, TCL_INDEX_NONE);
		Tcl_SetObjResult(interp, itemPtr);
	    }
	    goto done;
	}

	/*
	 * If start points within a group, it points to the start of the group.
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
	    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.
		 * 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
		 * 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.







|







3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
	    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.
		 * Consider: 0 0 0 1 1 1 2 2 2
		 *
		 * To maintain consistancy with standard lsearch semantics, we
		 * must find the leftmost occurrence 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.
3719
3720
3721
3722
3723
3724
3725
3726

3727
3728
3729
3730
3731
3732
3733
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {
			    match = (TclUtfCasecmp(bytes, patternBytes) == 0);
			} else {
			    match = (memcmp(bytes, patternBytes, length) == 0);

			}
		    }
		    break;

		case DICTIONARY:
		    bytes = TclGetString(itemPtr);
		    match = (DictionaryCompare(bytes, patternBytes) == 0);







|
>







3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {
			    match = (TclUtfCasecmp(bytes, patternBytes) == 0);
			} else {
			    match = (memcmp(bytes, patternBytes,
				    (size_t) length) == 0);
			}
		    }
		    break;

		case DICTIONARY:
		    bytes = TclGetString(itemPtr);
		    match = (DictionaryCompare(bytes, patternBytes) == 0);
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
		} else {
		    itemPtr = listv[i];
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		int j;

		TclNewIndexObj(itemPtr, i+groupOffset);
		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, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	}
    }

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    int j;

	    TclNewIndexObj(itemPtr, index+groupOffset);
	    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_SetObjResult(interp, itemPtr);
	} else {
		Tcl_Obj *elObj;
		TclNewIndexObj(elObj, index);
	    Tcl_SetObjResult(interp, elObj);
	}
    } else if (index < 0) {
	/*
	 * Is this superfluous? The result should be a blank object by
	 * default...
	 */







|


|
<



















|


|
<





|







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
		} else {
		    itemPtr = listv[i];
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
	    } else if (returnSubindices) {
		int j;

		TclNewIntObj(itemPtr, i+groupOffset);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_Obj *elObj;
		    TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));

		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
	    }
	}
    }

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    int j;

	    TclNewIntObj(itemPtr, index+groupOffset);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_Obj *elObj;
		TclNewIntObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));

		Tcl_ListObjAppendElement(interp, itemPtr, elObj);
	    }
	    Tcl_SetObjResult(interp, itemPtr);
	} else {
		Tcl_Obj *elObj;
		TclNewIntObj(elObj, index);
	    Tcl_SetObjResult(interp, elObj);
	}
    } else if (index < 0) {
	/*
	 * Is this superfluous? The result should be a blank object by
	 * default...
	 */
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
int
Tcl_LsortObjCmd(
    TCL_UNUSED(ClientData),
    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 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;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30







|

|
<
<







3977
3978
3979
3980
3981
3982
3983
3984
3985
3986


3987
3988
3989
3990
3991
3992
3993
int
Tcl_LsortObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int i, j, index, indices, length, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;


    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    size_t elmArrSize;
    SortElement *elementArray = NULL, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
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
	     * Check each of the indices for syntactic correctness. Note that
	     * 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++) {
		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)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			    TclGetString(indexv[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 %" TCL_Z_MODIFIER "d)", j));
		    sortInfo.resultCode = TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;







|














|







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
	     * Check each of the indices for syntactic correctness. Note that
	     * 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<sortindex ; 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)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			    TclGetString(indexv[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));
		    sortInfo.resultCode = TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;
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
		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;







|



|







<







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
		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_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (groupSize < 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;
	    }

	    group = 1;
	    i++;
	    break;
	}
    }
    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
	sortInfo.sortMode = SORTMODE_ASCII_NC;
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
	    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];







|







4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
	    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<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];
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
	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;







|







4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
	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 < 0 || 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;
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
    /*
     * 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);
    } else {
	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);







|







4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
    /*
     * 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 *)ckalloc(elmArrSize);
    } else {
	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);
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
	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) {
			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);
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	} else {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		objPtr = elementPtr->payload.objPtr;
		newArray[i++] = objPtr;







|











|







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
	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) {
			TclNewIntObj(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) {
		TclNewIntObj(objPtr, elementPtr->payload.index);
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	} else {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		objPtr = elementPtr->payload.objPtr;
		newArray[i++] = objPtr;
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
	sortInfo.compareCmdPtr = NULL;
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    if (elementArray) {
	if (elmArrSize <= MAXCALLOC) {
	    Tcl_Free(elementArray);
	} else {
	    free((char *)elementArray);
	}
    }
    return sortInfo.resultCode;
}








|







4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
	sortInfo.compareCmdPtr = NULL;
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    if (elementArray) {
	if (elmArrSize <= MAXCALLOC) {
	    ckfree((char *)elementArray);
	} else {
	    free((char *)elementArray);
	}
    }
    return sortInfo.resultCode;
}

Changes to generic/tclCmdMZ.c.
123
124
125
126
127
128
129

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
int
Tcl_RegexpObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    size_t offset, stringLength, matchLength, cflags, eflags;
    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[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL
    };
    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;
    offset = TCL_INDEX_START;
    all = 0;
    doinline = 0;

    for (i = 1; i < objc; i++) {
	const char *name;
	int index;

	name = TclGetString(objv[i]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum options) index) {
	case REGEXP_ALL:
	    all = 1;
	    break;
	case REGEXP_INDICES:
	    indices = 1;
	    break;
	case REGEXP_INLINE:







>
|
<








|








|















|







123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
int
Tcl_RegexpObjCmd(
    TCL_UNUSED(ClientData),
    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;
    int cflags, eflags, stringLength, matchLength;

    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL
    };
    enum regexpoptions {
	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;
    offset = 0;
    all = 0;
    doinline = 0;

    for (i = 1; i < objc; i++) {
	const char *name;
	int index;

	name = TclGetString(objv[i]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum regexpoptions) 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
	case REGEXP_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGEXP_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    size_t temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);







|



|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
	case REGEXP_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGEXP_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    int temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], INT_MAX - 1, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }







|
|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	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
	 * 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) {
	    eflags = 0;
	} else if (offset + 1 > stringLength + 1) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}








|

|







302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
	 * 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 == 0) {
	    eflags = 0;
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
	    /*
	     * It's the number of substitutions, plus one for the matchVar at
	     * index 0
	     */

	    objc = info.nsubs + 1;
	    if (all <= 1) {
		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		size_t 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) {
		    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) {
			end--;
		    }
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		}

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= (int)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);







|






|







|








|



|
|


|
|



|




|







353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
	    /*
	     * It's the number of substitutions, plus one for the matchVar at
	     * index 0
	     */

	    objc = info.nsubs + 1;
	    if (all <= 1) {
		TclNewObj(resultPtr);
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		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 <= 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 >= offset) {
			end--;
		    }
		} else {
		    start = -1;
		    end = -1;
		}

		TclNewIntObj(objs[0], start);
		TclNewIntObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= info.nsubs) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    TclNewObj(newPtr);
		}
	    }
	    if (doinline) {
		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= stringLength + 1) {
	    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







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	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
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
int
Tcl_RegsubObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result, cflags, all, match, command, numParts;
    size_t idx, wlen, wsublen = 0, offset, numMatches;
    size_t start, end, subStart, subEnd;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
	"--",		NULL
    };
    enum options {
	REGSUB_ALL,	 REGSUB_COMMAND,    REGSUB_EXPANDED, REGSUB_LINE,
	REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE,   REGSUB_START,
	REGSUB_LAST
    };

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < (size_t)objc; idx++) {
	const char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum options) index) {
	case REGSUB_ALL:
	    all = 1;
	    break;
	case REGSUB_NOCASE:
	    cflags |= TCL_REG_NOCASE;
	    break;
	case REGSUB_COMMAND:







|
<
|










|







|



|











|







483
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
int
Tcl_RegsubObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;

    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
	"--",		NULL
    };
    enum regsubobjoptions {
	REGSUB_ALL,	 REGSUB_COMMAND,    REGSUB_EXPANDED, REGSUB_LINE,
	REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE,   REGSUB_START,
	REGSUB_LAST
    };

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = 0;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < objc; idx++) {
	const char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum regsubobjoptions) index) {
	case REGSUB_ALL:
	    all = 1;
	    break;
	case REGSUB_NOCASE:
	    cflags |= TCL_REG_NOCASE;
	    break;
	case REGSUB_COMMAND:
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
	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) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], (size_t)WIDE_MAX - 1, &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) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? 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]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	}
    }

    if (all && (offset == TCL_INDEX_START) && (command == 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 nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;

	wsrc = TclGetUnicodeFromObj(objv[0], &slen);
	wstring = TclGetUnicodeFromObj(objv[1], &wlen);
	wsubspec = TclGetUnicodeFromObj(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);
		    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))) {

		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			TclAppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;
		    } else {
			p += slen;
		    }
		    wstring = p - 1;

		    TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    numMatches++;
		}
	    }
	    if (numMatches) {
		wlen    = wfirstChar + wlen - p;
		wstring = p;
	    }







|
|


|
















|













|



|
|



|







<
|
|




|

|
|
|













|
|









|
>





|






|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600

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
	case REGSUB_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    int temp;
	    if (++idx >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], INT_MAX - 1, &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 (objc-idx < 3 || objc-idx > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
    }

    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == 0) && (command == 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.
	 */


	int slen, nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	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++) {
		    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,
				(unsigned long) slen) == 0))) {
		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;
		    } else {
			p += slen;
		    }
		    wstring = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    numMatches++;
		}
	    }
	    if (numMatches) {
		wlen    = wfirstChar + wlen - p;
		wstring = p;
	    }
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = TclGetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = TclGetUnicodeFromObj(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







|






|







695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	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
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
	}
	if (match == 0) {
	    break;
	}
	if (numMatches == 0) {
	    resultPtr = Tcl_NewUnicodeObj(wstring, 0);
	    Tcl_IncrRefCount(resultPtr);
	    if (offset > TCL_INDEX_START) {
		/*
		 * Copy the initial portion of the string in if an offset was
		 * specified.
		 */

		TclAppendUnicodeToObj(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);

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







|





|












|














|





|



|



















|

















|











|







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
	}
	if (match == 0) {
	    break;
	}
	if (numMatches == 0) {
	    resultPtr = Tcl_NewUnicodeObj(wstring, 0);
	    Tcl_IncrRefCount(resultPtr);
	    if (offset > 0) {
		/*
		 * Copy the initial portion of the string in if an offset was
		 * specified.
		 */

		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;
	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 **)ckalloc(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 >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
		} else {
		    TclNewObj(args[idx + numParts]);
		}
		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]);
	    }
	    ckfree(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 = Tcl_GetUnicodeFromObj(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) {
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	    if (all) {
		continue;
	    } else {
		break;
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
		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,
			    wsrc - wfirstChar + 1);
		    *wsrc = '\\';
		    wfirstChar = wsrc + 2;
		    wsrc++;
		    continue;
		} else {
		    continue;
		}
	    } else {
		continue;
	    }

	    if (wfirstChar != wsrc) {
		TclAppendUnicodeToObj(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,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;
	    }
	    wfirstChar = wsrc + 1;
	}

	if (wfirstChar != wsrc) {
	    TclAppendUnicodeToObj(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);
	    }
	    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);
		}
		offset++;
	    }
	}
	if (!all) {
	    break;
	}







|













|






|
|











|









|











|







863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
		idx = 0;
	    } else if (ch == '\\') {
		ch = wsrc[1];
		if ((ch >= '0') && (ch <= '9')) {
		    idx = ch - '0';
		} else if ((ch == '\\') || (ch == '&')) {
		    *wsrc = ch;
		    Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			    wsrc - wfirstChar + 1);
		    *wsrc = '\\';
		    wfirstChar = wsrc + 2;
		    wsrc++;
		    continue;
		} else {
		    continue;
		}
	    } else {
		continue;
	    }

	    if (wfirstChar != wsrc) {
		Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			wsrc - wfirstChar);
	    }

	    if (idx <= info.nsubs) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    Tcl_AppendUnicodeToObj(resultPtr,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;
	    }
	    wfirstChar = wsrc + 1;
	}

	if (wfirstChar != wsrc) {
	    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) {
		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) {
		    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
	 * 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);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {
	    /*







|







944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
	 * 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) {
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {
	    /*
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
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    size_t splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
    end = stringPtr + stringLen;
    listPtr = Tcl_NewObj();

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
    } else if (splitCharLen == 0) {
	Tcl_HashTable charReuseTable;







|














|







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
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    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);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
    end = stringPtr + stringLen;
    TclNewObj(listPtr);

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
    } else if (splitCharLen == 0) {
	Tcl_HashTable charReuseTable;
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263

	/*
	 * 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) {
	    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;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */








|








|







1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262

	/*
	 * 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,(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;
	int splitLen;
	int splitChar;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

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
static int
StringFirstCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t start = TCL_INDEX_START;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;
}








|








|

|







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
static int
StringFirstCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int start = 0;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;
}

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
static int
StringLastCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t last = TCL_INDEX_END;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;
}








|








|

|







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
static int
StringLastCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int last = INT_MAX - 1;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;
}

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
static int
StringIndexCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t index, end;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
	return TCL_ERROR;
    }

    /*
     * Get the char length to calculate what 'end' means.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;
    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) {
	int ch = Tcl_GetUniChar(objv[1], index);

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

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4] = "";

	    end = Tcl_UniCharToUtf(ch, buf);
	    if ((ch >= 0xD800) && (end < 3)) {
		end += Tcl_UniCharToUtf(-1, buf + end);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|










|
|



|


















|
|
|

|







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
static int
StringIndexCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    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.
     */

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index >= 0) && (index < length)) {
	int ch = Tcl_GetUniChar(objv[1], index);

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

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4] = "";

	    length = Tcl_UniCharToUtf(ch, buf);
	    if ((ch >= 0xD800) && (length < 3)) {
		length += Tcl_UniCharToUtf(-1, buf + length);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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 (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
	    TCL_STRING_IN_PLACE);







|
|












|
|







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
static int
StringInsertCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int length;			/* String length */
    int 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 (index < 0) {
	index = 0;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
	    TCL_STRING_IN_PLACE);
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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, result = 1, strict = 0, index, length3;
    size_t failat = 0;
    size_t length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    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 isClasses {
	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
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };

    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"class ?-strict? ?-failindex var? str");
	return TCL_ERROR;







|
<
<











|










|







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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;


    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"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
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptionsEnum {
	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
	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 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");







|







1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
	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) {
	    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

    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.
     */

    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)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if ((objPtr->internalRep.wideValue != 0)

		? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
	    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) {







|




















|
>
|
|
>



















|
<







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

    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.
     */

    switch ((enum isClassesEnum) 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)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if (index != STR_IS_BOOL) {
	    TclGetBooleanFromObj(NULL, objPtr, &i);
	    if ((index == STR_IS_TRUE) ^ i) {
		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, 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) {
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
	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)) {
	    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;
	    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) {







|











|
<







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
	break;
    case STR_IS_LIST:
	/*
	 * We ignore the strictness here, since empty strings are always
	 * well-formed lists.
	 */

	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;
	    int lenRemain, 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) {
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
    /*
     * 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;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}







|







1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
    /*
     * 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)) {
	TclNewIntObj(objPtr, failat);
	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
static int
StringMapCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t 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);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {







|



|







1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
static int
StringMapCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    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*, unsigned long);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
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
	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) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc = 2 * i;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = (Tcl_Obj **)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);
	}
	Tcl_DictObjDone(&search);
    } else {
	int i;
	if (TclListObjGetElements(interp, objv[objc-2], &i,
		&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;







|
|








|










|
|



<
|



<







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
	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], &mapElemc);
	if (mapElemc == 0) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc *= 2;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {

	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (mapElemc == 0) {
	    /*
	     * empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
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

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = TclGetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }
    end = ustring1 + length1;

    strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp);

    /*
     * 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 u2lc;
	Tcl_UniChar *mapString;

	ustring2 = TclGetUnicodeFromObj(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);
	    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)) {
		    if (p != ustring1) {
			TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    TclAppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	size_t *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);
	if (nocase) {
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = TclGetUnicodeFromObj(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))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			TclAppendUnicodeToObj(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,
			    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_SetObjResult(interp, resultPtr);
  done:
    if (mapWithDict) {
	TclStackFree(interp, mapElemv);
    }
    if (copySource) {







|









|















|
<


|








|





|

|






|





|
<








|
|




|
















|






|















|
















|







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

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }
    end = ustring1 + length1;

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

	int mapLen, u2lc;

	Tcl_UniChar *mapString;

	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 = 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,
				(unsigned long) length2) == 0)) {
		    if (p != ustring1) {
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	int *mapLens, *u2lc = NULL;


	/*
	 * 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*2*sizeof(Tcl_UniChar *));
	mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; 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. */
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

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

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

	Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
    }
    Tcl_SetObjResult(interp, resultPtr);
  done:
    if (mapWithDict) {
	TclStackFree(interp, mapElemv);
    }
    if (copySource) {
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
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
static int
StringRangeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t first, last, end;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
	return TCL_ERROR;
    }

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (first == TCL_INDEX_NONE) {
	first = TCL_INDEX_START;
    }
    if (last + 1 >= end + 1) {
	last = end;
    }
    if (last + 1 >= first + 1) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|











|

|
|



|
|

|
|

|







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
static int
StringRangeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
	return TCL_ERROR;
    }

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    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 < 0) {
	first = 0;
    }
    if (last >= length) {
	last = length;
    }
    if (last >= first) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
static int
StringRplcCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
	size_t first, last, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    end = Tcl_GetCharLength(objv[1]) - 1;


    if (TclGetIntForIndexM(interp, objv[2], end, &first) != 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.
     */

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

	/*
	 * 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;
	}

	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);








|






|
>












|
|
|
>










|
|

|







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
static int
StringRplcCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != 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.
     */

    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 < 0) {
	    first = 0;
	}
	if (last > end) {
	    last = end;
	}

	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);

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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *string;
    size_t numChars, length, cur, index;
    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) {
	return TCL_ERROR;
    }
    string = TclGetString(objv[1]);
    if (index + 1 > numChars + 1) {
	index = numChars;
    }
    cur = 0;
    if (index + 1 > 1) {
	p = Tcl_UtfAtIndex(string, index);

	TclUtfToUCS4(p, &ch);
	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
	    int delta = 0;
	    const char *next;

	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }

	    next = TclUtfPrev(p, string);
	    do {
		next += delta;
		delta = TclUtfToUCS4(next, &ch);
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|








|
|


|
|
|


|



|


















|







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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *string;
    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);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index >= numChars) {
	index = numChars - 1;
    }
    cur = 0;
    if (index > 0) {
	p = Tcl_UtfAtIndex(string, index);

	TclUtfToUCS4(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);
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }
    TclNewIntObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *end, *string;
    size_t length, numChars, cur, index;
    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) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index + 1 <= numChars + 1) {
	p = Tcl_UtfAtIndex(string, index);
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUtfToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = numChars + 1;
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|








|
|



|
|

|












|

|







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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const char *p, *end, *string;
    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);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index < 0) {
	index = 0;
    }
    if (index < numChars) {
	p = Tcl_UtfAtIndex(string, index);
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUtfToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = numChars;
    }
    TclNewIntObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
    /*
     * 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;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }







|
<







2638
2639
2640
2641
2642
2643
2644
2645

2646
2647
2648
2649
2650
2651
2652
    /*
     * 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 length, i, match, nocase = 0, reqlength = -1;


    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
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;
    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,







|
<







2733
2734
2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
TclStringCmpOpts(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int *nocase,
    int *reqlength)
{
    int i, length;

    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringBytesCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);







<







|







2832
2833
2834
2835
2836
2837
2838

2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringBytesCmd(
    TCL_UNUSED(ClientData),
    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;
    }

    (void) TclGetStringFromObj(objv[1], &length);
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
static int
StringLowerCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *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;
	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 = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    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);







|

















|







|









|


|







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
static int
StringLowerCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *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 {
	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 < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	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);
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
static int
StringUpperCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *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;
	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;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    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);







|

















|







|
|








|


|







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
static int
StringUpperCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *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 {
	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 < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	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);
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
static int
StringTitleCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    const char *string1;
    char *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;
	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;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    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);







|

















|







|
|








|


|







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
static int
StringTitleCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *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 {
	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 < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last >= length1) {
	    last = length1;
	}
	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);
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
StringTrimCmd(
    TCL_UNUSED(ClientData),
    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;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







|







3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
StringTrimCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
StringTrimLCmd(
    TCL_UNUSED(ClientData),
    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;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







<
|







3213
3214
3215
3216
3217
3218
3219

3220
3221
3222
3223
3224
3225
3226
3227
StringTrimLCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;

    int trim, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
StringTrimRCmd(
    TCL_UNUSED(ClientData),
    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;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {







<
|







3259
3260
3261
3262
3263
3264
3265

3266
3267
3268
3269
3270
3271
3272
3273
StringTrimRCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;

    int trim, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
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
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;
    size_t patternLength, j;
    const 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[] = {
	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
	"--", NULL
    };
    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;

    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 options) index) {
	    /*
	     * General options.
	     */

	case OPT_LAST:
	    i++;
	    goto finishedOptions;







|
|
<




















|




















|







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
int
TclNRSwitchObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase, patternLength;

    const 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[] = {
	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
	"--", NULL
    };
    enum switchOptionsEnum {
	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;

    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) {
	    /*
	     * General options.
	     */

	case OPT_LAST:
	    i++;
	    goto finishedOptions;
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
	    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);
		} else {
		    TclNewIndexObj(rangeObjAry[1], -1);
		    rangeObjAry[0] = rangeObjAry[1];
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */








|
|
|

|







3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end > 0) {
		    TclNewIntObj(rangeObjAry[0], info.matches[j].start);
		    TclNewIntObj(rangeObjAry[1], info.matches[j].end-1);
		} else {
		    TclNewIntObj(rangeObjAry[1], TCL_INDEX_NONE);
		    rangeObjAry[0] = rangeObjAry[1];
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

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
	     * 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->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->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= (size_t)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");
	}







|













|








|







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
	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    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 *)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 >= 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");
	}
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
{
    /* 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);
	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 overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(overflow ? limit : (unsigned)patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*







|






|














|




|







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
{
    /* 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];
    int patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	ckfree(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) {
	int limit = 50;
	int overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(overflow ? limit : patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*
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
{
    static double measureOverhead = 0;
				/* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    Tcl_Obj *objPtr;
    int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    Tcl_WideUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt maxms = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
    Tcl_WideUInt maxcnt = WIDE_MAX;
				/* Maximal count of iterations. */
    Tcl_WideUInt threshold = 1;	/* Current threshold for check time (faster
				 * repeat count without time check) */
    Tcl_WideUInt 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;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    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 (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;
	}
    }

    if (i >= objc || i < objc - 3) {
    usage:
	Tcl_WrongNumArgs(interp, 1, objv,







|


|

|

|











|
















|













>
>







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
{
    static double measureOverhead = 0;
				/* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    Tcl_Obj *objPtr;
    int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    TclWideMUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt maxms = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
    TclWideMUInt maxcnt = WIDE_MAX;
				/* Maximal count of iterations. */
    TclWideMUInt threshold = 1;	/* Current threshold for check time (faster
				 * repeat count without time check) */
    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;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum timeRateOptionsEnum {
	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) {
	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,
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
		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideUInt usec, val;
	int digits;

	/*
	 * Absolute execution time in microseconds or in wide clicks.
	 */
	usec = (Tcl_WideUInt)(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 */

	    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;

		if (usec > curOverhead) {
		    usec -= curOverhead;
		} else {
		    usec = 0;
		}
	    }







|





|










>
|

















|







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
		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	TclWideMUInt usec, val;
	int digits;

	/*
	 * Absolute execution time in microseconds or in wide clicks.
	 */
	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];
	    goto retRes;
	}

	/*
	 * If not calibrating...
	 */

	if (!calibrate) {
	    /*
	     * Minimize influence of measurement overhead.
	     */

	    if (overhead > 0) {
		/*
		 * Estimate the time of overhead (microsecs).
		 */

		TclWideMUInt curOverhead = overhead * count;

		if (usec > curOverhead) {
		    usec -= curOverhead;
		} else {
		    usec = 0;
		}
	    }
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
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = usec / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    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);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!usec) {
	    usec++;			/* Avoid divide by zero. */







|















|







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
	    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);
	} 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 */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!usec) {
	    usec++;			/* Avoid divide by zero. */
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
		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / usec);
	    } else {
		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 {
		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).







|














|







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
		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / usec);
	    } else {
		TclNewIntObj(objs[4], 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);
	    }
	    TclNewLiteralStringObj(objs[7], "net-ms");
	}

	/*
	 * Construct the result as a list because many programs have always
	 * parsed as such (extracting the first element, typically).
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741

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







|







4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"body ?handler ...? ?finally script?");
	return TCL_ERROR;
    }
    bodyObj = objv[1];
    TclNewObj(handlersObj);
    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",
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
			"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];








|







4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
			"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",
			Tcl_GetString(objv[i+1])));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];

5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
				 * 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
				 * derived continuation data */
{
    const char *listStr = TclGetString(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);

    for (i = 0; i < n; i++) {







|







5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
				 * 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
				 * derived continuation data */
{
    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);

    for (i = 0; i < n; i++) {
Changes to generic/tclCompCmds.c.
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    /*
     * 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.







|

|







386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)ckalloc(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.
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
    /* Stack at this point is empty */
    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));
    }

    /*
     * Push the return options if the caller wants them. This needs to happen
     * before INST_END_CATCH
     */








|
|







682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
    /* Stack at this point is empty */
    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 %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /*
     * Push the return options if the caller wants them. This needs to happen
     * before INST_END_CATCH
     */

887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
	}
	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
    }
    if (listObj != NULL) {
	Tcl_Obj **objs;
	const char *bytes;
	int len;
	size_t slen;

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

    /*
     * General case: runtime concat.
     */







<




|
|







887
888
889
890
891
892
893

894
895
896
897
898
899
900
901
902
903
904
905
906
	}
	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
    }
    if (listObj != NULL) {
	Tcl_Obj **objs;
	const char *bytes;
	int len;


	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = TclGetStringFromObj(objPtr, &len);
	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(objPtr);
	return TCL_OK;
    }

    /*
     * General case: runtime concat.
     */
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	size_t numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	}







|
<







1073
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	int numBytes, code;

	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	}
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
    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...







|
<







1286
1287
1288
1289
1290
1291
1292
1293

1294
1295
1296
1297
1298
1299
1300
    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, len;


    if ((parsePtr->numWords & 1) == 0) {
	return TCL_ERROR;
    }

    /*
     * See if we can build the value at compile time...
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	Tcl_Free((void *)argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    Tcl_Free((void *)argv);

    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Allocate a temporary variable to store the iterator reference. The







|







|







1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	ckfree(argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    ckfree(argv);

    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Allocate a temporary variable to store the iterator reference. The
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802

    /*
     * 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->length = numVars;
    keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.







|







1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799

    /*
     * 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 *)ckalloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars);
    duiPtr->length = numVars;
    keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.
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
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInvoke(envPtr,INST_RETURN_STK);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
		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(







|
|









|







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
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInvoke(envPtr,INST_RETURN_STK);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	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:
    ckfree(duiPtr);
    TclStackFree(interp, keyTokenPtrs);
  issueFallback:
    return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileDictAppendCmd(
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
    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;
}

/*
 *----------------------------------------------------------------------
 *







|
|







2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
    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 %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    size_t len;

    dui1Ptr = (DictUpdateInfo *)clientData;
    len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
    dui2Ptr = (DictUpdateInfo *)Tcl_Alloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    size_t 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]));
    }







|








|










|

















|







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
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    size_t len;

    dui1Ptr = (DictUpdateInfo *)clientData;
    len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
    dui2Ptr = (DictUpdateInfo *)ckalloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    ckfree(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)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;
    int i;
    Tcl_Obj *variables;

    TclNewObj(variables);
    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewWideIntObj(duiPtr->varIndices[i]));
    }
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
    /*
     * 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->numLists = 0;	/* Count this up as we go */

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







|







2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
    /*
     * 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 *)ckalloc(offsetof(ForeachInfo, varLists)
	    + numLists * sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * 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.
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
	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->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    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) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);







|








|
<

<

|
|







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
	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *)ckalloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int numBytes, varIndex;



	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &numBytes);
	    varIndex = LocalScalar(bytes, numBytes, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists)
	    + 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->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }







|








|







2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = (ForeachInfo *)ckalloc(offsetof(ForeachInfo, varLists)
	    + 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 *)ckalloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	Tcl_Free(listPtr);
    }
    Tcl_Free(infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PrintForeachInfo, DisassembleForeachInfo --
 *







|

|







2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	ckfree(listPtr);
    }
    ckfree(infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PrintForeachInfo, DisassembleForeachInfo --
 *
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
    TCL_UNUSED(Command *),
    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;
    size_t len;

    /*
     * Don't handle any guaranteed-error cases.
     */

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;







|
<







3145
3146
3147
3148
3149
3150
3151
3152

3153
3154
3155
3156
3157
3158
3159
    TCL_UNUSED(Command *),
    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, len;


    /*
     * Don't handle any guaranteed-error cases.
     */

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
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
    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = (Tcl_Obj **)Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	TclNewObj(objv[i]);
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}
    }

    /*
     * Everything is a literal, so the result is constant too (or an error if
     * the format is broken). Do the format now.
     */

    tmpObj = Tcl_Format(interp, TclGetString(formatObj),
	    parsePtr->numWords-2, objv);
    for (; --i>=0 ;) {
	Tcl_DecrRefCount(objv[i]);
    }
    Tcl_Free(objv);
    Tcl_DecrRefCount(formatObj);
    if (tmpObj == NULL) {
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }

    /*







|














|




|







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
    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	TclNewObj(objv[i]);
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}
    }

    /*
     * Everything is a literal, so the result is constant too (or an error if
     * the format is broken). Do the format now.
     */

    tmpObj = Tcl_Format(interp, Tcl_GetString(formatObj),
	    parsePtr->numWords-2, objv);
    for (; --i>=0 ;) {
	Tcl_DecrRefCount(objv[i]);
    }
    ckfree(objv);
    Tcl_DecrRefCount(formatObj);
    if (tmpObj == NULL) {
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }

    /*
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
     * 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]);
    }
    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') {
		i++;
		continue;
	    } else if (*bytes == '%') {
		continue;







|








|







3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
     * 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]);
    }
    ckfree(objv);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(tokenPtr);
    i = 0;

    /*
     * Now scan through and check for non-%s and non-%% substitutions.
     */

    for (bytes = Tcl_GetString(formatObj) ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    bytes++;
	    if (*bytes == 's') {
		i++;
		continue;
	    } else if (*bytes == '%') {
		continue;
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
     * 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
				 * in the format string. */
    TclNewObj(tmpObj);	/* The buffer used to accumulate the literal
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);







|







3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
     * 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 = Tcl_GetString(formatObj);
				/* The start of the currently-scanned literal
				 * in the format string. */
    TclNewObj(tmpObj);	/* The buffer used to accumulate the literal
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
    }
    return index;
}

int
TclLocalScalar(
    const char *bytes,
    size_t numBytes,
    CompileEnv *envPtr)
{
    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;







|







3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
    }
    return index;
}

int
TclLocalScalar(
    const char *bytes,
    int numBytes,
    CompileEnv *envPtr)
{
    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;
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *isScalarPtr)		/* Must not be NULL. */
{
    const char *p;
    const char *last, *name, *elName;
    size_t n;
    Tcl_Token *elemTokenPtr = NULL;
	size_t nameLen, elNameLen;
    int 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







|

<
|







3411
3412
3413
3414
3415
3416
3417
3418
3419

3420
3421
3422
3423
3424
3425
3426
3427
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *isScalarPtr)		/* Must not be NULL. */
{
    const char *p;
    const char *last, *name, *elName;
    int n;
    Tcl_Token *elemTokenPtr = NULL;

    int nameLen, elNameLen, 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
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
	     last = p + varTokenPtr[1].size;  p < last;  p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    size_t remainingLen;

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








|







3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
	     last = p + varTokenPtr[1].size;  p < last;  p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    int remainingLen;

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

Changes to generic/tclCompCmdsGR.c.
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 *----------------------------------------------------------------------
 */

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







|
|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    int before,
    int after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
				 * 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;

    /*







<
|







177
178
179
180
181
182
183

184
185
186
187
188
189
190
191
				 * 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 realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;

    /*
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

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







|







493
494
495
496
497
498
499
500
501
502
503
504
505
506
507

    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)) {
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885

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







|







870
871
872
873
874
875
876
877
878
879
880
881
882
883
884

    /*
     * 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.
     */
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, idx, numWords = parsePtr->numWords;

    /*
     * Quit if too few args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {
	return TCL_ERROR;
    }








|







1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
    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;
    }

2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
				 * 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







<
|







2052
2053
2054
2055
2056
2057
2058

2059
2060
2061
2062
2063
2064
2065
2066
				 * 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. */

    int i, len, 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
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
	}
	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;







|







2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
	}
	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;
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
     */

    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







|
<







2238
2239
2240
2241
2242
2243
2244
2245

2246
2247
2248
2249
2250
2251
2252
     */

    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *stringTokenPtr;
    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
    Tcl_DString pattern;
    const char *bytes;
    int len, exact, quantified, result = TCL_ERROR;


    if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
	return TCL_ERROR;
    }

    /*
     * Parse the "-all", which must be the first argument (other options not
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
	    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.
		 */







|







2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
	    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 > 0) {
		    goto isSimpleGlob;
		}

		/*
		 * The pattern is "**"! I believe that should be impossible,
		 * but we definitely can't handle that at all.
		 */
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619

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







|







2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int 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);
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
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.







|
<







2828
2829
2830
2831
2832
2833
2834
2835

2836
2837
2838
2839
2840
2841
2842
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 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.
Changes to generic/tclCompCmdsSZ.c.
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
		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 ++;
    }







|

















|







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
		Tcl_DecrRefCount(obj);
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		int 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) {
	int len;
	const char *bytes = TclGetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472

    /* 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_OK;
    }

    /* Compute and push the string to be inserted */
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    if (idx == (int)TCL_INDEX_START) {







|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472

    /* 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) {
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict", "digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",
	"xdigit",	NULL
    };
    enum isClasses {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_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
    };







|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
	"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
    };
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
     *	3. Integers
     *	4. Floats
     *	5. Lists
     */

    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);

    switch ((enum isClasses) 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:







|







571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
     *	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:
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
				 * 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);








<
|







787
788
789
790
791
792
793

794
795
796
797
798
799
800
801
				 * 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);

884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	/*
	 * 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);







|

|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
	/*
	 * 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];
	int len = Tcl_GetCharLength(objPtr);

	len = sprintf(buf, "%d", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);
    }
    TclDecrRefCount(objPtr);
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
    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,







<







910
911
912
913
914
915
916

917
918
919
920
921
922
923
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *mapTokenPtr, *stringTokenPtr;
    Tcl_Obj *mapObj, **objv;
    const char *bytes;
    int len;


    /*
     * We only handle the case:
     *
     *    string map {foo bar} $thing
     *
     * That is, a literal two-element list (doesn't need to be brace-quoted,
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967

    /*
     * 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;
}








|
|


|
|
|







945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965

    /*
     * 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], &len);
    if (len == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, len);
	bytes = TclGetStringFromObj(objv[1], &len);
	PushLiteral(envPtr, bytes, len);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}

1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
    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;







|







1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    int numBytes,
    int flags,
    int line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0, bline = line;
    Tcl_Parse parse;
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
    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,







<
|







1535
1536
1537
1538
1539
1540
1541

1542
1543
1544
1545
1546
1547
1548
1549
    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {

	int length, 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,
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
	     * 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;
		    }
		}







<
|







1566
1567
1568
1569
1570
1571
1572

1573
1574
1575
1576
1577
1578
1579
1580
	     * 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) {

		int i, foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
		}
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624

	    /* 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);







|
|







1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620

	    /* 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 %d",
			(int) (CurrentOffset(envPtr) - startFixup.codeOffset));
	    }
	}

	envPtr->line = bline;
	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(	BEGIN_CATCH4, catchRange);
	ExceptionRangeStarts(envPtr, catchRange);
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

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







|
|














|
|








|
|


|
|











|
|








|
|







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

	/* OTHER */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);

	TclAdjustStackDepth(1, envPtr);
	/* BREAK destination */
	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
		    (int) (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 %d",
		    (int) (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 %d",
		    (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
	}
	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
		    (int) (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 %d",
		    (int) (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 %d",
		    (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
	}
	bline = envPtr->line;
    }

    while (count > 255) {
	OP1(	STR_CONCAT1, 255);
	count -= 254;
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
     * 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).







|







1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
     * 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--) {
	unsigned 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).
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
     * 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;







|
















|
|
|
|







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
     * 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);
	bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;
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
	    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.
	     */







|
|
|
|

















|
|
|







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
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree(bodyToken);
	    ckfree(bodyTokenArray);
	    ckfree(bodyLines);
	    ckfree(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 **)ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = (int *)ckalloc(sizeof(int) * numWords);
	bodyContLines = (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.
	     */
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
    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;
}

/*
 *----------------------------------------------------------------------
 *







|
|
|

|







2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.
     */

  freeTemporaries:
    ckfree(bodyToken);
    ckfree(bodyLines);
    ckfree(bodyContLines);
    if (bodyTokenArray != NULL) {
	ckfree(bodyTokenArray);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
     * (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;

    /*







|







2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
     * (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 *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
 */

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







|







2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
 */

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)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) {
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
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 *),







|







2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    ckfree(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
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
	    }
	    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;
		}







|











|







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
	    }
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		int 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) {
		int len;
		const char *varname = TclGetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
    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) {







<







3036
3037
3038
3039
3040
3041
3042

3043
3044
3045
3046
3047
3048
3049
    int *resultVars,
    int *optionVars,
    Tcl_Token **handlerTokens)
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar;
    int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;

    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    int *noError;
    char buf[TCL_INTEGER_SPACE];

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
	     */

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








|
|







3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);

3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
    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;
    }








<







3249
3250
3251
3252
3253
3254
3255

3256
3257
3258
3259
3260
3261
3262
    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];


    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
	return TCL_ERROR;
    }

3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
	     */

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








|
|







3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);

3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
		    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++;







|







3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
		    continue;
		}
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    int 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++;
Changes to generic/tclCompExpr.c.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 * 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 {
    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. */







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 * 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 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. */
160
161
162
163
164
165
166


167
168
169
170
171
172
173
#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
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
				 * appears that's not a supported operator. */



/* Leaf lexemes */

#define NUMBER		(LEAF | 1)
				/* For literal numbers */
#define SCRIPT		(LEAF | 2)
				/* Script substitution; [foo] */







>
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#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
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
				 * appears that's not a supported operator. */
#define COMMENT		6	/* Comment. Lasts to end of line or end of
				 * expression, whichever comes first. */

/* Leaf lexemes */

#define NUMBER		(LEAF | 1)
				/* For literal numbers */
#define SCRIPT		(LEAF | 2)
				/* Script substitution; [foo] */
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
	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 != */,
	QUOTED		/* " */,	INVALID		/* # */,
	VARIABLE	/* $ */,	MOD		/* % */,
	0		/* & or && */,	INVALID		/* ' */,
	OPEN_PAREN	/* ( */,	CLOSE_PAREN	/* ) */,
	0		/* * or ** */,	PLUS		/* + */,
	COMMA		/* , */,	MINUS		/* - */,
	0		/* . */,	DIVIDE		/* / */,
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */







|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	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 != */,
	QUOTED		/* " */,	0		/* # */,
	VARIABLE	/* $ */,	MOD		/* % */,
	0		/* & or && */,	INVALID		/* ' */,
	OPEN_PAREN	/* ( */,	CLOSE_PAREN	/* ) */,
	0		/* * or ** */,	PLUS		/* + */,
	COMMA		/* , */,	MINUS		/* - */,
	0		/* . */,	DIVIDE		/* / */,
	0, 0, 0, 0, 0, 0, 0, 0, 0, 0,			/* 0-9 */
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
 * 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,
			    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,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static size_t		ParseLexeme(const char *start, size_t numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *







|





|


|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
 * 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, 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,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);

/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
 *	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.
 *
 *----------------------------------------------------------------------
 */

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







|











|







542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
 *	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 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. */
    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. */
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    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
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    size_t 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
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need







|







577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
    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
				 * reallocation. */
    unsigned int 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
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
				 * 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
				 * 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. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *)Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*







|







|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
				 * 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 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. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*
670
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685
686
	 */

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {

		newPtr = (OpNode *)Tcl_AttemptRealloc(nodes, 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;







|
>
|
|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
	 */

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
		if (size <= UINT_MAX/sizeof(OpNode)) {
		    newPtr = (OpNode *) attemptckrealloc(nodes,
			    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;
704
705
706
707
708
709
710




711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
	 * 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);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
			(int)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







>
>
>
>


|




|







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
	 * Use context to categorize the lexemes that are ambiguous.
	 */

	if ((NODE_TYPE & lexeme) == 0) {
	    int b;

	    switch (lexeme) {
	    case COMMENT:
		start += scanned;
		numBytes -= scanned;
		continue;
	    case INVALID:
		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
			scanned, start);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		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
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
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} 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) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);








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


|



|

|


|







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
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    /*
		     * Tricky case: see test expr-62.10
		     */

		    int scanned2 = scanned;
		    do {
			scanned2 += TclParseAllWhiteSpace(
				start + scanned2, numBytes - scanned2);
			scanned2 += ParseLexeme(
				start + scanned2, numBytes - scanned2, &lexeme,
				NULL);
		    } while (lexeme == COMMENT);
		    if (lexeme == OPEN_PAREN) {
			/*
			 * Actually a function call, but with obscuring
			 * comments.  Skip to the start of the parentheses.
			 * Note that we assume that open parentheses are one
			 * byte long.
			 */

			lexeme = FUNCTION;
			Tcl_ListObjAppendElement(NULL, funcList, literal);
			scanned = scanned2 - 1;
			break;
		    }

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

1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
		 *
		 * 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.
		 */

		literal = Tcl_NewObj();
		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
		    Tcl_ListObjAppendElement(NULL, litList, literal);
		    complete = lastParsed = OT_LITERAL;
		    parsePtr->numTokens = wordIndex;
		    break;
		}
		Tcl_DecrRefCount(literal);







|







1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
		 *
		 * 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);
		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
		    Tcl_ListObjAppendElement(NULL, litList, literal);
		    complete = lastParsed = OT_LITERAL;
		    parsePtr->numTokens = wordIndex;
		    break;
		}
		Tcl_DecrRefCount(literal);
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
    }

    /*
     * Free any partial parse tree we've built.
     */

    if (nodes != NULL) {
	Tcl_Free(nodes);
    }

    if (interp == NULL) {
	/*
	 * Nowhere to report an error message, so just free it.
	 */








|







1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
    }

    /*
     * Free any partial parse tree we've built.
     */

    if (nodes != NULL) {
	ckfree(nodes);
    }

    if (interp == NULL) {
	/*
	 * Nowhere to report an error message, so just free it.
	 */

1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
	 * 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,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? (int)scanned : (int)limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	 */








|


|


|







1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
	 * 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) : limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? scanned : limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - scanned : limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	 */

1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
	/*
	 * 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,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
	if (errCode) {
	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
		    subErrCode, NULL);
	}
    }








|







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
	/*
	 * Finally, place context information in the errorInfo.
	 */

	numBytes = parsePtr->end - parsePtr->string;
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? numBytes : limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
	if (errCode) {
	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
		    subErrCode, NULL);
	}
    }

1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    size_t numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;







|







1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    int numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;
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
		 * 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));
		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.
		 */

		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));
		parsePtr->numTokens += toCopy + 1;
	    }

	    scanned = tokenPtr->start + tokenPtr->size - start;
	    start += scanned;
	    numBytes -= scanned;
	    tokenPtr += toCopy;







|
















|







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
		 * 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,
			(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.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy+1);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		*subExprTokenPtr = *tokenPtr;
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		subExprTokenPtr->numComponents++;
		subExprTokenPtr++;
		memcpy(subExprTokenPtr, tokenPtr,
			(size_t) toCopy * sizeof(Tcl_Token));
		parsePtr->numTokens += toCopy + 1;
	    }

	    scanned = tokenPtr->start + tokenPtr->size - start;
	    start += scanned;
	    numBytes -= scanned;
	    tokenPtr += toCopy;
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
 *----------------------------------------------------------------------
 */

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

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes == TCL_INDEX_NONE) {
	numBytes = (start ? strlen(start) : 0);
    }

    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);
    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
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    size_t 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;

    Tcl_UniChar ch = 0;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;
    }
    byte = UCHAR(*start);
    if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
	*lexemePtr = Lexeme[byte];
	return 1;
    }
    switch (byte) {










    case '*':
	if ((numBytes > 1) && (start[1] == '*')) {
	    *lexemePtr = EXPON;
	    return 2;
	}
	*lexemePtr = MULT;
	return 1;







|















|



















|




















|


|






>














>
>
>
>
>
>
>
>
>
>







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

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    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. */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    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);
    ckfree(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 int
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    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, size;
    Tcl_UniChar ch = 0;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;
    }
    byte = UCHAR(*start);
    if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
	*lexemePtr = Lexeme[byte];
	return 1;
    }
    switch (byte) {
    case '#':
	/*
	 * Scan forward over the comment contents.
	 */
	for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) {
	    byte = UCHAR(start[size]);
	}
	*lexemePtr = COMMENT;
	return size - (byte == '\n');

    case '*':
	if ((numBytes > 1) && (start[1] == '*')) {
	    *lexemePtr = EXPON;
	    return 2;
	}
	*lexemePtr = MULT;
	return 1;
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
    /*
     * 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);
	} else {
	    char utfBytes[4];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';







<







2141
2142
2143
2144
2145
2146
2147

2148
2149
2150
2151
2152
2153
2154
    /*
     * 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 == '_') {

	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[4];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
 *----------------------------------------------------------------------
 */

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. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    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));







|







2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    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));
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    Tcl_Free(opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index







|







2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree(opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		size_t length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,







|







2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		int length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
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
	    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;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);

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

		    objPtr->typePtr = literal->typePtr;
		    objPtr->internalRep = literal->internalRep;
		    literal->typePtr = NULL;
		}
		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
		 * registration that would enable sharing, and use the routine







|

|
|



















|







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
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);

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

		    objPtr->typePtr = literal->typePtr;
		    objPtr->internalRep = literal->internalRep;
		    literal->typePtr = NULL;
		}
		TclEmitPush(idx, 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
		 * registration that would enable sharing, and use the routine
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
	    break;
	default:
	    if (optimize && nodes[next].constant) {
		Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);

		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
			== TCL_OK) {
		    int index;
		    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);

			index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, index);
			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 {
			index = TclAddLiteralObj(envPtr, objPtr, NULL);
		    }
		    TclEmitPush(index, envPtr);
		} else {
		    TclCompileSyntaxError(interp, envPtr);
		}
		Tcl_RestoreInterpState(interp, save);
		convert = 0;
	    } else {
		nodePtr = nodes + next;







|









|

|

|
|











|

|







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
	    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;
			int numBytes;
			const char *bytes
				= Tcl_GetStringFromObj(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(idx, envPtr);
		} else {
		    TclCompileSyntaxError(interp, envPtr);
		}
		Tcl_RestoreInterpState(interp, save);
		convert = 0;
	    } else {
		nodePtr = nodes + next;
Changes to generic/tclCompile.c.
125
126
127
128
129
130
131




132
133
134
135
136
137
138
    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
	/* Jump relative to (pc + op4) if stktop expr object is true */
    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
	/* Jump relative to (pc + op1) if stktop expr object is false */
    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
	/* Jump relative to (pc + op4) if stktop expr object is false */





    {"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}},







>
>
>
>







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
	/* Jump relative to (pc + op4) if stktop expr object is true */
    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
	/* Jump relative to (pc + op1) if stktop expr object is false */
    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
	/* 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}},
165
166
167
168
169
170
171




172
173
174
175
176
177
178
179







180
181
182
183
184
185
186
	/* 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 */




    {"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. */








    {"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}},







>
>
>
>








>
>
>
>
>
>
>







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	/* 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}},
321
322
323
324
325
326
327



328
329
330
331
332
333
334
	 * indicated by op4 to hold the iterator state. The local scalar
	 * should not refer to a named variable as the value is not wholly
	 * 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 */



    {"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 */







>
>
>







336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
	 * indicated by op4 to hold the iterator state. The local scalar
	 * should not refer to a named variable as the value is not wholly
	 * 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. Use unsetScalar
	 * instead (with 0 for flags). */
    {"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 */
781
782
783
784
785
786
787
788

789
790
791
792
793
794
795
		&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.
     */








|
>







799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
		&tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
	    Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
	}
	traceInitialized = 1;
    }
#endif

    stringPtr = TclGetString(objPtr);
    length = 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.
     */

847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
    }

    /*
     * 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) {







|
|







866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
    }

    /*
     * Apply some peephole optimizations that can cross specific/generic
     * instruction generator boundaries.
     */

    if (iPtr->extra.optimizer) {
	(iPtr->extra.optimizer)(&compEnv);
    }

    /*
     * Invoke the compilation hook procedure if one exists.
     */

    if (hookProc) {
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148

	if (hePtr) {
	    ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr));
	    Tcl_DeleteHashEntry(hePtr);
	}
    }

    if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    Tcl_Free(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *







|




|







1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167

	if (hePtr) {
	    ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr));
	    Tcl_DeleteHashEntry(hePtr);
	}
    }

    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    ckfree(codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
		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);








|







1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
		iPtr->varFramePtr->localCachePtr)) {
	    Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	int 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);

1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
{
    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);
    }

    if (eclPtr->loc != NULL) {
	Tcl_Free(eclPtr->loc);
    }

    Tcl_Free(eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *







|



|


|







1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	ckfree(eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	ckfree(eclPtr->loc);
    }

    ckfree(eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    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. */
    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;







|






|







1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    CompileEnv *envPtr,/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    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+1].name == NULL);

    envPtr->iPtr = iPtr;
    envPtr->source = stringPtr;
    envPtr->numSrcBytes = numBytes;
    envPtr->procPtr = iPtr->compiledProcPtr;
    iPtr->compiledProcPtr = NULL;
    envPtr->numCommands = 0;
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
     * 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->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*







|







1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
     * 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 *)ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
 */

void
TclFreeCompileEnv(
    CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
	Tcl_Free(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.
	 */







|







1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
 */

void
TclFreeCompileEnv(
    CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
	ckfree(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.
	 */
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
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	Tcl_Free(envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	Tcl_Free(envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	Tcl_Free(envPtr->exceptArrayPtr);
	Tcl_Free(envPtr->exceptAuxArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
	Tcl_Free(envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	Tcl_Free(envPtr->auxDataArrayPtr);
    }
    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }
}








|


|


|
|


|


|







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
	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	ckfree(envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	ckfree(envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	ckfree(envPtr->exceptArrayPtr);
	ckfree(envPtr->exceptAuxArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
	ckfree(envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	ckfree(envPtr->auxDataArrayPtr);
    }
    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }
}

1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[4] = "";
		size_t length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

	default:







|







1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[4] = "";
		int length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

	default:
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
 *
 *----------------------------------------------------------------------
 */

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);
    }








|

















>



<






|
|












|



<
|







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

static int
ExpandRequested(
    Tcl_Token *tokenPtr,
    int 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)
{
    int numBytes;
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;


    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = TclGetStringFromObj(cmdObj, &numBytes);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, 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,
    int numWords,
    CompileEnv *envPtr)
{
    DefineLineInformation;

    int wordIdx = 0, depth = TclGetStackDepth(envPtr);

    if (cmdObj) {
	CompileCmdLiteral(interp, cmdObj, envPtr);
	wordIdx = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005

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







|







2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
	mapPtr->nuloc--;
	ckfree(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.
     */
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
    /*
     * 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
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine







|
|













|







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
    /*
     * TIP #280: Free full form of per-word line data and insert the reduced
     * form now
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;
    ckfree(eclPtr->loc[wlineat].line);
    ckfree(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. */
    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. */
{
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
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
	Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
	TclCompileSyntaxError(interp, envPtr);
	return;
    }

    /* Each iteration compiles one command from the script. */

    if (numBytes + 1 > 1) {
      /*
       * 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].
       */
      Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse));

      do {
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) {
	    /*
	     * Compile bytecodes to report the parsePtr error at runtime.
	     */

	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    parsePtr->term + 1 - parsePtr->commandStart);
	    TclCompileSyntaxError(interp, envPtr);
	    Tcl_Free(parsePtr);
	    return;
	}

#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.
	 * TODO: Suppress when numWords == 0 ?







|





|












|







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
	Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
	TclCompileSyntaxError(interp, envPtr);
	return;
    }

    /* Each iteration compiles one command from the script. */

    if (numBytes > 0) {
      /*
       * 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].
       */
      Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse));

      do {
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) {
	    /*
	     * Compile bytecodes to report the parsePtr error at runtime.
	     */

	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    parsePtr->term + 1 - parsePtr->commandStart);
	    TclCompileSyntaxError(interp, envPtr);
	    ckfree(parsePtr);
	    return;
	}

#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.
	 * TODO: Suppress when numWords == 0 ?
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267

	TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p);
	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		p - envPtr->source);
	Tcl_FreeParse(parsePtr);
      } while (numBytes > 0);

      Tcl_Free(parsePtr);
    }

    if (lastCmdIdx == -1) {
	/*
	 * Compiling the script yielded no bytecode.  The script must be all
	 * whitespace, comments, and empty commands.  Such scripts are defined
	 * to successfully produce the empty string result, so we emit the







|







2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285

	TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p);
	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		p - envPtr->source);
	Tcl_FreeParse(parsePtr);
      } while (numBytes > 0);

      ckfree(parsePtr);
    }

    if (lastCmdIdx == -1) {
	/*
	 * Compiling the script yielded no bytecode.  The script must be all
	 * whitespace, comments, and empty commands.  Such scripts are defined
	 * to successfully produce the empty string result, so we emit the
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
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).







|
|







2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    int nameBytes = tokenPtr[1].size;
    int i, 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).
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
    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;
    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*







|
<







2405
2406
2407
2408
2409
2410
2411
2412

2413
2414
2415
2416
2417
2418
2419
    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, length, adjust;

    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {







|







2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	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) {
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)Tcl_Realloc(clPosition,
                                maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }







|







2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)ckrealloc(clPosition,
                                maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
	    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);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */








|







2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	default:
	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */

2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     */

    if (maxNumCL) {
	Tcl_Free(clPosition);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*
 *----------------------------------------------------------------------
 *







|







2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     */

    if (maxNumCL) {
	ckfree(clPosition);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
	     * 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);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;







|







2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
	     * 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.
	     */
	    int numBytes;
	    const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = (unsigned char *)Tcl_Alloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);







|







2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = (unsigned char *)ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
 */

int
TclFindCompiledLocal(
    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*/
{
    CompiledLocal *localPtr;
    int localVar = -1;
    int i;







|







2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
 */

int
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    int 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*/
{
    CompiledLocal *localPtr;
    int localVar = -1;
    int i;
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
	 * 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)) {
		    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);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;







|








|
>

















|













|







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
	 * 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;
	int len;

	if (!cachePtr || !name) {
	    return -1;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = TclGetString(*varNamePtr);
		len = (*varNamePtr)->length;
		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)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
     * [inclusive].
     */

    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);
    } else {
	/*
	 * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 */

	unsigned char *newPtr = (unsigned char *)Tcl_Alloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;







|


|
|


|







3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	unsigned char *newPtr = (unsigned char *)ckalloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201

	size_t currElems = envPtr->cmdMapEnd;
	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);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a
	     * Tcl_Realloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = (CmdLocation *)Tcl_Alloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }







|


|
|


|







3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219

	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
	     * ckrealloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
	 * 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->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->nline = numWords;
    wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);







|





|
|

|







3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
	 * 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 *)ckrealloc(eclPtr->loc, newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = (int *)ckalloc(numWords * sizeof(int));
    ePtr->next = (int **)ckalloc(numWords * sizeof(int *));
    ePtr->nline = numWords;
    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);
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
	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 =
		    (ExceptionRange *)Tcl_Realloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    (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.
	     */

	    ExceptionRange *newPtr = (ExceptionRange *)Tcl_Alloc(newBytes);
	    ExceptionAux *newPtr2 = (ExceptionAux *)Tcl_Alloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}







|

|


|
|


|
|







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
	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 =
		    (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes);
	    ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
	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







|



|







3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
	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 *)ckrealloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
	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);
}








|



|







3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
	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 *)ckrealloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
    }

    /*
     * 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;
    }
}

/*
 *----------------------------------------------------------------------







|




|







3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
    }

    /*
     * Drop the arrays we were holding the only reference to.
     */

    if (auxPtr->breakTargets) {
	ckfree(auxPtr->breakTargets);
	auxPtr->breakTargets = NULL;
	auxPtr->numBreakTargets = 0;
    }
    if (auxPtr->continueTargets) {
	ckfree(auxPtr->continueTargets);
	auxPtr->continueTargets = NULL;
	auxPtr->numContinueTargets = 0;
    }
}

/*
 *----------------------------------------------------------------------
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770

	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);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	     * code a Tcl_Realloc equivalent for ourselves.
	     */

	    AuxData *newPtr = (AuxData *)Tcl_Alloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }







|


|
|


|







3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788

	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    AuxData *newPtr = (AuxData *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
     */

    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);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = (JumpFixup *)Tcl_Alloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}







|


|
|


|







3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
     */

    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 *)ckrealloc(fixupArrayPtr->fixup, newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
void
TclFreeJumpFixupArray(
    JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * free. */
{
    if (fixupArrayPtr->mallocedArray) {
	Tcl_Free(fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --







|







3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
void
TclFreeJumpFixupArray(
    JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * free. */
{
    if (fixupArrayPtr->mallocedArray) {
	ckfree(fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
				 * 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;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;







|







3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
				 * 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;
    unsigned numBytes;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;
Changes to generic/tclCompile.h.
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
				 * 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 {
    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. */







|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
				 * 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 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. */
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 * 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 {
    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 */
    int *line;			/* Line information for all words in the
				 * command. */
    int **next;			/* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;

typedef struct {
    int type;			/* Context type. */
    int start;			/* Starting line for compiled script. Needed
				 * for the extended recompile check in
				 * tclCompileObj. */
    Tcl_Obj *path;		/* Path of the sourced file the command is
				 * in. */
    ECL *loc;			/* Command word locations (lines). */







|

















|
|








|







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
 * 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 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 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
				 * for tracking of hidden continuation
				 * lines. */
} ECL;

typedef struct ExtCmdLoc {
    int type;			/* Context type. */
    int start;			/* Starting line for compiled script. Needed
				 * for the extended recompile check in
				 * tclCompileObj. */
    Tcl_Obj *path;		/* Path of the sourced file the command is
				 * in. */
    ECL *loc;			/* Command word locations (lines). */
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
 *
 * 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,
			    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







|
|
|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
 *
 * 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 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
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439

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







|







|



|







413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439

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. */
    unsigned 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. */
    unsigned int nsEpoch;	/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    unsigned 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
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592


593
594
595
596
597
598
599
600
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
	(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
 * 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 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 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 34 to 39 */
    INST_JUMP1,
    INST_JUMP4,
    INST_JUMP_TRUE1,
    INST_JUMP_TRUE4,
    INST_JUMP_FALSE1,
    INST_JUMP_FALSE4,

    /* 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 65 to 66 */
    INST_BREAK,
    INST_CONTINUE,





    /* Opcodes 69 to 72 */
    INST_BEGIN_CATCH4,
    INST_END_CATCH,
    INST_PUSH_RESULT,
    INST_PUSH_RETURN_CODE,

    /* Opcodes 73 to 78 */
    INST_STR_EQ,
    INST_STR_NEQ,
    INST_STR_CMP,
    INST_STR_LEN,
    INST_STR_INDEX,
    INST_STR_MATCH,

    /* Opcodes 79 to 81 */
    INST_LIST,
    INST_LIST_INDEX,
    INST_LIST_LENGTH,

    /* Opcodes 82 to 87 */
    INST_APPEND_SCALAR1,
    INST_APPEND_SCALAR4,
    INST_APPEND_ARRAY1,
    INST_APPEND_ARRAY4,
    INST_APPEND_ARRAY_STK,
    INST_APPEND_STK,

    /* Opcodes 88 to 93 */
    INST_LAPPEND_SCALAR1,
    INST_LAPPEND_SCALAR4,
    INST_LAPPEND_ARRAY1,
    INST_LAPPEND_ARRAY4,
    INST_LAPPEND_ARRAY_STK,
    INST_LAPPEND_STK,

    /* TIP #22 - LINDEX operator with flat arg list */

    INST_LIST_INDEX_MULTI,

    /*
     * TIP #33 - 'lset' command. Code gen also required a Forth-like
     *	     OVER operation.
     */

    INST_OVER,
    INST_LSET_LIST,
    INST_LSET_FLAT,

    /* TIP#90 - 'return' command. */

    INST_RETURN_IMM,

    /* TIP#123 - exponentiation operator. */

    INST_EXPON,

    /* TIP #157 - {*}... (word expansion) language syntax support. */

    INST_EXPAND_START,
    INST_EXPAND_STKTOP,
    INST_INVOKE_EXPANDED,

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

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

    /*
     * Instruction to support jumps defined by tables (instead of the classic
     * [switch] technique of chained comparisons).
     */

    INST_JUMP_TABLE,

    /*
     * Instructions to support compilation of global, variable, upvar and
     * [namespace upvar].
     */

    INST_UPVAR,
    INST_NSUPVAR,
    INST_VARIABLE,

    /* Instruction to support compiling syntax error to bytecode */

    INST_SYNTAX,

    /* Instruction to reverse N items on top of stack */

    INST_REVERSE,

    /* regexp instruction */

    INST_REGEXP,

    /* For [info exists] compilation */
    INST_EXIST_SCALAR,
    INST_EXIST_ARRAY,
    INST_EXIST_ARRAY_STK,
    INST_EXIST_STK,

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

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

    INST_INVOKE_REPLACE,

    INST_LIST_CONCAT,

    INST_EXPAND_DROP,

    /* New foreach implementation */
    INST_FOREACH_START,
    INST_FOREACH_STEP,
    INST_FOREACH_END,
    INST_LMAP_COLLECT,

    /* For compilation of [string trim] and related */
    INST_STR_TRIM,
    INST_STR_TRIM_LEFT,
    INST_STR_TRIM_RIGHT,

    INST_CONCAT_STK,

    INST_STR_UPPER,
    INST_STR_LOWER,
    INST_STR_TITLE,
    INST_STR_REPLACE,

    INST_ORIGIN_COMMAND,

    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
};

/*
 * 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"







|



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

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|

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

|
|
|

>
>
>
>
|
|
|
|
|

|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|

|
>
|

|
|
|
|
>
|
|
|

|
>
|

|
>
|

|
>
|
|
|

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

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

|
|
|
|
>
|

|
|
|
|
>
|
|
|

|
>
|

|
>
|

|
>
|

|
|
|
|
|

|
|
|

|
|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|

|
|
|
|

|
|
|
|
|

|
|
|
|
|

|
|
|
|
|

|

|

|

|
|
|
|
|

|
|
|
|

|

|
|
|
|

|

|
|

|

|
|
|

|
|
|
|

|

|

|
|
|
|
|

|
|
<







532
533
534
535
536
537
538
539
540
541
542

543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
	(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_LOR) must match the entries in the array operatorStrings in
 * tclExecute.c.
 */


/* 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_STR_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 */
#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 */
#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 */
#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 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 */
#define INST_BREAK			65
#define INST_CONTINUE			66

/* Opcodes 67 to 68 */
#define INST_FOREACH_START4		67 /* DEPRECATED */
#define INST_FOREACH_STEP4		68 /* DEPRECATED */

/* 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 */
#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 78 to 81 */
#define INST_LIST			79
#define INST_LIST_INDEX			80
#define INST_LIST_LENGTH		81

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

#define INST_LIST_INDEX_MULTI		94

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

#define INST_RETURN_IMM			98

/* TIP#123 - exponentiation operator. */

#define INST_EXPON			99

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

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

#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).
 */

#define INST_JUMP_TABLE			121

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

#define INST_SYNTAX			125

/* Instruction to reverse N items on top of stack */

#define INST_REVERSE			126

/* regexp instruction */

#define INST_REGEXP			127

/* For [info exists] compilation */
#define INST_EXIST_SCALAR		128
#define INST_EXIST_ARRAY		129
#define INST_EXIST_ARRAY_STK		130
#define INST_EXIST_STK			131

/* For [subst] compilation */
#define INST_NOP			132
#define INST_RETURN_CODE_BRANCH		133

/* For [unset] compilation */
#define INST_UNSET_SCALAR		134
#define INST_UNSET_ARRAY		135
#define INST_UNSET_ARRAY_STK		136
#define INST_UNSET_STK			137

/* For [dict with], [dict exists], [dict create] and [dict merge] */
#define INST_DICT_EXPAND		138
#define INST_DICT_RECOMBINE_STK		139
#define INST_DICT_RECOMBINE_IMM		140
#define INST_DICT_EXISTS		141
#define INST_DICT_VERIFY		142

/* For [string map] and [regsub] compilation */
#define INST_STR_MAP			143
#define INST_STR_FIND			144
#define INST_STR_FIND_LAST		145
#define INST_STR_RANGE_IMM		146
#define INST_STR_RANGE			147

/* For operations to do with coroutines and other NRE-manipulators */
#define INST_YIELD			148
#define INST_COROUTINE_NAME		149
#define INST_TAILCALL			150

/* For compilation of basic information operations */
#define INST_NS_CURRENT			151
#define INST_INFO_LEVEL_NUM		152
#define INST_INFO_LEVEL_ARGS		153
#define INST_RESOLVE_COMMAND		154

/* For compilation relating to TclOO */
#define INST_TCLOO_SELF			155
#define INST_TCLOO_CLASS		156
#define INST_TCLOO_NS			157
#define INST_TCLOO_IS_OBJECT		158

/* For compilation of [array] subcommands */
#define INST_ARRAY_EXISTS_STK		159
#define INST_ARRAY_EXISTS_IMM		160
#define INST_ARRAY_MAKE_STK		161
#define INST_ARRAY_MAKE_IMM		162

#define INST_INVOKE_REPLACE		163

#define INST_LIST_CONCAT		164

#define INST_EXPAND_DROP		165

/* New foreach implementation */
#define INST_FOREACH_START              166
#define INST_FOREACH_STEP               167
#define INST_FOREACH_END                168
#define INST_LMAP_COLLECT               169

/* For compilation of [string trim] and related */
#define INST_STR_TRIM			170
#define INST_STR_TRIM_LEFT		171
#define INST_STR_TRIM_RIGHT		172

#define INST_CONCAT_STK			173

#define INST_STR_UPPER			174
#define INST_STR_LOWER			175
#define INST_STR_TITLE			176
#define INST_STR_REPLACE		177

#define INST_ORIGIN_COMMAND		178

#define INST_TCLOO_NEXT			179
#define INST_TCLOO_NEXT_CLASS		180

#define INST_YIELD_TO_INVOKE		181

#define INST_NUM_TYPE			182
#define INST_TRY_CVT_TO_BOOLEAN		183
#define INST_STR_CLASS			184

#define INST_LAPPEND_LIST		185
#define INST_LAPPEND_LIST_ARRAY		186
#define INST_LAPPEND_LIST_ARRAY_STK	187
#define INST_LAPPEND_LIST_STK		188

#define INST_CLOCK_READ			189

#define INST_DICT_GET_DEF		190

/* TIP 461 */
#define INST_STR_LT			191
#define INST_STR_GT			192
#define INST_STR_LE			193
#define INST_STR_GE			194

/* The last opcode */
#define LAST_INST_OPCODE		194


/*
 * 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"
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
    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. */
    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];







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
    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. */
    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];
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
/*
 * 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
				 * 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;







|







1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
/*
 * 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 {
    int length;			/* Size of array */
    int varIndices[TCLFLEXARRAY];		/* 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;
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
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    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	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,
			    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	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 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);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(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 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,
			    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	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t 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 void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, size_t 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);
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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    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.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *
 * void *TclFetchAuxData(CompileEng *envPtr, int index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02







|




|


|








|



|

|













|
|







|





|














|











|

|









|


|


|


|










|




|














|







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
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
			    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,
			    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, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    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(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const 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);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
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,
			    int before, int 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	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    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, int 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 void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int 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);
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(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    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,
			    int 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(ClientData 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.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *
 * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02
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
    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







|







|















|







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
    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, int 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, (int) (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 int	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)

/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	char n[35];						\
	sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log",		\
		(size_t) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\
	    int _l, _t = 0;						\







|
|







1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	char n[35];						\
	sprintf(n, "/tmp/tclDTraceDebug-%lu.log",		\
		(unsigned long) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\
	    int _l, _t = 0;						\
Changes to generic/tclConfig.c.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

/*
 * 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 {
    Tcl_Obj *pkg;
    Tcl_Interp *interp;
    char *encoding;
} QCCD;

/*
 * Static functions in this file:







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

/*
 * 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 QCCD {
    Tcl_Obj *pkg;
    Tcl_Interp *interp;
    char *encoding;
} QCCD;

/*
 * Static functions in this file:
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
    const 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));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = (char *)Tcl_Alloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*







|



|







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
    const 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 *)ckalloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
{
    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[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    };
    Tcl_DString conv;







<
|







195
196
197
198
199
200
201

202
203
204
205
206
207
208
209
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;

    int n, index;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    };
    Tcl_DString conv;
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
		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 = 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);

	if (!listPtr) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "insufficient memory to create list", -1));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    return TCL_ERROR;
	}

	if (m) {
	    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);







|












|
|








|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
		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 *) 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, &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);
	    return TCL_ERROR;
	}

	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);
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
    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);
    }
    Tcl_Free(cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *







|

|







326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
    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) {
	ckfree(cdPtr->encoding);
    }
    ckfree(cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *
Changes to generic/tclDTrace.d.
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
    void *freeIntRepProc;
    void *dupIntRepProc;
    void *updateStringProc;
    void *setFromAnyProc;
} Tcl_ObjType;

struct Tcl_Obj {
    size_t refCount;
    char *bytes;
    size_t length;
    const Tcl_ObjType *typePtr;
    union {
	long longValue;
	double doubleValue;
	void *otherValuePtr;
	int64_t wideValue;
	struct {







|

|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
    void *freeIntRepProc;
    void *dupIntRepProc;
    void *updateStringProc;
    void *setFromAnyProc;
} Tcl_ObjType;

struct Tcl_Obj {
    int refCount;
    char *bytes;
    int length;
    const Tcl_ObjType *typePtr;
    union {
	long longValue;
	double doubleValue;
	void *otherValuePtr;
	int64_t wideValue;
	struct {
Changes to generic/tclDate.c.
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((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)







|
|







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#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)
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(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;







|







2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    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

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

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







|







2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
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
    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;
    }

    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}








|
|


|

|

|




|





|


|





|


|

|

|



|


|

|



|


|

|







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
    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);
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    TclNewObj(resultElement);
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) -yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

Changes to generic/tclDecls.h.
55
56
57
58
59
60
61
62
63
64
65
66
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 */
EXTERN const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 2 */
EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN void *		Tcl_Alloc(size_t size);
/* 4 */
EXTERN void		Tcl_Free(void *ptr);
/* 5 */
EXTERN void *		Tcl_Realloc(void *ptr, size_t size);
/* 6 */
EXTERN void *		Tcl_DbCkalloc(size_t size, const char *file,
				int line);
/* 7 */
EXTERN void		Tcl_DbCkfree(void *ptr, const char *file, int line);
/* 8 */
EXTERN void *		Tcl_DbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */







|

|

|

|


|

|




|




|







55
56
57
58
59
60
61
62
63
64
65
66
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 */
EXTERN const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 2 */
EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 3 */
EXTERN char *		Tcl_Alloc(unsigned int size);
/* 4 */
EXTERN void		Tcl_Free(char *ptr);
/* 5 */
EXTERN char *		Tcl_Realloc(char *ptr, unsigned int size);
/* 6 */
EXTERN char *		Tcl_DbCkalloc(unsigned int size, const char *file,
				int line);
/* 7 */
EXTERN void		Tcl_DbCkfree(char *ptr, const char *file, int line);
/* 8 */
EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
				const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, ClientData clientData);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, ClientData clientData);
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 10 */
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121



122
123
124
125
126
127
128
129
130
131



132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156




157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
/* 14 */
EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 15 */
EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
/* 17 */
EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 20 */
EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 21 */
EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
				int line);
/* Slot 22 is reserved */



/* 23 */
EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				size_t length, const char *file, int line);
/* 24 */
EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
/* 25 */
EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* Slot 26 is reserved */



/* 27 */
EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
/* 28 */
EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, size_t length,
				const char *file, int line);
/* 29 */
EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
				int *boolPtr);
/* 32 */
EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *boolPtr);
/* 33 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
				double *doublePtr);
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
/* Slot 36 is reserved */




/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);







|














|
>
>
>


|






|
>
>
>



|




















|
>
>
>
>










|







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
/* 14 */
EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 15 */
EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
/* 16 */
EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
				int length);
/* 17 */
EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
/* 18 */
EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
/* 19 */
EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 20 */
EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
				int line);
/* 21 */
EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
				int line);
/* 22 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj *		Tcl_DbNewBooleanObj(int boolValue, const char *file,
				int line);
/* 23 */
EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				int length, const char *file, int line);
/* 24 */
EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
/* 25 */
EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* 26 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj *		Tcl_DbNewLongObj(long longValue, const char *file,
				int line);
/* 27 */
EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
/* 28 */
EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, int length,
				const char *file, int line);
/* 29 */
EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
/* 31 */
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
				int *boolPtr);
/* 32 */
EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *boolPtr);
/* 33 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
				double *doublePtr);
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
/* 36 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_GetIndexFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *const *tablePtr,
				const char *msg, int flags, int *indexPtr);
/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
				int *intPtr);
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
/* 40 */
EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
/* 41 */
EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
/* 42 */
EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
/* 43 */
EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
186
187
188
189
190
191
192
193


194
195
196
197
198
199


200
201
202


203
204
205
206
207


208
209
210
211
212
213
214
215
216


217
218
219
220


221
222
223
224
225
226



227



228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246


247


248
249
250
251
252
253
254

255
256
257
258

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303





304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357

358
359
360
361

362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391

392
393
394
395


396
397
398
399
400
401
402
403
404
/* 47 */
EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *lengthPtr);
/* 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 */


/* 50 */
EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				size_t length);
/* 51 */
EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
/* Slot 52 is reserved */


/* 53 */
EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* Slot 54 is reserved */


/* 55 */
EXTERN Tcl_Obj *	Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, size_t length);
/* Slot 57 is reserved */


/* 58 */
EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr,
				size_t length);
/* 59 */
EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, size_t length);
/* 60 */
EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* Slot 61 is reserved */


/* 62 */
EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* Slot 63 is reserved */


/* 64 */
EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length);
/* 65 */
EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
/* Slot 66 is reserved */



/* Slot 67 is reserved */



/* 68 */
EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
/* 70 */
EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
				void *clientData);
/* 72 */
EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
/* Slot 76 is reserved */


/* Slot 77 is reserved */


/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);

/* 80 */
EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				void *clientData);
/* Slot 81 is reserved */

/* 82 */
EXTERN int		Tcl_CommandComplete(const char *cmd);
/* 83 */
EXTERN char *		Tcl_Concat(int argc, const char *const *argv);
/* 84 */
EXTERN size_t		Tcl_ConvertElement(const char *src, char *dst,
				int flags);
/* 85 */
EXTERN size_t		Tcl_ConvertCountedElement(const char *src,
				size_t length, char *dst, int flags);
/* 86 */
EXTERN int		Tcl_CreateAlias(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				const char *const *argv);
/* 87 */
EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
/* 88 */
EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
				const char *chanName, void *instanceData,
				int mask);
/* 89 */
EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
				Tcl_ChannelProc *proc, void *clientData);
/* 90 */
EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
/* 91 */
EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdProc *proc,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 92 */
EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
/* Slot 95 is reserved */





/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 97 */
EXTERN Tcl_Interp *	Tcl_CreateChild(Tcl_Interp *interp, const char *name,
				int isSafe);
/* 98 */
EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, void *clientData);
/* 99 */
EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc, void *clientData);

/* 100 */
EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, void *clientData);
/* 102 */
EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
/* 103 */
EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
				const char *cmdName);
/* 104 */
EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
				Tcl_Command command);
/* 105 */
EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
				void *clientData);
/* 106 */
EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
/* 107 */
EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 108 */
EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);

/* 115 */
EXTERN int		Tcl_DoOneEvent(int flags);
/* 116 */
EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData);

/* 117 */
EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
				const char *bytes, size_t length);
/* 118 */
EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
				const char *element);
/* 119 */
EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 122 */
EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 124 */
EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr,
				size_t length);
/* 125 */
EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
EXTERN int		Tcl_Eof(Tcl_Channel chan);
/* 127 */
EXTERN const char *	Tcl_ErrnoId(void);
/* 128 */
EXTERN const char *	Tcl_ErrnoMsg(int err);
/* Slot 129 is reserved */

/* 130 */
EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* Slot 131 is reserved */


/* 132 */
EXTERN void		Tcl_EventuallyFree(void *clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
EXTERN TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
				const char *hiddenCmdToken,
				const char *cmdName);







|
>
>


|


|
>
>


|
>
>



|
|
>
>

|
<


|


|
>
>



|
>
>

|


|
|
>
>
>
|
>
>
>









|








|
>
>
|
>
>






|
>


|
|
>





|


|
|












|
|


|


|



|




|


|


|
>
>
>
>
>



|






|


|
>





|


|








|



|


|














|
>



|
>


|
















|
<








|
>



|
>
>

|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
/* 47 */
EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *lengthPtr);
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int first, int count,
				int objc, Tcl_Obj *const objv[]);
/* 49 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj *		Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				int length);
/* 51 */
EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
/* 52 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj *		Tcl_NewIntObj(int intValue);
/* 53 */
EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_Obj *		Tcl_NewLongObj(long longValue);
/* 55 */
EXTERN Tcl_Obj *	Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);

/* 59 */
EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, int length);
/* 60 */
EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* 63 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* 64 */
EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				int length);
/* 66 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_AddErrorInfo(Tcl_Interp *interp,
				const char *message);
/* 67 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_AddObjErrorInfo(Tcl_Interp *interp,
				const char *message, int length);
/* 68 */
EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
/* 69 */
EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
/* 70 */
EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
/* 71 */
EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
				ClientData clientData);
/* 72 */
EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
/* 73 */
EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
/* 76 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
TCL_DEPRECATED("Use Tcl_UtfBackslash")
char			Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 80 */
EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				ClientData clientData);
/* 81 */
EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
EXTERN int		Tcl_CommandComplete(const char *cmd);
/* 83 */
EXTERN char *		Tcl_Concat(int argc, const char *const *argv);
/* 84 */
EXTERN int		Tcl_ConvertElement(const char *src, char *dst,
				int flags);
/* 85 */
EXTERN int		Tcl_ConvertCountedElement(const char *src,
				int length, char *dst, int flags);
/* 86 */
EXTERN int		Tcl_CreateAlias(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				const char *const *argv);
/* 87 */
EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
/* 88 */
EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
				const char *chanName,
				ClientData instanceData, int mask);
/* 89 */
EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
				Tcl_ChannelProc *proc, ClientData clientData);
/* 90 */
EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, ClientData clientData);
/* 91 */
EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 92 */
EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				ClientData clientData);
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
/* 95 */
TCL_DEPRECATED("")
void			Tcl_CreateMathFunc(Tcl_Interp *interp,
				const char *name, int numArgs,
				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
				ClientData clientData);
/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 97 */
EXTERN Tcl_Interp *	Tcl_CreateChild(Tcl_Interp *interp, const char *name,
				int isSafe);
/* 98 */
EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, ClientData clientData);
/* 99 */
EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc,
				ClientData clientData);
/* 100 */
EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
/* 101 */
EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, ClientData clientData);
/* 102 */
EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, ClientData clientData);
/* 103 */
EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
				const char *cmdName);
/* 104 */
EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
				Tcl_Command command);
/* 105 */
EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
				ClientData clientData);
/* 106 */
EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				ClientData clientData);
/* 107 */
EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 108 */
EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
/* 109 */
EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
/* 110 */
EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
/* 111 */
EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
/* 112 */
EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
/* 113 */
EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
/* 114 */
EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 115 */
EXTERN int		Tcl_DoOneEvent(int flags);
/* 116 */
EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
				ClientData clientData);
/* 117 */
EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
				const char *bytes, int length);
/* 118 */
EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
				const char *element);
/* 119 */
EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
/* 120 */
EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
/* 121 */
EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 122 */
EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
/* 123 */
EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
/* 124 */
EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);

/* 125 */
EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
EXTERN int		Tcl_Eof(Tcl_Channel chan);
/* 127 */
EXTERN const char *	Tcl_ErrnoId(void);
/* 128 */
EXTERN const char *	Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* 131 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
EXTERN void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
EXTERN TCL_NORETURN void Tcl_Exit(int status);
/* 134 */
EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
				const char *hiddenCmdToken,
				const char *cmdName);
423
424
425
426
427
428
429
430

431
432
433
434
435
436


437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
/* 141 */
EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				Tcl_Obj **resultPtrPtr);
/* 142 */
EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
EXTERN void		Tcl_Finalize(void);
/* Slot 144 is reserved */

/* 145 */
EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
				Tcl_HashSearch *searchPtr);
/* 146 */
EXTERN int		Tcl_Flush(Tcl_Channel chan);
/* Slot 147 is reserved */


/* 148 */
EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
				const char *childCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *argcPtr,
				const char ***argvPtr);
/* 149 */
EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *childCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
/* 150 */
EXTERN void *		Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
				Tcl_InterpDeleteProc **procPtr);
/* 151 */
EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
/* 152 */
EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				void **handlePtr);
/* 154 */
EXTERN void *		Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
EXTERN const char *	Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				Tcl_DString *dsPtr);
/* 158 */
EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
EXTERN const char *	Tcl_GetCommandName(Tcl_Interp *interp,
				Tcl_Command command);
/* 161 */







|
>





|
>
>













|









|

|









|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
/* 141 */
EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				Tcl_Obj **resultPtrPtr);
/* 142 */
EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
/* 143 */
EXTERN void		Tcl_Finalize(void);
/* 144 */
EXTERN void		Tcl_FindExecutable(const char *argv0);
/* 145 */
EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
				Tcl_HashSearch *searchPtr);
/* 146 */
EXTERN int		Tcl_Flush(Tcl_Channel chan);
/* 147 */
TCL_DEPRECATED("see TIP #559. Use Tcl_ResetResult")
void			Tcl_FreeResult(Tcl_Interp *interp);
/* 148 */
EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
				const char *childCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *argcPtr,
				const char ***argvPtr);
/* 149 */
EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *childCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
/* 150 */
EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
				Tcl_InterpDeleteProc **procPtr);
/* 151 */
EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
/* 152 */
EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
/* 153 */
EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				ClientData *handlePtr);
/* 154 */
EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
EXTERN const char *	Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				Tcl_DString *dsPtr);
/* 158 */
EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
/* 159 */
EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
EXTERN const char *	Tcl_GetCommandName(Tcl_Interp *interp,
				Tcl_Command command);
/* 161 */
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

517



518
519
520
521


522



523
524
525
526
527
528
529
EXTERN const char *	Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
#endif /* MACOSX */
/* 168 */
EXTERN Tcl_PathType	Tcl_GetPathType(const char *path);
/* 169 */
EXTERN size_t		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
EXTERN size_t		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int		Tcl_GetServiceMode(void);
/* 172 */
EXTERN Tcl_Interp *	Tcl_GetChild(Tcl_Interp *interp, const char *name);
/* 173 */
EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
/* Slot 174 is reserved */

/* Slot 175 is reserved */



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



/* 179 */
EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
				const char *cmdName,
				const char *hiddenCmdToken);
/* 180 */
EXTERN int		Tcl_Init(Tcl_Interp *interp);
/* 181 */







|





|




|

|






|
>
|
>
>
>



|
>
>
|
>
>
>







535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
EXTERN const char *	Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif /* MACOSX */
/* 168 */
EXTERN Tcl_PathType	Tcl_GetPathType(const char *path);
/* 169 */
EXTERN int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
/* 170 */
EXTERN int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int		Tcl_GetServiceMode(void);
/* 172 */
EXTERN Tcl_Interp *	Tcl_GetChild(Tcl_Interp *interp, const char *name);
/* 173 */
EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
/* 174 */
EXTERN const char *	Tcl_GetStringResult(Tcl_Interp *interp);
/* 175 */
TCL_DEPRECATED("No longer in use, changed to macro")
const char *		Tcl_GetVar(Tcl_Interp *interp, const char *varName,
				int flags);
/* 176 */
EXTERN const char *	Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 177 */
EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
				const char *command);
/* 178 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_GlobalEvalObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 179 */
EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
				const char *cmdName,
				const char *hiddenCmdToken);
/* 180 */
EXTERN int		Tcl_Init(Tcl_Interp *interp);
/* 181 */
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				void *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(void *handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(void *tcpSocket);
/* 192 */
EXTERN char *		Tcl_Merge(int argc, const char *const *argv);
/* 193 */
EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */







|



|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				void *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
EXTERN char *		Tcl_Merge(int argc, const char *const *argv);
/* 193 */
EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
/* 195 */
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
				int myport, int async);
/* 200 */
EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
				const char *host,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 201 */
EXTERN void		Tcl_Preserve(void *data);
/* 202 */
EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
EXTERN int		Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
/* 206 */
EXTERN size_t		Tcl_Read(Tcl_Channel chan, char *bufPtr,
				size_t toRead);
/* 207 */
EXTERN void		Tcl_ReapDetachedProcs(void);
/* 208 */
EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);
/* 209 */
EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,







|

|











|
<







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
EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
				int myport, int async);
/* 200 */
EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
				const char *host,
				Tcl_TcpAcceptProc *acceptProc,
				ClientData callbackData);
/* 201 */
EXTERN void		Tcl_Preserve(ClientData data);
/* 202 */
EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
/* 203 */
EXTERN int		Tcl_PutEnv(const char *assignment);
/* 204 */
EXTERN const char *	Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
/* 206 */
EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);

/* 207 */
EXTERN void		Tcl_ReapDetachedProcs(void);
/* 208 */
EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);
/* 209 */
EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
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
/* 213 */
EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
/* 214 */
EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
/* 215 */
EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, size_t index,
				const char **startPtr, const char **endPtr);
/* 216 */
EXTERN void		Tcl_Release(void *clientData);
/* 217 */
EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
EXTERN size_t		Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
EXTERN size_t		Tcl_ScanCountedElement(const char *src,
				size_t length, int *flagPtr);
/* Slot 220 is reserved */


/* 221 */
EXTERN int		Tcl_ServiceAll(void);
/* 222 */
EXTERN int		Tcl_ServiceEvent(int flags);
/* 223 */
EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
				void *clientData);
/* 224 */
EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				const char *newValue);
/* 226 */
EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
				const char *cmdName,
				const Tcl_CmdInfo *infoPtr);
/* 227 */
EXTERN void		Tcl_SetErrno(int err);
/* 228 */
EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void		Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* Slot 230 is reserved */


/* 231 */
EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* Slot 232 is reserved */


/* 233 */
EXTERN int		Tcl_SetServiceMode(int mode);
/* 234 */
EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
				Tcl_Obj *errorObjPtr);
/* 235 */
EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr);
/* 236 */
EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* Slot 237 is reserved */



/* 238 */
EXTERN const char *	Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *newValue,
				int flags);
/* 239 */
EXTERN const char *	Tcl_SignalId(int sig);
/* 240 */
EXTERN const char *	Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, int *argcPtr,
				const char ***argvPtr);
/* 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 */




/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc, void *clientData);

/* 249 */
EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
/* 250 */
EXTERN size_t		Tcl_Ungets(Tcl_Channel chan, const char *str,
				size_t len, int atHead);
/* 251 */
EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
/* 252 */
EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 253 is reserved */



/* 254 */
EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* Slot 255 is reserved */





/* 256 */
EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				void *clientData);
/* 257 */
EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* Slot 258 is reserved */




/* 259 */
EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* 260 */
EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
/* Slot 261 is reserved */





/* 262 */
EXTERN void *		Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				void *prevClientData);
/* 263 */
EXTERN size_t		Tcl_Write(Tcl_Channel chan, const char *s,
				size_t slen);
/* 264 */
EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
/* Slot 267 is reserved */



/* Slot 268 is reserved */



/* 269 */
EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
EXTERN const char *	Tcl_ParseVar(Tcl_Interp *interp, const char *start,
				const char **termPtr);
/* Slot 271 is reserved */



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


/* 277 */
EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* Slot 278 is reserved */


/* 279 */
EXTERN void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
				const Tcl_ChannelType *typePtr,
				void *instanceData, int mask,
				Tcl_Channel prevChan);
/* 282 */
EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 283 */
EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
/* 286 */
EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
				Tcl_Obj *appendObjPtr);
/* 287 */
EXTERN Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* 289 */
EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* Slot 290 is reserved */

/* 291 */
EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
				size_t numBytes, int flags);
/* 292 */
EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 293 */
EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 294 */
EXTERN TCL_NORETURN void Tcl_ExitThread(int status);
/* 295 */
EXTERN 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);
/* 296 */
EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				Tcl_DString *dsPtr);
/* 297 */
EXTERN void		Tcl_FinalizeThread(void);
/* 298 */
EXTERN void		Tcl_FinalizeNotifier(void *clientData);
/* 299 */
EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
/* 301 */
EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
EXTERN const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				size_t offset, const char *msg, int flags,
				int *indexPtr);
/* 305 */
EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				size_t size);
/* 306 */
EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 307 */
EXTERN void *		Tcl_InitNotifier(void);
/* 308 */
EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
EXTERN size_t		Tcl_NumUtfChars(const char *src, size_t length);
/* 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 */


/* 316 */
EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
				const char *name);
/* 317 */
EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
				int flags);
/* 318 */
EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
EXTERN int		Tcl_UniCharAtIndex(const char *src, size_t index);
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */
EXTERN int		Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN const char *	Tcl_UtfAtIndex(const char *src, size_t index);
/* 326 */
EXTERN int		Tcl_UtfCharComplete(const char *src, size_t length);
/* 327 */
EXTERN size_t		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
/* 328 */
EXTERN const char *	Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
EXTERN const char *	Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
EXTERN const char *	Tcl_UtfNext(const char *src);
/* 331 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
EXTERN 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);
/* 333 */
EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				Tcl_DString *dsPtr);
/* 334 */
EXTERN int		Tcl_UtfToLower(char *src);
/* 335 */
EXTERN int		Tcl_UtfToTitle(char *src);
/* 336 */
EXTERN int		Tcl_UtfToChar16(const char *src,
				unsigned short *chPtr);
/* 337 */
EXTERN int		Tcl_UtfToUpper(char *src);
/* 338 */
EXTERN size_t		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				size_t srcLen);
/* 339 */
EXTERN size_t		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
/* Slot 341 is reserved */


/* Slot 342 is reserved */


/* 343 */
EXTERN void		Tcl_AlertNotifier(void *clientData);
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
EXTERN int		Tcl_UniCharIsAlpha(int ch);
/* 347 */
EXTERN int		Tcl_UniCharIsDigit(int ch);
/* 348 */
EXTERN int		Tcl_UniCharIsLower(int ch);
/* 349 */
EXTERN int		Tcl_UniCharIsSpace(int ch);
/* 350 */
EXTERN int		Tcl_UniCharIsUpper(int ch);
/* 351 */
EXTERN int		Tcl_UniCharIsWordChar(int ch);
/* Slot 352 is reserved */


/* Slot 353 is reserved */




/* 354 */
EXTERN char *		Tcl_Char16ToUtfDString(const unsigned short *uniStr,
				size_t uniLength, Tcl_DString *dsPtr);
/* 355 */
EXTERN unsigned short *	 Tcl_UtfToChar16DString(const char *src,
				size_t length, Tcl_DString *dsPtr);
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* Slot 357 is reserved */



/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				size_t length);
/* 360 */
EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 361 */
EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				int nested, Tcl_Parse *parsePtr);
/* 362 */
EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				size_t numBytes, Tcl_Parse *parsePtr);
/* 363 */
EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 364 */
EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				Tcl_Parse *parsePtr, int append);
/* 365 */
EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
EXTERN int		Tcl_Chdir(const char *dirName);
/* 367 */
EXTERN int		Tcl_Access(const char *path, int mode);
/* 368 */
EXTERN int		Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
EXTERN int		Tcl_UtfNcmp(const char *s1, const char *s2, size_t n);

/* 370 */
EXTERN int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
				size_t n);
/* 371 */
EXTERN int		Tcl_StringCaseMatch(const char *str,
				const char *pattern, int nocase);
/* 372 */
EXTERN int		Tcl_UniCharIsControl(int ch);
/* 373 */
EXTERN int		Tcl_UniCharIsGraph(int ch);
/* 374 */
EXTERN int		Tcl_UniCharIsPrint(int ch);
/* 375 */
EXTERN int		Tcl_UniCharIsPunct(int ch);
/* 376 */
EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				size_t offset, size_t nmatches, int flags);
/* 377 */
EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
/* 378 */
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
				size_t numChars);
/* 379 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t numChars);
/* 380 */
EXTERN size_t		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);
/* Slot 382 is reserved */


/* 383 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
				size_t last);
/* Slot 384 is reserved */



/* 385 */
EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
/* 388 */
EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
				const char *pattern);
/* 390 */
EXTERN int		Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp,

				int objc, Tcl_Obj *const objv[]);
/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,

				size_t stackSize, int flags);
/* 394 */
EXTERN size_t		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				size_t bytesToRead);
/* 395 */
EXTERN size_t		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				size_t srcLen);
/* 396 */
EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
EXTERN const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
				const Tcl_ChannelType *chanTypePtr);
/* 400 */
EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
				const Tcl_ChannelType *chanTypePtr);
/* Slot 401 is reserved */



/* 402 */
EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
				const Tcl_ChannelType *chanTypePtr);
/* 403 */
EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
				const Tcl_ChannelType *chanTypePtr);
/* 404 */
EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
				const Tcl_ChannelType *chanTypePtr);
/* Slot 405 is reserved */



/* 406 */
EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 407 */
EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 408 */







|


|



|

|
|
|
>
>







|
















|
>
>


|
>
>










|
>
>
>

















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



|
>




|
|






|
>
>
>



|
>
>
>
>
>




|



|
>
>
>
>






|
>
>
>
>
>

|


|

|
<







|
>
>
>
|
>
>
>





|
>
>
>




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


|
>
>








|
















|


|
|
>


|











|

|



|




|













|



|




|










|

|
|
|
>
>
|
>
>













|









|

|

|












|

|



|











|
|

|


|
>
>
|
>
>

|
















|
>
>
|
>
>
>
>


|

|
|



|
>
>
>





|


|




|
|


|


|




|










|
>


|














|





|


|

|

|
|
>
>

|
<
|
>
>
>













|
>
|






|
>
|

|
|

|
|












|
>
>
>









|
>
>
>







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
/* 213 */
EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
/* 214 */
EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
/* 215 */
EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
				const char **startPtr, const char **endPtr);
/* 216 */
EXTERN void		Tcl_Release(ClientData clientData);
/* 217 */
EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
/* 218 */
EXTERN int		Tcl_ScanElement(const char *src, int *flagPtr);
/* 219 */
EXTERN int		Tcl_ScanCountedElement(const char *src, int length,
				int *flagPtr);
/* 220 */
TCL_DEPRECATED("")
int			Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
EXTERN int		Tcl_ServiceAll(void);
/* 222 */
EXTERN int		Tcl_ServiceEvent(int flags);
/* 223 */
EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
				ClientData clientData);
/* 224 */
EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
/* 225 */
EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				const char *newValue);
/* 226 */
EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
				const char *cmdName,
				const Tcl_CmdInfo *infoPtr);
/* 227 */
EXTERN void		Tcl_SetErrno(int err);
/* 228 */
EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
/* 229 */
EXTERN void		Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* 230 */
EXTERN void		Tcl_SetPanicProc(
				TCL_NORETURN1 Tcl_PanicProc *panicProc);
/* 231 */
EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
/* 232 */
EXTERN void		Tcl_SetResult(Tcl_Interp *interp, char *result,
				Tcl_FreeProc *freeProc);
/* 233 */
EXTERN int		Tcl_SetServiceMode(int mode);
/* 234 */
EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
				Tcl_Obj *errorObjPtr);
/* 235 */
EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr);
/* 236 */
EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* 237 */
TCL_DEPRECATED("No longer in use, changed to macro")
const char *		Tcl_SetVar(Tcl_Interp *interp, const char *varName,
				const char *newValue, int flags);
/* 238 */
EXTERN const char *	Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *newValue,
				int flags);
/* 239 */
EXTERN const char *	Tcl_SignalId(int sig);
/* 240 */
EXTERN const char *	Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, int *argcPtr,
				const char ***argvPtr);
/* 243 */
EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
				const char ***argvPtr);
/* 244 */
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 245 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
int			Tcl_TellOld(Tcl_Channel chan);
/* 247 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 249 */
EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
/* 250 */
EXTERN int		Tcl_Ungets(Tcl_Channel chan, const char *str,
				int len, int atHead);
/* 251 */
EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
/* 252 */
EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 253 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
				int flags);
/* 254 */
EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 255 */
TCL_DEPRECATED("No longer in use, changed to macro")
void			Tcl_UntraceVar(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 256 */
EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
/* 257 */
EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* 258 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
				const char *varName, const char *localName,
				int flags);
/* 259 */
EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
/* 260 */
EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
/* 261 */
TCL_DEPRECATED("No longer in use, changed to macro")
ClientData		Tcl_VarTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 262 */
EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
/* 263 */
EXTERN int		Tcl_Write(Tcl_Channel chan, const char *s, int slen);

/* 264 */
EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_AppendResultVA(Tcl_Interp *interp,
				va_list argList);
/* 268 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
				va_list argList);
/* 269 */
EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
EXTERN const char *	Tcl_ParseVar(Tcl_Interp *interp, const char *start,
				const char **termPtr);
/* 271 */
TCL_DEPRECATED("No longer in use, changed to macro")
const char *		Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
				const char *version, int exact);
/* 272 */
EXTERN const char *	Tcl_PkgPresentEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* 273 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
				const char *version);
/* 274 */
TCL_DEPRECATED("No longer in use, changed to macro")
const char *		Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
				const char *version, int exact);
/* 275 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_SetErrorCodeVA(Tcl_Interp *interp,
				va_list argList);
/* 276 */
TCL_DEPRECATED("see TIP #422")
int			Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
TCL_DEPRECATED("see TIP #422")
TCL_NORETURN void	Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
				const Tcl_ChannelType *typePtr,
				ClientData instanceData, int mask,
				Tcl_Channel prevChan);
/* 282 */
EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 283 */
EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
/* 284 */
EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
/* Slot 285 is reserved */
/* 286 */
EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
				Tcl_Obj *appendObjPtr);
/* 287 */
EXTERN Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
/* 288 */
EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 289 */
EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 290 */
EXTERN void		Tcl_DiscardResult(Tcl_SavedResult *statePtr);
/* 291 */
EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
				int numBytes, int flags);
/* 292 */
EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 293 */
EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 294 */
EXTERN TCL_NORETURN void Tcl_ExitThread(int status);
/* 295 */
EXTERN 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);
/* 296 */
EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
				const char *src, int srcLen,
				Tcl_DString *dsPtr);
/* 297 */
EXTERN void		Tcl_FinalizeThread(void);
/* 298 */
EXTERN void		Tcl_FinalizeNotifier(ClientData clientData);
/* 299 */
EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
/* 300 */
EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
/* 301 */
EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
EXTERN const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				int offset, const char *msg, int flags,
				int *indexPtr);
/* 305 */
EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				int size);
/* 306 */
EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* 307 */
EXTERN ClientData	Tcl_InitNotifier(void);
/* 308 */
EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
/* 309 */
EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
/* 310 */
EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
/* 311 */
EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
/* 312 */
EXTERN int		Tcl_NumUtfChars(const char *src, int length);
/* 313 */
EXTERN int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
				int charsToRead, int appendFlag);
/* 314 */
EXTERN void		Tcl_RestoreResult(Tcl_Interp *interp,
				Tcl_SavedResult *statePtr);
/* 315 */
EXTERN void		Tcl_SaveResult(Tcl_Interp *interp,
				Tcl_SavedResult *statePtr);
/* 316 */
EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
				const char *name);
/* 317 */
EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
				int flags);
/* 318 */
EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
/* 319 */
EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
EXTERN int		Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
/* 323 */
EXTERN int		Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
EXTERN const char *	Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
EXTERN int		Tcl_UtfBackslash(const char *src, int *readPtr,
				char *dst);
/* 328 */
EXTERN const char *	Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
EXTERN const char *	Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
EXTERN const char *	Tcl_UtfNext(const char *src);
/* 331 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
EXTERN 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);
/* 333 */
EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, int srcLen,
				Tcl_DString *dsPtr);
/* 334 */
EXTERN int		Tcl_UtfToLower(char *src);
/* 335 */
EXTERN int		Tcl_UtfToTitle(char *src);
/* 336 */
EXTERN int		Tcl_UtfToChar16(const char *src,
				unsigned short *chPtr);
/* 337 */
EXTERN int		Tcl_UtfToUpper(char *src);
/* 338 */
EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				int srcLen);
/* 339 */
EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
const char *		Tcl_GetDefaultEncodingDir(void);
/* 342 */
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
void			Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void		Tcl_AlertNotifier(ClientData clientData);
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
EXTERN int		Tcl_UniCharIsAlpha(int ch);
/* 347 */
EXTERN int		Tcl_UniCharIsDigit(int ch);
/* 348 */
EXTERN int		Tcl_UniCharIsLower(int ch);
/* 349 */
EXTERN int		Tcl_UniCharIsSpace(int ch);
/* 350 */
EXTERN int		Tcl_UniCharIsUpper(int ch);
/* 351 */
EXTERN int		Tcl_UniCharIsWordChar(int ch);
/* 352 */
TCL_DEPRECATED("Use Tcl_GetCharLength")
int			Tcl_UniCharLen(const Tcl_UniChar *uniStr);
/* 353 */
TCL_DEPRECATED("Use Tcl_UtfNcmp")
int			Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct,
				unsigned long numChars);
/* 354 */
EXTERN char *		Tcl_Char16ToUtfDString(const unsigned short *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 355 */
EXTERN unsigned short *	 Tcl_UtfToChar16DString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* 357 */
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
Tcl_Obj *		Tcl_EvalTokens(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				int length);
/* 360 */
EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 361 */
EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, int numBytes, int nested,
				Tcl_Parse *parsePtr);
/* 362 */
EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				int numBytes, Tcl_Parse *parsePtr);
/* 363 */
EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
/* 364 */
EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, int numBytes,
				Tcl_Parse *parsePtr, int append);
/* 365 */
EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 366 */
EXTERN int		Tcl_Chdir(const char *dirName);
/* 367 */
EXTERN int		Tcl_Access(const char *path, int mode);
/* 368 */
EXTERN int		Tcl_Stat(const char *path, struct stat *bufPtr);
/* 369 */
EXTERN int		Tcl_UtfNcmp(const char *s1, const char *s2,
				unsigned long n);
/* 370 */
EXTERN int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
				unsigned long n);
/* 371 */
EXTERN int		Tcl_StringCaseMatch(const char *str,
				const char *pattern, int nocase);
/* 372 */
EXTERN int		Tcl_UniCharIsControl(int ch);
/* 373 */
EXTERN int		Tcl_UniCharIsGraph(int ch);
/* 374 */
EXTERN int		Tcl_UniCharIsPrint(int ch);
/* 375 */
EXTERN int		Tcl_UniCharIsPunct(int ch);
/* 376 */
EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				int offset, int nmatches, int flags);
/* 377 */
EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
/* 378 */
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
				int numChars);
/* 379 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int numChars);
/* 380 */
EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
TCL_DEPRECATED("No longer in use, changed to macro")
Tcl_UniChar *		Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);

/* 384 */
TCL_DEPRECATED("Use Tcl_AppendStringsToObj")
void			Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, int length);
/* 385 */
EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
/* 387 */
EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
/* 388 */
EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
/* 389 */
EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
				const char *pattern);
/* 390 */
EXTERN int		Tcl_ProcObjCmd(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc,
				ClientData clientData, int stackSize,
				int flags);
/* 394 */
EXTERN int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				int bytesToRead);
/* 395 */
EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				int srcLen);
/* 396 */
EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
EXTERN const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
				const Tcl_ChannelType *chanTypePtr);
/* 400 */
EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
				const Tcl_ChannelType *chanTypePtr);
/* 401 */
TCL_DEPRECATED("Use Tcl_ChannelClose2Proc")
Tcl_DriverCloseProc *	Tcl_ChannelCloseProc(
				const Tcl_ChannelType *chanTypePtr);
/* 402 */
EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
				const Tcl_ChannelType *chanTypePtr);
/* 403 */
EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
				const Tcl_ChannelType *chanTypePtr);
/* 404 */
EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
				const Tcl_ChannelType *chanTypePtr);
/* 405 */
TCL_DEPRECATED("Use Tcl_ChannelWideSeekProc")
Tcl_DriverSeekProc *	Tcl_ChannelSeekProc(
				const Tcl_ChannelType *chanTypePtr);
/* 406 */
EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 407 */
EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 408 */
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
EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
/* 416 */
EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
EXTERN int		Tcl_IsChannelExisting(const char *channelName);
/* Slot 419 is reserved */




/* Slot 420 is reserved */



/* Slot 421 is reserved */


/* Slot 422 is reserved */


/* 423 */
EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
				int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
EXTERN void *		Tcl_CommandTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *procPtr,
				void *prevClientData);
/* 426 */
EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);

/* 427 */
EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);

/* 428 */
EXTERN void *		Tcl_AttemptAlloc(size_t size);
/* 429 */
EXTERN void *		Tcl_AttemptDbCkalloc(size_t size, const char *file,
				int line);
/* 430 */
EXTERN void *		Tcl_AttemptRealloc(void *ptr, size_t size);
/* 431 */
EXTERN void *		Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
				size_t length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* Slot 435 is reserved */






/* Slot 436 is reserved */



/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
/* 439 */







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






|


|



|
>



|
>

|

|
|

|

|


|
<





|
>
>
>
>
>
>
|
>
>
>







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
EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
/* 416 */
EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
EXTERN int		Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCL_DEPRECATED("Use Tcl_UtfNcasecmp")
int			Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct,
				unsigned long numChars);
/* 420 */
TCL_DEPRECATED("Use Tcl_StringCaseMatch")
int			Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
				const Tcl_UniChar *uniPattern, int nocase);
/* 421 */
EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
				const void *key);
/* 422 */
EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
				const void *key, int *newPtr);
/* 423 */
EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
				int keyType, const Tcl_HashKeyType *typePtr);
/* 424 */
EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
/* 425 */
EXTERN ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *procPtr,
				ClientData prevClientData);
/* 426 */
EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
/* 427 */
EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
/* 428 */
EXTERN char *		Tcl_AttemptAlloc(unsigned int size);
/* 429 */
EXTERN char *		Tcl_AttemptDbCkalloc(unsigned int size,
				const char *file, int line);
/* 430 */
EXTERN char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
/* 431 */
EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
				const char *file, int line);
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);

/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
int			Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				const char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,
				ClientData *clientDataPtr);
/* 436 */
TCL_DEPRECATED("")
Tcl_Obj *		Tcl_ListMathFuncs(Tcl_Interp *interp,
				const char *pattern);
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
/* 439 */
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
/* 451 */
EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
/* 452 */
EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
/* 453 */
EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
				Tcl_Obj **objPtrRef);
/* 454 */
EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 455 */
EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
/* 456 */
EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,







|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
/* 451 */
EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
/* 452 */
EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
/* 453 */
EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
				Tcl_Obj **objPtrRef);
/* 454 */
EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
/* 455 */
EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
/* 456 */
EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,
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
/* 463 */
EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */
EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
				Tcl_Obj *const objv[]);
/* 465 */
EXTERN void *		Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				const Tcl_Filesystem *fsPtr);
/* 466 */
EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 467 */
EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
EXTERN Tcl_Obj *	Tcl_FSNewNativePath(
				const Tcl_Filesystem *fromFilesystem,
				void *clientData);
/* 469 */
EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
/* 473 */
EXTERN int		Tcl_FSRegister(void *clientData,
				const Tcl_Filesystem *fsPtr);
/* 474 */
EXTERN int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
EXTERN void *		Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
EXTERN const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 477 */
EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, size_t count);
/* 482 */
EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc *objProc,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
				const Tcl_CmdInfo *infoPtr);







|









|









|




|




|








|





|







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
/* 463 */
EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 464 */
EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
				Tcl_Obj *const objv[]);
/* 465 */
EXTERN ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				const Tcl_Filesystem *fsPtr);
/* 466 */
EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 467 */
EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
/* 468 */
EXTERN Tcl_Obj *	Tcl_FSNewNativePath(
				const Tcl_Filesystem *fromFilesystem,
				ClientData clientData);
/* 469 */
EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
/* 470 */
EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
/* 471 */
EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
/* 472 */
EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
/* 473 */
EXTERN int		Tcl_FSRegister(ClientData clientData,
				const Tcl_Filesystem *fsPtr);
/* 474 */
EXTERN int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
/* 475 */
EXTERN ClientData	Tcl_FSData(const Tcl_Filesystem *fsPtr);
/* 476 */
EXTERN const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
/* 477 */
EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
/* 478 */
EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
/* 479 */
EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
/* 480 */
EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
/* 481 */
EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 482 */
EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
/* 483 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc *objProc,
				ClientData clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 484 */
EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
/* 485 */
EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
				const Tcl_CmdInfo *infoPtr);
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
/* 505 */
EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
				const char *pkgName,
				const Tcl_Config *configuration,
				const char *valEncoding);
/* 506 */
EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				const char *name, void *clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */







|







1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
/* 505 */
EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
				const char *pkgName,
				const Tcl_Config *configuration,
				const char *valEncoding);
/* 506 */
EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				const char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 507 */
EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
/* 508 */
EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 509 */
1379
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
				Tcl_Obj *objPtr);
/* 517 */
EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
/* 518 */
EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
				Tcl_Obj *fileName, const char *encodingName);
/* Slot 519 is reserved */

/* 520 */
EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData,
				Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData);
/* 522 */
EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */







|
>



|




|







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
				Tcl_Obj *objPtr);
/* 517 */
EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
/* 518 */
EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
				Tcl_Obj *fileName, const char *encodingName);
/* 519 */
EXTERN Tcl_ExitProc *	Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
/* 520 */
EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				ClientData clientData,
				Tcl_LimitHandlerDeleteProc *deleteProc);
/* 521 */
EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				ClientData clientData);
/* 522 */
EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
/* 523 */
EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
/* 524 */
EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
/* 525 */
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
/* 551 */
EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
				Tcl_Command token,
				Tcl_Namespace **namespacePtrPtr);
/* 552 */
EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
				Tcl_ScaleTimeProc *scaleProc,
				void *clientData);
/* 553 */
EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
				Tcl_ScaleTimeProc **scaleProc,
				void **clientData);
/* 554 */
EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 555 */
EXTERN Tcl_Obj *	Tcl_NewBignumObj(void *value);
/* 556 */
EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(void *value, const char *file,







|



|







1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
/* 551 */
EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
				Tcl_Command token,
				Tcl_Namespace **namespacePtrPtr);
/* 552 */
EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
				Tcl_ScaleTimeProc *scaleProc,
				ClientData clientData);
/* 553 */
EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
				Tcl_ScaleTimeProc **scaleProc,
				ClientData *clientData);
/* 554 */
EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
				const Tcl_ChannelType *chanTypePtr);
/* 555 */
EXTERN Tcl_Obj *	Tcl_NewBignumObj(void *value);
/* 556 */
EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(void *value, const char *file,
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
				const char *name, int objc,
				Tcl_Obj *const objv[], void *clientDataPtr);
/* 574 */
EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 575 */
EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
				const char *bytes, size_t length,
				size_t limit, const char *ellipsis);
/* 576 */
EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 577 */
EXTERN int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 578 */
EXTERN Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
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 */
EXTERN int		Tcl_CreatePipe(Tcl_Interp *interp,
				Tcl_Channel *rchan, Tcl_Channel *wchan,
				int flags);
/* 583 */
EXTERN Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				Tcl_ObjCmdProc *nreProc, void *clientData,

				Tcl_CmdDeleteProc *deleteProc);
/* 584 */
EXTERN int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 585 */
EXTERN int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 586 */
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,
				Tcl_ObjCmdProc *objProc, void *clientData,

				int objc, Tcl_Obj *const objv[]);
/* 589 */
EXTERN unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
EXTERN unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
EXTERN unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */







|
|














|










|
>












|
>
|


|
>
|







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
				const char *name, int objc,
				Tcl_Obj *const objv[], void *clientDataPtr);
/* 574 */
EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 575 */
EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
				const char *bytes, int length, int limit,
				const char *ellipsis);
/* 576 */
EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 577 */
EXTERN int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *format,
				int objc, Tcl_Obj *const objv[]);
/* 578 */
EXTERN Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
/* 579 */
EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
EXTERN int		Tcl_CancelEval(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr, ClientData clientData,
				int flags);
/* 581 */
EXTERN int		Tcl_Canceled(Tcl_Interp *interp, int flags);
/* 582 */
EXTERN int		Tcl_CreatePipe(Tcl_Interp *interp,
				Tcl_Channel *rchan, Tcl_Channel *wchan,
				int flags);
/* 583 */
EXTERN Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				Tcl_ObjCmdProc *nreProc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 584 */
EXTERN int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 585 */
EXTERN int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 586 */
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,
				ClientData data0, ClientData data1,
				ClientData data2, ClientData data3);
/* 588 */
EXTERN int		Tcl_NRCallObjProc(Tcl_Interp *interp,
				Tcl_ObjCmdProc *objProc,
				ClientData clientData, int objc,
				Tcl_Obj *const objv[]);
/* 589 */
EXTERN unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
EXTERN unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
EXTERN unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */
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
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 */
EXTERN int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, size_t buffersize,
				Tcl_Obj *gzipHeaderDictObj);
/* 612 */
EXTERN unsigned int	Tcl_ZlibCRC32(unsigned int crc,
				const unsigned char *buf, size_t len);
/* 613 */
EXTERN unsigned int	Tcl_ZlibAdler32(unsigned int adler,
				const unsigned char *buf, size_t len);
/* 614 */
EXTERN int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
				int format, int level, Tcl_Obj *dictObj,
				Tcl_ZlibStream *zshandle);
/* 615 */
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,
				Tcl_Obj *data, int flush);
/* 619 */
EXTERN int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, size_t count);
/* 620 */
EXTERN int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
EXTERN int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
EXTERN void		Tcl_SetStartupScript(Tcl_Obj *path,
				const char *encoding);







|



|


|















|







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
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 */
EXTERN int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, int buffersize,
				Tcl_Obj *gzipHeaderDictObj);
/* 612 */
EXTERN unsigned int	Tcl_ZlibCRC32(unsigned int crc,
				const unsigned char *buf, int len);
/* 613 */
EXTERN unsigned int	Tcl_ZlibAdler32(unsigned int adler,
				const unsigned char *buf, int len);
/* 614 */
EXTERN int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
				int format, int level, Tcl_Obj *dictObj,
				Tcl_ZlibStream *zshandle);
/* 615 */
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,
				Tcl_Obj *data, int flush);
/* 619 */
EXTERN int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, int count);
/* 620 */
EXTERN int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
EXTERN int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
EXTERN void		Tcl_SetStartupScript(Tcl_Obj *path,
				const char *encoding);
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
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 632 */
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 */
EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
/* 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);
/* 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;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const 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 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved9)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#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_Sleep) (int ms); /* 12 */
    int (*tcl_WaitForEvent) (const 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 */
    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 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    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_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 */
    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 */
    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_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 */
    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_AllowExceptions) (Tcl_Interp *interp); /* 68 */
    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 */
    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 */
    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 */
    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_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 */
    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_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_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 */
    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_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    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 */
    void (*tcl_Finalize) (void); /* 143 */
    void (*reserved144)(void);
    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 */
    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_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 */
    int (*tcl_GetErrno) (void); /* 161 */
    const 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_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 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **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 */
    int (*tcl_GetServiceMode) (void); /* 171 */
    Tcl_Interp * (*tcl_GetChild) (Tcl_Interp *interp, const char *name); /* 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 */
    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 */
    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_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 */
    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 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    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_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_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_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 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    void (*reserved230)(void);
    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
    void (*reserved232)(void);
    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 */
    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_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_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);
    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);
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    void (*reserved278)(void);
    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 */
    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 (*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 */
    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_FinalizeThread) (void); /* 297 */
    void (*tcl_FinalizeNotifier) (void *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 */
    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 */
    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_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 */
    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 */
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToChar16) (const char *src, unsigned short *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 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (void *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 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    void (*reserved357)(void);
    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 */
    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_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 */
    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);
    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 */
    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 */
    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 */
    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 */
    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 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    void (*reserved435)(void);
    void (*reserved436)(void);
    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 */
    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 */
    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_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_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_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 */
    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_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 */
    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_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 */







|

















|


















|


|
<




|

|
|














|
|
|
|
|
|

|





|















|





|
|


|

|







|



|








|
|

|

|

|
|
|
|

|

|
|
|
|
|



|




|
|

|
|
|


|
|


|
|
|
|
|
|

|
|

|
|

|
|


|
|
|






|

|
|






|




|

|
|











|


|


|


|
|



|









|





|


|
|



|
|

|
|










|

|








|
|




|








|
|

|
|
|


|






|

|




|






|
|
|
|
|

|


|

|
|

|


|
|
|



|
|


|

|
|
|
|

|


|






|
|
|
|



|
|

|





|
|

|




|
|
|
|




|




|
|
|




|
|




|
|

|
|
|








|
|
|
|

|

|
|
|
|
|
|




|
|





|

|
|
|
|
|
|
|





|


|
|
|





|



|













|
|
|
|


|
|
|
|
|
|
|
|


|
|
















|











|


|




|

|

|



|

|







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
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
				const char *service, const char *host,
				unsigned int flags,
				Tcl_TcpAcceptProc *acceptProc,
				ClientData callbackData);
/* 632 */
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,
				unsigned int 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 */
EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
/* 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,
				int size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int endValue, int *indexPtr);

/* 646 */
EXTERN int		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const 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 */
    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);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#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_Sleep) (int ms); /* 12 */
    int (*tcl_WaitForEvent) (const 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, int 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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_DEPRECATED_API("No longer in use, changed to macro") 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 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *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 */
    CONST86 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    TCL_DEPRECATED_API("Use Tcl_UtfBackslash") 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, const 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, 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, 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 */
    TCL_DEPRECATED_API("") 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_CreateChild) (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, 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, ClientData clientData); /* 114 */
    int (*tcl_DoOneEvent) (int flags); /* 115 */
    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, 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 */
    int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    void (*tcl_EventuallyFree) (ClientData 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 */
    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_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    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 */
    void (*tcl_Finalize) (void); /* 143 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") 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 */
    TCL_DEPRECATED_API("see TIP #559. Use Tcl_ResetResult") void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
    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 */
    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, 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 */
    CONST86 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 */
    int (*tcl_GetErrno) (void); /* 161 */
    const 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_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, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    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 */
    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_Channel (*tcl_GetStdChannel) (int type); /* 173 */
    const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
    const 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const 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, 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 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    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_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, int index, const char **startPtr, const char **endPtr); /* 215 */
    void (*tcl_Release) (ClientData clientData); /* 216 */
    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
    int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
    int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
    TCL_DEPRECATED_API("") 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, 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 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
    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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
    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 */
    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 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") 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 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    TCL_DEPRECATED_API("see TIP #422") 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 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
    TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 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, 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 (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
    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, 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) (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 */
    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
    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 */
    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, int index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const 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 */
    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, 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_UtfToUpper) (char *src); /* 337 */
    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 */
    TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") 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 */
    TCL_DEPRECATED_API("Use Tcl_GetCharLength") int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") 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, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const 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, const 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, 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, 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, int numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
    TCL_DEPRECATED_API("Use Tcl_AppendStringsToObj") 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) (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, 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 */
    TCL_DEPRECATED_API("Use Tcl_ChannelClose2Proc") 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_DEPRECATED_API("Use Tcl_ChannelWideSeekProc") 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 */
    TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
    TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
    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 */
    TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    TCL_DEPRECATED_API("") 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 */
    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 *CONST86 * (*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_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 */
    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const 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, ClientData clientData); /* 468 */
    const void * (*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) (ClientData clientData, const Tcl_Filesystem *fsPtr); /* 473 */
    int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
    ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    CONST86 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, int count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    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_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 */
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
    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 */
    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 */
    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 */
    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_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_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 */







|












|
|
|







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
    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 */
    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, 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 */
    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_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 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 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 */
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
    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 */
    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */







|
|







2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
    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, 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) (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 */
    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
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
    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 */
    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 */







|




|


|



|
|







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
    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 */
    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
    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, ...) 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, ClientData 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, ClientData 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, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
    int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData 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 */
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
    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 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif







|
|
|





|











|





|






|
|

|
|







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
    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, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
    unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */
    unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int 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, int 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, ClientData 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, unsigned int 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, int size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
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
	(tclStubsPtr->tcl_ConvertToType) /* 18 */
#define Tcl_DbDecrRefCount \
	(tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
#define Tcl_DbIncrRefCount \
	(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
	(tclStubsPtr->tcl_DbIsShared) /* 21 */
/* Slot 22 is reserved */

#define Tcl_DbNewByteArrayObj \
	(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
	(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#define Tcl_DbNewListObj \
	(tclStubsPtr->tcl_DbNewListObj) /* 25 */
/* Slot 26 is reserved */

#define Tcl_DbNewObj \
	(tclStubsPtr->tcl_DbNewObj) /* 27 */
#define Tcl_DbNewStringObj \
	(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
#define Tcl_DuplicateObj \
	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#define TclFreeObj \
	(tclStubsPtr->tclFreeObj) /* 30 */
#define Tcl_GetBoolean \
	(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#define Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#define Tcl_GetDouble \
	(tclStubsPtr->tcl_GetDouble) /* 34 */
#define Tcl_GetDoubleFromObj \
	(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
/* Slot 36 is reserved */

#define Tcl_GetInt \
	(tclStubsPtr->tcl_GetInt) /* 37 */
#define Tcl_GetIntFromObj \
	(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
#define Tcl_GetLongFromObj \
	(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
#define Tcl_GetObjType \







|
>






|
>


















|
>







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
	(tclStubsPtr->tcl_ConvertToType) /* 18 */
#define Tcl_DbDecrRefCount \
	(tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
#define Tcl_DbIncrRefCount \
	(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#define Tcl_DbIsShared \
	(tclStubsPtr->tcl_DbIsShared) /* 21 */
#define Tcl_DbNewBooleanObj \
	(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
#define Tcl_DbNewByteArrayObj \
	(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#define Tcl_DbNewDoubleObj \
	(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#define Tcl_DbNewListObj \
	(tclStubsPtr->tcl_DbNewListObj) /* 25 */
#define Tcl_DbNewLongObj \
	(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
#define Tcl_DbNewObj \
	(tclStubsPtr->tcl_DbNewObj) /* 27 */
#define Tcl_DbNewStringObj \
	(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
#define Tcl_DuplicateObj \
	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#define TclFreeObj \
	(tclStubsPtr->tclFreeObj) /* 30 */
#define Tcl_GetBoolean \
	(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#define Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#define Tcl_GetDouble \
	(tclStubsPtr->tcl_GetDouble) /* 34 */
#define Tcl_GetDoubleFromObj \
	(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
#define Tcl_GetIndexFromObj \
	(tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
#define Tcl_GetInt \
	(tclStubsPtr->tcl_GetInt) /* 37 */
#define Tcl_GetIntFromObj \
	(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
#define Tcl_GetLongFromObj \
	(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
#define Tcl_GetObjType \
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
	(tclStubsPtr->tcl_ListObjGetElements) /* 45 */
#define Tcl_ListObjIndex \
	(tclStubsPtr->tcl_ListObjIndex) /* 46 */
#define Tcl_ListObjLength \
	(tclStubsPtr->tcl_ListObjLength) /* 47 */
#define Tcl_ListObjReplace \
	(tclStubsPtr->tcl_ListObjReplace) /* 48 */
/* Slot 49 is reserved */

#define Tcl_NewByteArrayObj \
	(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
	(tclStubsPtr->tcl_NewDoubleObj) /* 51 */

/* Slot 52 is reserved */
#define Tcl_NewListObj \
	(tclStubsPtr->tcl_NewListObj) /* 53 */

/* Slot 54 is reserved */
#define Tcl_NewObj \
	(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
	(tclStubsPtr->tcl_NewStringObj) /* 56 */
/* Slot 57 is reserved */

#define Tcl_SetByteArrayLength \
	(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
	(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
	(tclStubsPtr->tcl_SetDoubleObj) /* 60 */

/* Slot 61 is reserved */
#define Tcl_SetListObj \
	(tclStubsPtr->tcl_SetListObj) /* 62 */

/* Slot 63 is reserved */
#define Tcl_SetObjLength \
	(tclStubsPtr->tcl_SetObjLength) /* 64 */
#define Tcl_SetStringObj \
	(tclStubsPtr->tcl_SetStringObj) /* 65 */
/* Slot 66 is reserved */
/* Slot 67 is reserved */


#define Tcl_AllowExceptions \
	(tclStubsPtr->tcl_AllowExceptions) /* 68 */
#define Tcl_AppendElement \
	(tclStubsPtr->tcl_AppendElement) /* 69 */
#define Tcl_AppendResult \
	(tclStubsPtr->tcl_AppendResult) /* 70 */
#define Tcl_AsyncCreate \
	(tclStubsPtr->tcl_AsyncCreate) /* 71 */
#define Tcl_AsyncDelete \
	(tclStubsPtr->tcl_AsyncDelete) /* 72 */
#define Tcl_AsyncInvoke \
	(tclStubsPtr->tcl_AsyncInvoke) /* 73 */
#define Tcl_AsyncMark \
	(tclStubsPtr->tcl_AsyncMark) /* 74 */
#define Tcl_AsyncReady \
	(tclStubsPtr->tcl_AsyncReady) /* 75 */
/* Slot 76 is reserved */


/* Slot 77 is reserved */
#define Tcl_BadChannelOption \
	(tclStubsPtr->tcl_BadChannelOption) /* 78 */
#define Tcl_CallWhenDeleted \
	(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#define Tcl_CancelIdleCall \
	(tclStubsPtr->tcl_CancelIdleCall) /* 80 */

/* Slot 81 is reserved */
#define Tcl_CommandComplete \
	(tclStubsPtr->tcl_CommandComplete) /* 82 */
#define Tcl_Concat \
	(tclStubsPtr->tcl_Concat) /* 83 */
#define Tcl_ConvertElement \
	(tclStubsPtr->tcl_ConvertElement) /* 84 */
#define Tcl_ConvertCountedElement \







|
>




>
|


>
|




|
>






>
|


>
|




|
|
>
>
















|
>
>
|






>
|







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
	(tclStubsPtr->tcl_ListObjGetElements) /* 45 */
#define Tcl_ListObjIndex \
	(tclStubsPtr->tcl_ListObjIndex) /* 46 */
#define Tcl_ListObjLength \
	(tclStubsPtr->tcl_ListObjLength) /* 47 */
#define Tcl_ListObjReplace \
	(tclStubsPtr->tcl_ListObjReplace) /* 48 */
#define Tcl_NewBooleanObj \
	(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
#define Tcl_NewByteArrayObj \
	(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#define Tcl_NewDoubleObj \
	(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
#define Tcl_NewIntObj \
	(tclStubsPtr->tcl_NewIntObj) /* 52 */
#define Tcl_NewListObj \
	(tclStubsPtr->tcl_NewListObj) /* 53 */
#define Tcl_NewLongObj \
	(tclStubsPtr->tcl_NewLongObj) /* 54 */
#define Tcl_NewObj \
	(tclStubsPtr->tcl_NewObj) /* 55 */
#define Tcl_NewStringObj \
	(tclStubsPtr->tcl_NewStringObj) /* 56 */
#define Tcl_SetBooleanObj \
	(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
#define Tcl_SetByteArrayLength \
	(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#define Tcl_SetByteArrayObj \
	(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#define Tcl_SetDoubleObj \
	(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
#define Tcl_SetIntObj \
	(tclStubsPtr->tcl_SetIntObj) /* 61 */
#define Tcl_SetListObj \
	(tclStubsPtr->tcl_SetListObj) /* 62 */
#define Tcl_SetLongObj \
	(tclStubsPtr->tcl_SetLongObj) /* 63 */
#define Tcl_SetObjLength \
	(tclStubsPtr->tcl_SetObjLength) /* 64 */
#define Tcl_SetStringObj \
	(tclStubsPtr->tcl_SetStringObj) /* 65 */
#define Tcl_AddErrorInfo \
	(tclStubsPtr->tcl_AddErrorInfo) /* 66 */
#define Tcl_AddObjErrorInfo \
	(tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
#define Tcl_AllowExceptions \
	(tclStubsPtr->tcl_AllowExceptions) /* 68 */
#define Tcl_AppendElement \
	(tclStubsPtr->tcl_AppendElement) /* 69 */
#define Tcl_AppendResult \
	(tclStubsPtr->tcl_AppendResult) /* 70 */
#define Tcl_AsyncCreate \
	(tclStubsPtr->tcl_AsyncCreate) /* 71 */
#define Tcl_AsyncDelete \
	(tclStubsPtr->tcl_AsyncDelete) /* 72 */
#define Tcl_AsyncInvoke \
	(tclStubsPtr->tcl_AsyncInvoke) /* 73 */
#define Tcl_AsyncMark \
	(tclStubsPtr->tcl_AsyncMark) /* 74 */
#define Tcl_AsyncReady \
	(tclStubsPtr->tcl_AsyncReady) /* 75 */
#define Tcl_BackgroundError \
	(tclStubsPtr->tcl_BackgroundError) /* 76 */
#define Tcl_Backslash \
	(tclStubsPtr->tcl_Backslash) /* 77 */
#define Tcl_BadChannelOption \
	(tclStubsPtr->tcl_BadChannelOption) /* 78 */
#define Tcl_CallWhenDeleted \
	(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#define Tcl_CancelIdleCall \
	(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
#define Tcl_Close \
	(tclStubsPtr->tcl_Close) /* 81 */
#define Tcl_CommandComplete \
	(tclStubsPtr->tcl_CommandComplete) /* 82 */
#define Tcl_Concat \
	(tclStubsPtr->tcl_Concat) /* 83 */
#define Tcl_ConvertElement \
	(tclStubsPtr->tcl_ConvertElement) /* 84 */
#define Tcl_ConvertCountedElement \
2633
2634
2635
2636
2637
2638
2639
2640

2641
2642
2643
2644
2645
2646
2647
	(tclStubsPtr->tcl_CreateCommand) /* 91 */
#define Tcl_CreateEventSource \
	(tclStubsPtr->tcl_CreateEventSource) /* 92 */
#define Tcl_CreateExitHandler \
	(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
#define Tcl_CreateInterp \
	(tclStubsPtr->tcl_CreateInterp) /* 94 */
/* Slot 95 is reserved */

#define Tcl_CreateObjCommand \
	(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
#define Tcl_CreateChild \
	(tclStubsPtr->tcl_CreateChild) /* 97 */
#define Tcl_CreateTimerHandler \
	(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
#define Tcl_CreateTrace \







|
>







2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
	(tclStubsPtr->tcl_CreateCommand) /* 91 */
#define Tcl_CreateEventSource \
	(tclStubsPtr->tcl_CreateEventSource) /* 92 */
#define Tcl_CreateExitHandler \
	(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
#define Tcl_CreateInterp \
	(tclStubsPtr->tcl_CreateInterp) /* 94 */
#define Tcl_CreateMathFunc \
	(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
#define Tcl_CreateObjCommand \
	(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
#define Tcl_CreateChild \
	(tclStubsPtr->tcl_CreateChild) /* 97 */
#define Tcl_CreateTimerHandler \
	(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
#define Tcl_CreateTrace \
2700
2701
2702
2703
2704
2705
2706

2707
2708
2709

2710
2711
2712
2713
2714
2715
2716
2717
	(tclStubsPtr->tcl_DStringStartSublist) /* 125 */
#define Tcl_Eof \
	(tclStubsPtr->tcl_Eof) /* 126 */
#define Tcl_ErrnoId \
	(tclStubsPtr->tcl_ErrnoId) /* 127 */
#define Tcl_ErrnoMsg \
	(tclStubsPtr->tcl_ErrnoMsg) /* 128 */

/* Slot 129 is reserved */
#define Tcl_EvalFile \
	(tclStubsPtr->tcl_EvalFile) /* 130 */

/* Slot 131 is reserved */
#define Tcl_EventuallyFree \
	(tclStubsPtr->tcl_EventuallyFree) /* 132 */
#define Tcl_Exit \
	(tclStubsPtr->tcl_Exit) /* 133 */
#define Tcl_ExposeCommand \
	(tclStubsPtr->tcl_ExposeCommand) /* 134 */
#define Tcl_ExprBoolean \







>
|


>
|







2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
	(tclStubsPtr->tcl_DStringStartSublist) /* 125 */
#define Tcl_Eof \
	(tclStubsPtr->tcl_Eof) /* 126 */
#define Tcl_ErrnoId \
	(tclStubsPtr->tcl_ErrnoId) /* 127 */
#define Tcl_ErrnoMsg \
	(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
#define Tcl_Eval \
	(tclStubsPtr->tcl_Eval) /* 129 */
#define Tcl_EvalFile \
	(tclStubsPtr->tcl_EvalFile) /* 130 */
#define Tcl_EvalObj \
	(tclStubsPtr->tcl_EvalObj) /* 131 */
#define Tcl_EventuallyFree \
	(tclStubsPtr->tcl_EventuallyFree) /* 132 */
#define Tcl_Exit \
	(tclStubsPtr->tcl_Exit) /* 133 */
#define Tcl_ExposeCommand \
	(tclStubsPtr->tcl_ExposeCommand) /* 134 */
#define Tcl_ExprBoolean \
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739

2740
2741
2742
2743
2744
2745
2746
2747
	(tclStubsPtr->tcl_ExprLongObj) /* 140 */
#define Tcl_ExprObj \
	(tclStubsPtr->tcl_ExprObj) /* 141 */
#define Tcl_ExprString \
	(tclStubsPtr->tcl_ExprString) /* 142 */
#define Tcl_Finalize \
	(tclStubsPtr->tcl_Finalize) /* 143 */

/* Slot 144 is reserved */
#define Tcl_FirstHashEntry \
	(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
#define Tcl_Flush \
	(tclStubsPtr->tcl_Flush) /* 146 */

/* Slot 147 is reserved */
#define Tcl_GetAlias \
	(tclStubsPtr->tcl_GetAlias) /* 148 */
#define Tcl_GetAliasObj \
	(tclStubsPtr->tcl_GetAliasObj) /* 149 */
#define Tcl_GetAssocData \
	(tclStubsPtr->tcl_GetAssocData) /* 150 */
#define Tcl_GetChannel \







>
|




>
|







2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
	(tclStubsPtr->tcl_ExprLongObj) /* 140 */
#define Tcl_ExprObj \
	(tclStubsPtr->tcl_ExprObj) /* 141 */
#define Tcl_ExprString \
	(tclStubsPtr->tcl_ExprString) /* 142 */
#define Tcl_Finalize \
	(tclStubsPtr->tcl_Finalize) /* 143 */
#define Tcl_FindExecutable \
	(tclStubsPtr->tcl_FindExecutable) /* 144 */
#define Tcl_FirstHashEntry \
	(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
#define Tcl_Flush \
	(tclStubsPtr->tcl_Flush) /* 146 */
#define Tcl_FreeResult \
	(tclStubsPtr->tcl_FreeResult) /* 147 */
#define Tcl_GetAlias \
	(tclStubsPtr->tcl_GetAlias) /* 148 */
#define Tcl_GetAliasObj \
	(tclStubsPtr->tcl_GetAliasObj) /* 149 */
#define Tcl_GetAssocData \
	(tclStubsPtr->tcl_GetAssocData) /* 150 */
#define Tcl_GetChannel \
2792
2793
2794
2795
2796
2797
2798

2799

2800
2801
2802

2803

2804
2805
2806
2807
2808
2809
2810
2811
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \
	(tclStubsPtr->tcl_GetServiceMode) /* 171 */
#define Tcl_GetChild \
	(tclStubsPtr->tcl_GetChild) /* 172 */
#define Tcl_GetStdChannel \
	(tclStubsPtr->tcl_GetStdChannel) /* 173 */

/* Slot 174 is reserved */

/* Slot 175 is reserved */
#define Tcl_GetVar2 \
	(tclStubsPtr->tcl_GetVar2) /* 176 */

/* Slot 177 is reserved */

/* Slot 178 is reserved */
#define Tcl_HideCommand \
	(tclStubsPtr->tcl_HideCommand) /* 179 */
#define Tcl_Init \
	(tclStubsPtr->tcl_Init) /* 180 */
#define Tcl_InitHashTable \
	(tclStubsPtr->tcl_InitHashTable) /* 181 */
#define Tcl_InputBlocked \







>
|
>
|


>
|
>
|







2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \
	(tclStubsPtr->tcl_GetServiceMode) /* 171 */
#define Tcl_GetChild \
	(tclStubsPtr->tcl_GetChild) /* 172 */
#define Tcl_GetStdChannel \
	(tclStubsPtr->tcl_GetStdChannel) /* 173 */
#define Tcl_GetStringResult \
	(tclStubsPtr->tcl_GetStringResult) /* 174 */
#define Tcl_GetVar \
	(tclStubsPtr->tcl_GetVar) /* 175 */
#define Tcl_GetVar2 \
	(tclStubsPtr->tcl_GetVar2) /* 176 */
#define Tcl_GlobalEval \
	(tclStubsPtr->tcl_GlobalEval) /* 177 */
#define Tcl_GlobalEvalObj \
	(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
#define Tcl_HideCommand \
	(tclStubsPtr->tcl_HideCommand) /* 179 */
#define Tcl_Init \
	(tclStubsPtr->tcl_Init) /* 180 */
#define Tcl_InitHashTable \
	(tclStubsPtr->tcl_InitHashTable) /* 181 */
#define Tcl_InputBlocked \
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
	(tclStubsPtr->tcl_Release) /* 216 */
#define Tcl_ResetResult \
	(tclStubsPtr->tcl_ResetResult) /* 217 */
#define Tcl_ScanElement \
	(tclStubsPtr->tcl_ScanElement) /* 218 */
#define Tcl_ScanCountedElement \
	(tclStubsPtr->tcl_ScanCountedElement) /* 219 */

/* Slot 220 is reserved */
#define Tcl_ServiceAll \
	(tclStubsPtr->tcl_ServiceAll) /* 221 */
#define Tcl_ServiceEvent \
	(tclStubsPtr->tcl_ServiceEvent) /* 222 */
#define Tcl_SetAssocData \
	(tclStubsPtr->tcl_SetAssocData) /* 223 */
#define Tcl_SetChannelBufferSize \
	(tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
#define Tcl_SetChannelOption \
	(tclStubsPtr->tcl_SetChannelOption) /* 225 */
#define Tcl_SetCommandInfo \
	(tclStubsPtr->tcl_SetCommandInfo) /* 226 */
#define Tcl_SetErrno \
	(tclStubsPtr->tcl_SetErrno) /* 227 */
#define Tcl_SetErrorCode \
	(tclStubsPtr->tcl_SetErrorCode) /* 228 */
#define Tcl_SetMaxBlockTime \
	(tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */

/* Slot 230 is reserved */
#define Tcl_SetRecursionLimit \
	(tclStubsPtr->tcl_SetRecursionLimit) /* 231 */

/* Slot 232 is reserved */
#define Tcl_SetServiceMode \
	(tclStubsPtr->tcl_SetServiceMode) /* 233 */
#define Tcl_SetObjErrorCode \
	(tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
#define Tcl_SetObjResult \
	(tclStubsPtr->tcl_SetObjResult) /* 235 */
#define Tcl_SetStdChannel \
	(tclStubsPtr->tcl_SetStdChannel) /* 236 */

/* Slot 237 is reserved */
#define Tcl_SetVar2 \
	(tclStubsPtr->tcl_SetVar2) /* 238 */
#define Tcl_SignalId \
	(tclStubsPtr->tcl_SignalId) /* 239 */
#define Tcl_SignalMsg \
	(tclStubsPtr->tcl_SignalMsg) /* 240 */
#define Tcl_SourceRCFile \
	(tclStubsPtr->tcl_SourceRCFile) /* 241 */
#define Tcl_SplitList \
	(tclStubsPtr->tcl_SplitList) /* 242 */
#define Tcl_SplitPath \
	(tclStubsPtr->tcl_SplitPath) /* 243 */

/* Slot 244 is reserved */

/* Slot 245 is reserved */

/* Slot 246 is reserved */

/* Slot 247 is reserved */
#define Tcl_TraceVar2 \
	(tclStubsPtr->tcl_TraceVar2) /* 248 */
#define Tcl_TranslateFileName \
	(tclStubsPtr->tcl_TranslateFileName) /* 249 */
#define Tcl_Ungets \
	(tclStubsPtr->tcl_Ungets) /* 250 */
#define Tcl_UnlinkVar \
	(tclStubsPtr->tcl_UnlinkVar) /* 251 */
#define Tcl_UnregisterChannel \
	(tclStubsPtr->tcl_UnregisterChannel) /* 252 */

/* Slot 253 is reserved */
#define Tcl_UnsetVar2 \
	(tclStubsPtr->tcl_UnsetVar2) /* 254 */

/* Slot 255 is reserved */
#define Tcl_UntraceVar2 \
	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
#define Tcl_UpdateLinkedVar \
	(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */

/* Slot 258 is reserved */
#define Tcl_UpVar2 \
	(tclStubsPtr->tcl_UpVar2) /* 259 */
#define Tcl_VarEval \
	(tclStubsPtr->tcl_VarEval) /* 260 */

/* Slot 261 is reserved */
#define Tcl_VarTraceInfo2 \
	(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#define Tcl_Write \
	(tclStubsPtr->tcl_Write) /* 263 */
#define Tcl_WrongNumArgs \
	(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
#define Tcl_DumpActiveMemory \
	(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
#define Tcl_ValidateAllMemory \
	(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */

/* Slot 267 is reserved */

/* Slot 268 is reserved */
#define Tcl_HashStats \
	(tclStubsPtr->tcl_HashStats) /* 269 */
#define Tcl_ParseVar \
	(tclStubsPtr->tcl_ParseVar) /* 270 */
/* Slot 271 is reserved */

#define Tcl_PkgPresentEx \
	(tclStubsPtr->tcl_PkgPresentEx) /* 272 */

/* Slot 273 is reserved */

/* Slot 274 is reserved */

/* Slot 275 is reserved */

/* Slot 276 is reserved */
#define Tcl_WaitPid \
	(tclStubsPtr->tcl_WaitPid) /* 277 */

/* Slot 278 is reserved */
#define Tcl_GetVersion \
	(tclStubsPtr->tcl_GetVersion) /* 279 */
#define Tcl_InitMemory \
	(tclStubsPtr->tcl_InitMemory) /* 280 */
#define Tcl_StackChannel \
	(tclStubsPtr->tcl_StackChannel) /* 281 */
#define Tcl_UnstackChannel \







>
|


















>
|


>
|








>
|












>
|
>
|
>
|
>
|










>
|


>
|




>
|




>
|










>
|
>
|




|
>


>
|
>
|
>
|
>
|


>
|







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
	(tclStubsPtr->tcl_Release) /* 216 */
#define Tcl_ResetResult \
	(tclStubsPtr->tcl_ResetResult) /* 217 */
#define Tcl_ScanElement \
	(tclStubsPtr->tcl_ScanElement) /* 218 */
#define Tcl_ScanCountedElement \
	(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
#define Tcl_SeekOld \
	(tclStubsPtr->tcl_SeekOld) /* 220 */
#define Tcl_ServiceAll \
	(tclStubsPtr->tcl_ServiceAll) /* 221 */
#define Tcl_ServiceEvent \
	(tclStubsPtr->tcl_ServiceEvent) /* 222 */
#define Tcl_SetAssocData \
	(tclStubsPtr->tcl_SetAssocData) /* 223 */
#define Tcl_SetChannelBufferSize \
	(tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
#define Tcl_SetChannelOption \
	(tclStubsPtr->tcl_SetChannelOption) /* 225 */
#define Tcl_SetCommandInfo \
	(tclStubsPtr->tcl_SetCommandInfo) /* 226 */
#define Tcl_SetErrno \
	(tclStubsPtr->tcl_SetErrno) /* 227 */
#define Tcl_SetErrorCode \
	(tclStubsPtr->tcl_SetErrorCode) /* 228 */
#define Tcl_SetMaxBlockTime \
	(tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
#define Tcl_SetPanicProc \
	(tclStubsPtr->tcl_SetPanicProc) /* 230 */
#define Tcl_SetRecursionLimit \
	(tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
#define Tcl_SetResult \
	(tclStubsPtr->tcl_SetResult) /* 232 */
#define Tcl_SetServiceMode \
	(tclStubsPtr->tcl_SetServiceMode) /* 233 */
#define Tcl_SetObjErrorCode \
	(tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
#define Tcl_SetObjResult \
	(tclStubsPtr->tcl_SetObjResult) /* 235 */
#define Tcl_SetStdChannel \
	(tclStubsPtr->tcl_SetStdChannel) /* 236 */
#define Tcl_SetVar \
	(tclStubsPtr->tcl_SetVar) /* 237 */
#define Tcl_SetVar2 \
	(tclStubsPtr->tcl_SetVar2) /* 238 */
#define Tcl_SignalId \
	(tclStubsPtr->tcl_SignalId) /* 239 */
#define Tcl_SignalMsg \
	(tclStubsPtr->tcl_SignalMsg) /* 240 */
#define Tcl_SourceRCFile \
	(tclStubsPtr->tcl_SourceRCFile) /* 241 */
#define Tcl_SplitList \
	(tclStubsPtr->tcl_SplitList) /* 242 */
#define Tcl_SplitPath \
	(tclStubsPtr->tcl_SplitPath) /* 243 */
#define Tcl_StaticPackage \
	(tclStubsPtr->tcl_StaticPackage) /* 244 */
#define Tcl_StringMatch \
	(tclStubsPtr->tcl_StringMatch) /* 245 */
#define Tcl_TellOld \
	(tclStubsPtr->tcl_TellOld) /* 246 */
#define Tcl_TraceVar \
	(tclStubsPtr->tcl_TraceVar) /* 247 */
#define Tcl_TraceVar2 \
	(tclStubsPtr->tcl_TraceVar2) /* 248 */
#define Tcl_TranslateFileName \
	(tclStubsPtr->tcl_TranslateFileName) /* 249 */
#define Tcl_Ungets \
	(tclStubsPtr->tcl_Ungets) /* 250 */
#define Tcl_UnlinkVar \
	(tclStubsPtr->tcl_UnlinkVar) /* 251 */
#define Tcl_UnregisterChannel \
	(tclStubsPtr->tcl_UnregisterChannel) /* 252 */
#define Tcl_UnsetVar \
	(tclStubsPtr->tcl_UnsetVar) /* 253 */
#define Tcl_UnsetVar2 \
	(tclStubsPtr->tcl_UnsetVar2) /* 254 */
#define Tcl_UntraceVar \
	(tclStubsPtr->tcl_UntraceVar) /* 255 */
#define Tcl_UntraceVar2 \
	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
#define Tcl_UpdateLinkedVar \
	(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
#define Tcl_UpVar \
	(tclStubsPtr->tcl_UpVar) /* 258 */
#define Tcl_UpVar2 \
	(tclStubsPtr->tcl_UpVar2) /* 259 */
#define Tcl_VarEval \
	(tclStubsPtr->tcl_VarEval) /* 260 */
#define Tcl_VarTraceInfo \
	(tclStubsPtr->tcl_VarTraceInfo) /* 261 */
#define Tcl_VarTraceInfo2 \
	(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#define Tcl_Write \
	(tclStubsPtr->tcl_Write) /* 263 */
#define Tcl_WrongNumArgs \
	(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
#define Tcl_DumpActiveMemory \
	(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
#define Tcl_ValidateAllMemory \
	(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
#define Tcl_AppendResultVA \
	(tclStubsPtr->tcl_AppendResultVA) /* 267 */
#define Tcl_AppendStringsToObjVA \
	(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
#define Tcl_HashStats \
	(tclStubsPtr->tcl_HashStats) /* 269 */
#define Tcl_ParseVar \
	(tclStubsPtr->tcl_ParseVar) /* 270 */
#define Tcl_PkgPresent \
	(tclStubsPtr->tcl_PkgPresent) /* 271 */
#define Tcl_PkgPresentEx \
	(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
#define Tcl_PkgProvide \
	(tclStubsPtr->tcl_PkgProvide) /* 273 */
#define Tcl_PkgRequire \
	(tclStubsPtr->tcl_PkgRequire) /* 274 */
#define Tcl_SetErrorCodeVA \
	(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
#define Tcl_VarEvalVA \
	(tclStubsPtr->tcl_VarEvalVA) /* 276 */
#define Tcl_WaitPid \
	(tclStubsPtr->tcl_WaitPid) /* 277 */
#define Tcl_PanicVA \
	(tclStubsPtr->tcl_PanicVA) /* 278 */
#define Tcl_GetVersion \
	(tclStubsPtr->tcl_GetVersion) /* 279 */
#define Tcl_InitMemory \
	(tclStubsPtr->tcl_InitMemory) /* 280 */
#define Tcl_StackChannel \
	(tclStubsPtr->tcl_StackChannel) /* 281 */
#define Tcl_UnstackChannel \
2998
2999
3000
3001
3002
3003
3004

3005
3006
3007
3008
3009
3010
3011
3012
	(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
#define Tcl_CreateEncoding \
	(tclStubsPtr->tcl_CreateEncoding) /* 287 */
#define Tcl_CreateThreadExitHandler \
	(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
#define Tcl_DeleteThreadExitHandler \
	(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */

/* Slot 290 is reserved */
#define Tcl_EvalEx \
	(tclStubsPtr->tcl_EvalEx) /* 291 */
#define Tcl_EvalObjv \
	(tclStubsPtr->tcl_EvalObjv) /* 292 */
#define Tcl_EvalObjEx \
	(tclStubsPtr->tcl_EvalObjEx) /* 293 */
#define Tcl_ExitThread \







>
|







3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
	(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
#define Tcl_CreateEncoding \
	(tclStubsPtr->tcl_CreateEncoding) /* 287 */
#define Tcl_CreateThreadExitHandler \
	(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
#define Tcl_DeleteThreadExitHandler \
	(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
#define Tcl_DiscardResult \
	(tclStubsPtr->tcl_DiscardResult) /* 290 */
#define Tcl_EvalEx \
	(tclStubsPtr->tcl_EvalEx) /* 291 */
#define Tcl_EvalObjv \
	(tclStubsPtr->tcl_EvalObjv) /* 292 */
#define Tcl_EvalObjEx \
	(tclStubsPtr->tcl_EvalObjEx) /* 293 */
#define Tcl_ExitThread \
3045
3046
3047
3048
3049
3050
3051

3052

3053
3054
3055
3056
3057
3058
3059
3060
	(tclStubsPtr->tcl_ConditionNotify) /* 310 */
#define Tcl_ConditionWait \
	(tclStubsPtr->tcl_ConditionWait) /* 311 */
#define Tcl_NumUtfChars \
	(tclStubsPtr->tcl_NumUtfChars) /* 312 */
#define Tcl_ReadChars \
	(tclStubsPtr->tcl_ReadChars) /* 313 */

/* Slot 314 is reserved */

/* Slot 315 is reserved */
#define Tcl_SetSystemEncoding \
	(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
#define Tcl_SetVar2Ex \
	(tclStubsPtr->tcl_SetVar2Ex) /* 317 */
#define Tcl_ThreadAlert \
	(tclStubsPtr->tcl_ThreadAlert) /* 318 */
#define Tcl_ThreadQueueEvent \







>
|
>
|







3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
	(tclStubsPtr->tcl_ConditionNotify) /* 310 */
#define Tcl_ConditionWait \
	(tclStubsPtr->tcl_ConditionWait) /* 311 */
#define Tcl_NumUtfChars \
	(tclStubsPtr->tcl_NumUtfChars) /* 312 */
#define Tcl_ReadChars \
	(tclStubsPtr->tcl_ReadChars) /* 313 */
#define Tcl_RestoreResult \
	(tclStubsPtr->tcl_RestoreResult) /* 314 */
#define Tcl_SaveResult \
	(tclStubsPtr->tcl_SaveResult) /* 315 */
#define Tcl_SetSystemEncoding \
	(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
#define Tcl_SetVar2Ex \
	(tclStubsPtr->tcl_SetVar2Ex) /* 317 */
#define Tcl_ThreadAlert \
	(tclStubsPtr->tcl_ThreadAlert) /* 318 */
#define Tcl_ThreadQueueEvent \
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
	(tclStubsPtr->tcl_UtfToUpper) /* 337 */
#define Tcl_WriteChars \
	(tclStubsPtr->tcl_WriteChars) /* 338 */
#define Tcl_WriteObj \
	(tclStubsPtr->tcl_WriteObj) /* 339 */
#define Tcl_GetString \
	(tclStubsPtr->tcl_GetString) /* 340 */

/* Slot 341 is reserved */

/* Slot 342 is reserved */
#define Tcl_AlertNotifier \
	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#define Tcl_ServiceModeHook \
	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
#define Tcl_UniCharIsAlnum \
	(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
#define Tcl_UniCharIsAlpha \
	(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
#define Tcl_UniCharIsDigit \
	(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
#define Tcl_UniCharIsLower \
	(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
#define Tcl_UniCharIsSpace \
	(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
#define Tcl_UniCharIsUpper \
	(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
#define Tcl_UniCharIsWordChar \
	(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */

/* Slot 352 is reserved */

/* Slot 353 is reserved */
#define Tcl_Char16ToUtfDString \
	(tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */
#define Tcl_UtfToChar16DString \
	(tclStubsPtr->tcl_UtfToChar16DString) /* 355 */
#define Tcl_GetRegExpFromObj \
	(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */

/* Slot 357 is reserved */
#define Tcl_FreeParse \
	(tclStubsPtr->tcl_FreeParse) /* 358 */
#define Tcl_LogCommandInfo \
	(tclStubsPtr->tcl_LogCommandInfo) /* 359 */
#define Tcl_ParseBraces \
	(tclStubsPtr->tcl_ParseBraces) /* 360 */
#define Tcl_ParseCommand \







>
|
>
|


















>
|
>
|






>
|







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
	(tclStubsPtr->tcl_UtfToUpper) /* 337 */
#define Tcl_WriteChars \
	(tclStubsPtr->tcl_WriteChars) /* 338 */
#define Tcl_WriteObj \
	(tclStubsPtr->tcl_WriteObj) /* 339 */
#define Tcl_GetString \
	(tclStubsPtr->tcl_GetString) /* 340 */
#define Tcl_GetDefaultEncodingDir \
	(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
#define Tcl_SetDefaultEncodingDir \
	(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
#define Tcl_AlertNotifier \
	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#define Tcl_ServiceModeHook \
	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
#define Tcl_UniCharIsAlnum \
	(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
#define Tcl_UniCharIsAlpha \
	(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
#define Tcl_UniCharIsDigit \
	(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
#define Tcl_UniCharIsLower \
	(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
#define Tcl_UniCharIsSpace \
	(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
#define Tcl_UniCharIsUpper \
	(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
#define Tcl_UniCharIsWordChar \
	(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
#define Tcl_UniCharLen \
	(tclStubsPtr->tcl_UniCharLen) /* 352 */
#define Tcl_UniCharNcmp \
	(tclStubsPtr->tcl_UniCharNcmp) /* 353 */
#define Tcl_Char16ToUtfDString \
	(tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */
#define Tcl_UtfToChar16DString \
	(tclStubsPtr->tcl_UtfToChar16DString) /* 355 */
#define Tcl_GetRegExpFromObj \
	(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
#define Tcl_EvalTokens \
	(tclStubsPtr->tcl_EvalTokens) /* 357 */
#define Tcl_FreeParse \
	(tclStubsPtr->tcl_FreeParse) /* 358 */
#define Tcl_LogCommandInfo \
	(tclStubsPtr->tcl_LogCommandInfo) /* 359 */
#define Tcl_ParseBraces \
	(tclStubsPtr->tcl_ParseBraces) /* 360 */
#define Tcl_ParseCommand \
3174
3175
3176
3177
3178
3179
3180

3181
3182
3183

3184
3185
3186
3187
3188
3189
3190
3191
	(tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
#define Tcl_SetUnicodeObj \
	(tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
#define Tcl_GetCharLength \
	(tclStubsPtr->tcl_GetCharLength) /* 380 */
#define Tcl_GetUniChar \
	(tclStubsPtr->tcl_GetUniChar) /* 381 */

/* Slot 382 is reserved */
#define Tcl_GetRange \
	(tclStubsPtr->tcl_GetRange) /* 383 */

/* Slot 384 is reserved */
#define Tcl_RegExpMatchObj \
	(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
#define Tcl_SetNotifier \
	(tclStubsPtr->tcl_SetNotifier) /* 386 */
#define Tcl_GetAllocMutex \
	(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
#define Tcl_GetChannelNames \







>
|


>
|







3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
	(tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
#define Tcl_SetUnicodeObj \
	(tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
#define Tcl_GetCharLength \
	(tclStubsPtr->tcl_GetCharLength) /* 380 */
#define Tcl_GetUniChar \
	(tclStubsPtr->tcl_GetUniChar) /* 381 */
#define Tcl_GetUnicode \
	(tclStubsPtr->tcl_GetUnicode) /* 382 */
#define Tcl_GetRange \
	(tclStubsPtr->tcl_GetRange) /* 383 */
#define Tcl_AppendUnicodeToObj \
	(tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
#define Tcl_RegExpMatchObj \
	(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
#define Tcl_SetNotifier \
	(tclStubsPtr->tcl_SetNotifier) /* 386 */
#define Tcl_GetAllocMutex \
	(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
#define Tcl_GetChannelNames \
3210
3211
3212
3213
3214
3215
3216

3217
3218
3219
3220
3221
3222
3223

3224
3225
3226
3227
3228
3229
3230
3231
	(tclStubsPtr->tcl_ChannelBuffered) /* 397 */
#define Tcl_ChannelName \
	(tclStubsPtr->tcl_ChannelName) /* 398 */
#define Tcl_ChannelVersion \
	(tclStubsPtr->tcl_ChannelVersion) /* 399 */
#define Tcl_ChannelBlockModeProc \
	(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */

/* Slot 401 is reserved */
#define Tcl_ChannelClose2Proc \
	(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
#define Tcl_ChannelInputProc \
	(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
#define Tcl_ChannelOutputProc \
	(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */

/* Slot 405 is reserved */
#define Tcl_ChannelSetOptionProc \
	(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
#define Tcl_ChannelGetOptionProc \
	(tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
#define Tcl_ChannelWatchProc \
	(tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
#define Tcl_ChannelGetHandleProc \







>
|






>
|







3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
	(tclStubsPtr->tcl_ChannelBuffered) /* 397 */
#define Tcl_ChannelName \
	(tclStubsPtr->tcl_ChannelName) /* 398 */
#define Tcl_ChannelVersion \
	(tclStubsPtr->tcl_ChannelVersion) /* 399 */
#define Tcl_ChannelBlockModeProc \
	(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
#define Tcl_ChannelCloseProc \
	(tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
#define Tcl_ChannelClose2Proc \
	(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
#define Tcl_ChannelInputProc \
	(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
#define Tcl_ChannelOutputProc \
	(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
#define Tcl_ChannelSeekProc \
	(tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
#define Tcl_ChannelSetOptionProc \
	(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
#define Tcl_ChannelGetOptionProc \
	(tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
#define Tcl_ChannelWatchProc \
	(tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
#define Tcl_ChannelGetHandleProc \
3244
3245
3246
3247
3248
3249
3250

3251

3252

3253

3254
3255
3256
3257
3258
3259
3260
3261
	(tclStubsPtr->tcl_CutChannel) /* 415 */
#define Tcl_SpliceChannel \
	(tclStubsPtr->tcl_SpliceChannel) /* 416 */
#define Tcl_ClearChannelHandlers \
	(tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */
#define Tcl_IsChannelExisting \
	(tclStubsPtr->tcl_IsChannelExisting) /* 418 */

/* Slot 419 is reserved */

/* Slot 420 is reserved */

/* Slot 421 is reserved */

/* Slot 422 is reserved */
#define Tcl_InitCustomHashTable \
	(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#define Tcl_InitObjHashTable \
	(tclStubsPtr->tcl_InitObjHashTable) /* 424 */
#define Tcl_CommandTraceInfo \
	(tclStubsPtr->tcl_CommandTraceInfo) /* 425 */
#define Tcl_TraceCommand \







>
|
>
|
>
|
>
|







3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
	(tclStubsPtr->tcl_CutChannel) /* 415 */
#define Tcl_SpliceChannel \
	(tclStubsPtr->tcl_SpliceChannel) /* 416 */
#define Tcl_ClearChannelHandlers \
	(tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */
#define Tcl_IsChannelExisting \
	(tclStubsPtr->tcl_IsChannelExisting) /* 418 */
#define Tcl_UniCharNcasecmp \
	(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
#define Tcl_UniCharCaseMatch \
	(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
#define Tcl_FindHashEntry \
	(tclStubsPtr->tcl_FindHashEntry) /* 421 */
#define Tcl_CreateHashEntry \
	(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
#define Tcl_InitCustomHashTable \
	(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#define Tcl_InitObjHashTable \
	(tclStubsPtr->tcl_InitObjHashTable) /* 424 */
#define Tcl_CommandTraceInfo \
	(tclStubsPtr->tcl_CommandTraceInfo) /* 425 */
#define Tcl_TraceCommand \
3272
3273
3274
3275
3276
3277
3278

3279

3280
3281
3282
3283
3284
3285
3286
3287
	(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
#define Tcl_AttemptSetObjLength \
	(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
#define Tcl_GetChannelThread \
	(tclStubsPtr->tcl_GetChannelThread) /* 433 */
#define Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */

/* Slot 435 is reserved */

/* Slot 436 is reserved */
#define Tcl_SubstObj \
	(tclStubsPtr->tcl_SubstObj) /* 437 */
#define Tcl_DetachChannel \
	(tclStubsPtr->tcl_DetachChannel) /* 438 */
#define Tcl_IsStandardChannel \
	(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
#define Tcl_FSCopyFile \







>
|
>
|







3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
	(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
#define Tcl_AttemptSetObjLength \
	(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
#define Tcl_GetChannelThread \
	(tclStubsPtr->tcl_GetChannelThread) /* 433 */
#define Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
#define Tcl_GetMathFuncInfo \
	(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
#define Tcl_ListMathFuncs \
	(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
#define Tcl_SubstObj \
	(tclStubsPtr->tcl_SubstObj) /* 437 */
#define Tcl_DetachChannel \
	(tclStubsPtr->tcl_DetachChannel) /* 438 */
#define Tcl_IsStandardChannel \
	(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
#define Tcl_FSCopyFile \
3438
3439
3440
3441
3442
3443
3444

3445
3446
3447
3448
3449
3450
3451
3452
	(tclStubsPtr->tcl_FindCommand) /* 515 */
#define Tcl_GetCommandFromObj \
	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
#define Tcl_GetCommandFullName \
	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#define Tcl_FSEvalFileEx \
	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */

/* Slot 519 is reserved */
#define Tcl_LimitAddHandler \
	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
#define Tcl_LimitRemoveHandler \
	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
#define Tcl_LimitReady \
	(tclStubsPtr->tcl_LimitReady) /* 522 */
#define Tcl_LimitCheck \







>
|







3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
	(tclStubsPtr->tcl_FindCommand) /* 515 */
#define Tcl_GetCommandFromObj \
	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
#define Tcl_GetCommandFullName \
	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#define Tcl_FSEvalFileEx \
	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
#define Tcl_SetExitProc \
	(tclStubsPtr->tcl_SetExitProc) /* 519 */
#define Tcl_LimitAddHandler \
	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
#define Tcl_LimitRemoveHandler \
	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
#define Tcl_LimitReady \
	(tclStubsPtr->tcl_LimitReady) /* 522 */
#define Tcl_LimitCheck \
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

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp


#   undef Tcl_Init


#   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





#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)

#define Tcl_PkgProvide(interp, name, version) \
	Tcl_PkgProvideEx(interp, name, version, NULL)

#define Tcl_PkgRequire(interp, name, version, exact) \
	Tcl_PkgRequireEx(interp, name, version, exact, NULL)

#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
	Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
	sizeof(char *), msg, flags, indexPtr)

#define Tcl_NewBooleanObj(boolValue) \
	Tcl_NewWideIntObj((boolValue)!=0)

#define Tcl_DbNewBooleanObj(boolValue, file, line) \
	Tcl_DbNewWideIntObj((boolValue)!=0, file, line)

#define Tcl_SetBooleanObj(objPtr, boolValue) \
	Tcl_SetWideIntObj(objPtr, (boolValue)!=0)

#define Tcl_SetVar(interp, varName, newValue, flags) \
	Tcl_SetVar2(interp, varName, NULL, newValue, flags)

#define Tcl_UnsetVar(interp, varName, flags) \
	Tcl_UnsetVar2(interp, varName, NULL, flags)

#define Tcl_GetVar(interp, varName, flags) \
	Tcl_GetVar2(interp, varName, NULL, flags)

#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
	Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)

#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)

#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
	Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)

#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_GetLongFromObj
#	undef Tcl_ExprLong
#	undef Tcl_ExprLongObj




#	define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
#	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
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
#   define Tcl_Free(x) \
    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 */

#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))

#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))

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

#if TCL_UTF_MAX <= 3
#   undef Tcl_UniCharToUtfDString
#   define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
#   undef Tcl_UtfToUniCharDString
#   define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
#   undef Tcl_UtfToUniChar
#   define Tcl_UtfToUniChar Tcl_UtfToChar16
#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:
 */


#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)

#define Tcl_GlobalEvalObj(interp, objPtr) \
    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 */







>
>

>
>

>

>








|






>
>
>
>


>


>


>



>


>


>


>


>


>


>


>


>


>


>


>


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


>


|


|
|


>



|
|

>

|
>







|





>













>
>
>
>















>
>
>
>
>
>
>
>



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

>

>

>

>

>

>

>












|
|

|
|





|
|

|
|









>


>



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


<
<
|


|

<
|
|
|
<


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

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
#   undef Tcl_FindExecutable
#   undef Tcl_GetStringResult
#   undef Tcl_Init
#   undef Tcl_SetPanicProc
#   undef Tcl_SetExitProc
#   undef Tcl_ObjSetVar2
#   undef Tcl_StaticPackage
#   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
#   define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
#   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 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_SeekOld
#undef Tcl_TellOld

#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)
#undef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
	Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
#undef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj(objPtr, boolValue) \
	Tcl_SetWideIntObj(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)
#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#ifdef TCL_NO_DEPRECATED
#undef Tcl_FreeResult
#undef Tcl_AppendResultVA
#undef Tcl_AppendStringsToObjVA
#undef Tcl_SetErrorCodeVA
#undef Tcl_VarEvalVA
#undef Tcl_PanicVA
#undef Tcl_GetStringResult
#undef Tcl_GetDefaultEncodingDir
#undef Tcl_SetDefaultEncodingDir
#undef Tcl_UniCharLen
#undef Tcl_UniCharNcmp
#undef Tcl_EvalTokens
#undef Tcl_UniCharNcasecmp
#undef Tcl_UniCharCaseMatch
#undef Tcl_GetMathFuncInfo
#undef Tcl_ListMathFuncs
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#undef Tcl_Eval
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
#define Tcl_SaveResult(interp, statePtr) \
	do { \
	    (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
	    Tcl_IncrRefCount((statePtr)->objResultPtr); \
	    Tcl_SetObjResult(interp, Tcl_NewObj()); \
	} while(0)
#undef Tcl_RestoreResult
#define Tcl_RestoreResult(interp, statePtr) \
	do { \
	    Tcl_ResetResult(interp); \
   	    Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
   	    Tcl_DecrRefCount((statePtr)->objResultPtr); \
	} while(0)
#undef Tcl_DiscardResult
#define Tcl_DiscardResult(statePtr) \
	Tcl_DecrRefCount((statePtr)->objResultPtr)
#undef Tcl_SetResult
#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) { \
		    ckfree((char *)__result); \
		} else { \
		    (*__freeProc)((char *)__result); \
		} \
	    } \
	} while(0)
#endif /* TCL_NO_DEPRECATED */

#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_GetLongFromObj
#	undef Tcl_ExprLong
#	undef Tcl_ExprLongObj
#	undef Tcl_UniCharNcmp
#	undef Tcl_UtfNcmp
#	undef Tcl_UtfNcasecmp
#	undef Tcl_UniCharNcasecmp
#	define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
#	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;
	}
#	define Tcl_UniCharNcmp(ucs,uct,n) \
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n))
#	define Tcl_UtfNcmp(s1,s2,n) \
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UtfNcasecmp(s1,s2,n) \
		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
#	define Tcl_UniCharNcasecmp(ucs,uct,n) \
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
#   endif
#endif





#undef Tcl_NewLongObj













#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#undef Tcl_NewIntObj
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#undef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#undef Tcl_SetIntObj
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#undef Tcl_GetUnicode
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
#undef Tcl_BackgroundError
#define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)
#undef Tcl_StringMatch
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)

#if TCL_UTF_MAX <= 3
#   undef Tcl_UniCharToUtfDString
#   define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
#   undef Tcl_UtfToUniCharDString
#   define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
#   undef Tcl_UtfToUniChar
#   define Tcl_UtfToUniChar Tcl_UtfToChar16
#endif
#if defined(USE_TCL_STUBS)
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, int, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, int, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, int, 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 *, int, Tcl_DString *))Tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, int, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, int, Tcl_DString *))Tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, int, 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)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)


#if defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)
#undef Tcl_Close




















#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)










#endif



#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX > 3)
#   undef Tcl_UtfCharComplete
#   define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 4) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
#endif

#define Tcl_CreateSlave Tcl_CreateChild
#define Tcl_GetSlave Tcl_GetChild
#define Tcl_GetMaster Tcl_GetParent


#endif /* _TCLDECLS */
Changes to generic/tclDictObj.c.
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
				 * 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) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*







|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
				 * 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. */
    unsigned int epoch; 	/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
AllocChainEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    ChainEntry *cPtr;

    cPtr = (ChainEntry *)Tcl_Alloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

/*
 * Helper functions that disguise most of the details relating to how the







|


|







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
AllocChainEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    ChainEntry *cPtr;

    cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    cPtr->entry.clientData = NULL;
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

/*
 * Helper functions that disguise most of the details relating to how the
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
 */

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict, *newDict = (Dict *)Tcl_Alloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetIntRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */







|







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
 */

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetIntRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    Tcl_Free(dict);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDict --
 *







|







450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    ckfree(dict);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDict --
 *
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532




533
534
535
536






537
538
539
540
541
542
543
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict;
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    size_t i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

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

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	Tcl_InitStringRep(dictPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    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);
	elem = TclGetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);




	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);






    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */








|








|




















|











>
>
>
>




>
>
>
>
>
>







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict;
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    int numElems;

    DictGetIntRep(dictPtr, dict);

    assert (dict != NULL);

    numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	Tcl_InitStringRep(dictPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)ckalloc(numElems);
    }
    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);
	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);
	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.
     */

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetDictFromAny --







|







565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetDictFromAny --
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = (Dict *)Tcl_Alloc(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.







|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    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.
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

		/*
		 * 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);

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	size_t 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 literal;

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {
		break;







|







|






|
<







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

		/*
		 * 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) Tcl_GetString(objPtr);

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	int length;
	const char *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    int elemSize, literal;


	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    }
	    if (elemStart == limit) {
		break;
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
  errorInFindDictElement:
    DeleteChainTable(dict);
    Tcl_Free(dict);
    return TCL_ERROR;
}

static Dict *
GetDictFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr)







|







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
  errorInFindDictElement:
    DeleteChainTable(dict);
    ckfree(dict);
    return TCL_ERROR;
}

static Dict *
GetDictFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr)
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
#endif







|







1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
#endif
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
    int line)
{
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)Tcl_Alloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
}







|







1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
    int line)
{
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
}
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
    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);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --







|







2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
    dict = GetDictFromObj(interp, objv[1]);
    if (dict == NULL) {
	return TCL_ERROR;
    }

    statsStr = Tcl_HashStats(&dict->table);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
    ckfree(statsStr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --
2213
2214
2215
2216
2217
2218
2219
2220
2221

2222
2223
2224
2225
2226
2227
2228
	if (Tcl_IsShared(valuePtr)) {
	    valuePtr = Tcl_DuplicateObj(valuePtr);
	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
	}
	if (objc == 4) {
	    code = TclIncrObj(interp, valuePtr, objv[3]);
	} else {
	    Tcl_Obj *incrPtr = Tcl_NewWideIntObj(1);


	    Tcl_IncrRefCount(incrPtr);
	    code = TclIncrObj(interp, valuePtr, incrPtr);
	    TclDecrRefCount(incrPtr);
	}
    }
    if (code == TCL_OK) {
	TclInvalidateStringRep(dictPtr);







|

>







2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
	if (Tcl_IsShared(valuePtr)) {
	    valuePtr = Tcl_DuplicateObj(valuePtr);
	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
	}
	if (objc == 4) {
	    code = TclIncrObj(interp, valuePtr, objv[3]);
	} else {
	    Tcl_Obj *incrPtr;

	    TclNewIntObj(incrPtr, 1);
	    Tcl_IncrRefCount(incrPtr);
	    code = TclIncrObj(interp, valuePtr, incrPtr);
	    TclDecrRefCount(incrPtr);
	}
    }
    if (code == TCL_OK) {
	TclInvalidateStringRep(dictPtr);
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
    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);
	} else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    TclDecrRefCount(dictPtr);
	    return TCL_ERROR;
	}
    }
    TclDecrRefCount(dictPtr);







|







3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
    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, Tcl_GetString(objv[i+1]), NULL, 0);
	} else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    TclDecrRefCount(dictPtr);
	    return TCL_ERROR;
	}
    }
    TclDecrRefCount(dictPtr);
Changes to generic/tclDisassemble.c.
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
 */

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));
}

/*
 *----------------------------------------------------------------------







|


|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
 */

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 = TclGetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
 *----------------------------------------------------------------------
 */

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







|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
 *----------------------------------------------------------------------
 */

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);
273
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290
291
292
293
294
295
    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







|
|
>






|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %u, epoch %u, interp %p (epoch %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",
		Tcl_GetString(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
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
     */

    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,







|







318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %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,
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
    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++;
	}







|









|








|









|







402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
    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++;
	}
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494

    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++;
	}







|









|









|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495

    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++;
	}
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
	    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) {







|







|


















|




|



|







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
	    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 ", (unsigned) 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 ", (unsigned) 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 ", (unsigned) opnd);
	    break;
	case OPERAND_LIT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
	    break;
	case OPERAND_AUX4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) 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) {
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
	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) {







|





|





|













|







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
	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_SCLS1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
		    tclStringClassTable[opnd].name);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	int 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) {
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
    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);
    }
}

/*
 *----------------------------------------------------------------------







|




|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
    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, 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;
	unsigned int len = strlen(s);
	dst = Tcl_InitStringRep(objPtr, s, len);
	TclOOM(dst, len);
    }
}

/*
 *----------------------------------------------------------------------
Changes to generic/tclEncoding.c.
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
    /*
     * 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.
     */

    dataPtr = (TableEncodingData *)Tcl_Alloc(sizeof(TableEncodingData));
    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);

    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;







|




|

|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
    /*
     * 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.
     */

    dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';

    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;
677
678
679
680
681
682
683
































































684
685
686
687
688
689
690
	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    }

    Tcl_DeleteHashTable(&encodingTable);
    Tcl_MutexUnlock(&encodingMutex);
}

































































/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncoding --
 *
 *	Given the name of a encoding, find the corresponding Tcl_Encoding
 *	token. If the encoding did not already exist, Tcl attempts to







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







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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
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 TclGetString(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);
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncoding --
 *
 *	Given the name of a encoding, find the corresponding Tcl_Encoding
 *	token. If the encoding did not already exist, Tcl attempts to
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	if (encodingPtr->name) {
	    Tcl_Free(encodingPtr->name);
	}
	Tcl_Free(encodingPtr);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --







|

|







853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	if (encodingPtr->name) {
	    ckfree(encodingPtr->name);
	}
	ckfree(encodingPtr);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = (Encoding *)Tcl_Alloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {







|







1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	 * 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;







|







1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
	 * reference goes away.
	 */

	Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = (char *)ckalloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }
    return (Tcl_Encoding) encodingPtr;
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
 */

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
				 * 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;
    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);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,







|







|
<












|







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

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. */
    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, dstLen, result, soFar, srcRead, dstWrote, dstChars;


    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 < 0) {
	srcLen = encodingPtr->lengthProc(src);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
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

int
Tcl_ExternalToUtf(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    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 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
				 * 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







|
|








|







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

int
Tcl_ExternalToUtf(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    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. */
    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
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {







|







1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = encodingPtr->lengthProc(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
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
 */

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
				 * 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;
    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 = strlen(src);
    }
    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);







|







|
<












|







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

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. */
    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, dstLen, result, soFar, srcRead, dstWrote, dstChars;


    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 < 0) {
	srcLen = strlen(src);
    }
    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);
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

int
Tcl_UtfToExternal(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    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 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
				 * 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







|
|








|







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

int
Tcl_UtfToExternal(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    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. */
    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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {







|







1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen < 0) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_CloseEx(NULL, chan, 0);

    return encoding;
}

/*
 *-------------------------------------------------------------------------
 *







|







1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_Close(NULL, chan);

    return encoding;
}

/*
 *-------------------------------------------------------------------------
 *
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
    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = (TableEncodingData *)Tcl_Alloc(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);
    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;
	size_t expected = 3 + 16 * (16 * 4 + 1);

	if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
	    return NULL;
	}
	p = TclGetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;







|











|








|







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
    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    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 **)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;
	int expected = 3 + 16 * (16 * 4 + 1);

	if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
	    return NULL;
	}
	p = TclGetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
    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);
    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;







|







1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    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;
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
    }

    /*
     * Read lines until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) != -1;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */







|







1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
    }

    /*
     * Read lines until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) >= 0;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;

	/*
	 * Skip short lines.
	 */
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
    while (1) {
	int argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
	    break;
	}
	line = Tcl_DStringValue(&lineString);
	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
	    Tcl_DStringFree(&lineString);
	    continue;
	}







|







2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
    while (1) {
	int argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) < 0) {
	    break;
	}
	line = Tcl_DStringValue(&lineString);
	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
	    Tcl_DStringFree(&lineString);
	    continue;
	}
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	Tcl_Free((void *)argv);
	Tcl_DStringFree(&lineString);
    }

    size = offsetof(EscapeEncodingData, subTables)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)Tcl_Alloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),







|





|







2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	ckfree(argv);
	Tcl_DStringFree(&lineString);
    }

    size = offsetof(EscapeEncodingData, subTables)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
2277
2278
2279
2280
2281
2282
2283

2284
2285
2286
2287
2288
2289
2290

2291
2292
2293
2294
2295
2296
2297
	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.
	     */

	    *dst++ = *src++;

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

	    *dst++ = 0;

	    src += 2;
	} else if (!TclUCS4Complete(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.
	     */







>







>







2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
	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.
	     */

	    *dst++ = *src++;
	    *chPtr = 0; /* reset surrogate handling */
	} 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.
	     */

	    *dst++ = 0;
	    *chPtr = 0; /* reset surrogate handling */
	    src += 2;
	} else if (!TclUCS4Complete(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.
	     */
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
{
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    Tcl_Free(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
    Tcl_Free(dataPtr->fromUnicode);
    dataPtr->fromUnicode = NULL;
    Tcl_Free(dataPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *







|

|

|







3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
{
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    ckfree(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
    ckfree(dataPtr->fromUnicode);
    dataPtr->fromUnicode = NULL;
    ckfree(dataPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *
3456
3457
3458
3459
3460
3461
3462
3463

3464
3465
3466
3467
3468
3469
3470
		     * in the next conversion.
		     */

		    state = oldState;
		    result = TCL_CONVERT_NOSPACE;
		    break;
		}
		memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen);

		dst += subTablePtr->sequenceLen;
	    }
	}

	if (tablePrefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;







|
>







3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
		     * in the next conversion.
		     */

		    state = oldState;
		    result = TCL_CONVERT_NOSPACE;
		    break;
		}
		memcpy(dst, subTablePtr->sequence,
			subTablePtr->sequenceLen);
		dst += subTablePtr->sequenceLen;
	    }
	}

	if (tablePrefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
	subTablePtr = dataPtr->subTables;
	for (i = 0; i < dataPtr->numSubTables; i++) {
	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr->encodingPtr = NULL;
	    subTablePtr++;
	}
    }
    Tcl_Free(dataPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *







|







3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
	subTablePtr = dataPtr->subTables;
	for (i = 0; i < dataPtr->numSubTables; i++) {
	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr->encodingPtr = NULL;
	    subTablePtr++;
	}
    }
    ckfree(dataPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");







|







3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
3695
3696
3697
3698
3699
3700
3701
3702


3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714

    Tcl_DecrRefCount(libPathObj);
    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);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
>
>
|











3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);

    *lengthPtr = searchPathObj->length;
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclEnsemble.c.
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

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







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

typedef struct {
    unsigned int 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. */
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
				/* 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;







|




|







671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	ckfree(ensemblePtr);
	return NULL;
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;
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
		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;
}

/*
 *----------------------------------------------------------------------
 *







|




















|







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
		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_GetString(Tcl_GetObjResult(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) {
	ckfree(nameParts);
    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
				 * 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);







|








|







1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
				 * 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;
    int subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if (objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
	 * 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);







|
|







1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
	 * 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. */
	int stringLength, i;
	int 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);
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
    }
    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]);







|







1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
    }
    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 {
	int 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]);
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
 *
 *----------------------------------------------------------------------
 */

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







|
|











|







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

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    int numRemoved,
    int 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 {
	int numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}
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
    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;
    }








|
|








|






|
|







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
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_Obj **tmp = (Tcl_Obj **) data[0];
    Tcl_Obj **store = (Tcl_Obj **) data[1];

    ckfree(store);
    ckfree(tmp);
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    int idx;
    int size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
	}
    }

    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.







|

|







2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    }  else {
	Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *));

	store = (Tcl_Obj **)ckalloc(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.
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
	}
    } 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.
     */








|







2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
	ECRSetIntRep(objPtr, ensembleCmd);
    }

    /*
     * Populate the internal rep.
     */

2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
        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)







|







2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
        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);
        }
        ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
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);







|
<







2564
2565
2566
2567
2568
2569
2570
2571

2572
2573
2574
2575
2576
2577
2578
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);
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
        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]);







|







2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
        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]);
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
                }
            }
        } 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;
                }

                /*







|







2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
                }
            }
        } 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;
                }

                /*
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
     *
     * 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 ;







|







2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
     *
     * 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 ;
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
    EnsembleCmdRep *ensembleCmd;

    ECRGetIntRep(objPtr, ensembleCmd);
    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    Tcl_Free(ensembleCmd);
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --
 *







|







2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
    EnsembleCmdRep *ensembleCmd;

    ECRGetIntRep(objPtr, ensembleCmd);
    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    ckfree(ensembleCmd);
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --
 *
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872

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







|







2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd;
    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));

    ECRGetIntRep(objPtr, ensembleCmd);
    ECRSetIntRep(copyPtr, ensembleCopy);

    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
    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;
    }







|







2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
    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;
    unsigned numBytes;
    const char *word;

    TclNewObj(replaced);
    Tcl_IncrRefCount(replaced);
    if (parsePtr->numWords < depth + 1) {
	goto failed;
    }
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
     * 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;







|








|







2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
     * 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) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {
	    str = TclGetStringFromObj(elems[i], &sclen);
	    if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
		    goto failed;
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
	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;







|







3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
	int done, matched;
	Tcl_Obj *tmpObj;

	/*
	 * No map, so check the dictionary directly.
	 */

	TclNewStringObj(subcmdObj, word, (int) numBytes);
	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
	if (result == TCL_OK && targetCmdObj != NULL) {
	    /*
	     * Got it. Skip the fiddling around with prefixes.
	     */

	    replacement = subcmdObj;
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192

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







|







3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
        mapPtr->nuloc--;
        ckfree(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.
     */
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
	 * 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;
}







|







3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
	 * 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)", parsePtr->tokenPtr->size,
		    parsePtr->tokenPtr->start, diff);
	}
#endif
    }

    return result;
}
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
    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);







<











|
|







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
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    const char *bytes;
    int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;


    /*
     * 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 = TclGetString(words[i-1]);
	    PushLiteral(envPtr, bytes, words[i-1]->length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size, 0);
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
    /*
     * 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.
     */







|



|







3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
    /*
     * 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 = TclGetString(objPtr);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }
    cmdLit = TclRegisterLiteral(envPtr, bytes, objPtr->length, extraLiteralFlags);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */
Changes to generic/tclEnv.c.
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
		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. */
    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
				 * 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
				 * 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;








|







|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
		Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
#  define utf2tenvirondstr(str, len, dstr) \
		Tcl_UtfToExternalDString(NULL, str, len, dstr)
#  define techar char
#endif

static struct {
    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
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    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;

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
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;
    char *p, *oldValue;
    const techar *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) {
#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 *));

	    memcpy(newEnviron, tenviron, length * sizeof(techar *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		Tcl_Free(env.ourEnviron);
	    }
	    tenviron = (env.ourEnviron = newEnviron);
	    env.ourEnvironSize = length + 5;
	}
	index = length;
	tenviron[index + 1] = NULL;
#endif /* USE_PUTENV */







|
|












|








|



|







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
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;
    unsigned nameLength, valueLength;
    int index, length;
    char *p, *oldValue;
    const techar *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 == -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 **)ckalloc((length + 5) * sizeof(techar *));

	    memcpy(newEnviron, tenviron, length * sizeof(techar *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		ckfree(env.ourEnviron);
	    }
	    tenviron = (env.ourEnviron = newEnviron);
	    env.ourEnvironSize = length + 5;
	}
	index = length;
	tenviron[index + 1] = NULL;
#endif /* USE_PUTENV */
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
    /*
     * 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 = (char *)Tcl_Alloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = utf2tenvirondstr(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);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    putenv(p);
    index = TclpFindVariable(name, &length);
#else
    tenviron[index] = (techar *)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)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(p);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {
	/*







|









|




















|







|







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
    /*
     * 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 = (char *)ckalloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = utf2tenvirondstr(p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + tNTL);
    memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    putenv(p);
    index = TclpFindVariable(name, &length);
#else
    tenviron[index] = (techar *)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 != -1) && (tenviron[index] == (techar *)p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	ckfree(p);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {
	/*
442
443
444
445
446
447
448
449

450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    size_t length, 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) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */







|
>















|







442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    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 == -1) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
#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);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = (char *)Tcl_Alloc(length + 1);
    memcpy(string, name, length);
    string[length] = '\0';
#endif /* _WIN32 */

    utf2tenvirondstr(string, -1, &envString);
    string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
    memcpy(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) {
	ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(string);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }
#else /* !USE_PUTENV_FOR_UNSET */
    for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
	envPtr[-1] = *envPtr;
	if (*envPtr == NULL) {
	    break;







|




|





|




















|







482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
#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 *)ckalloc(length + 2);
    memcpy(string, name, length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = (char *)ckalloc(length + 1);
    memcpy(string, name, length);
    string[length] = '\0';
#endif /* _WIN32 */

    utf2tenvirondstr(string, -1, &envString);
    string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + tNTL);
    memcpy(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) {
	ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	ckfree(string);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }
#else /* !USE_PUTENV_FOR_UNSET */
    for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
	envPtr[-1] = *envPtr;
	if (*envPtr == NULL) {
	    break;
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
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;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != TCL_INDEX_NONE) {
	Tcl_DString envStr;

	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);







|





|







558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
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. */
{
    int length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != -1) {
	Tcl_DString envStr;

	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);
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
 */

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{
    size_t 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]);
	}

	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.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}

/*
 *----------------------------------------------------------------------
 *







|



















|

















|



|







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

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{
    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]) {
	    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 **)ckrealloc(env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(size_t) (growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
     * 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
     * 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);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    Tcl_Free(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}








|

|


|




|







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
     * 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
     * free all strings in the cache.
     */

    if (env.cache) {
#ifdef PURIFY
	int i;
	for (i = 0; i < env.cacheSize; i++) {
	    ckfree(env.cache[i]);
	}
#endif
	ckfree(env.cache);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    ckfree(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}

Changes to generic/tclEvent.c.
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141











142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
			    const char *name2, int flags);
static void		InvokeExitHandlers(void);
static void		FinalizeThread(int quick);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BackgroundException --
 *
 *	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_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->errorMsg = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(errPtr->errorMsg);
    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
    Tcl_IncrRefCount(errPtr->returnOpts);
    errPtr->nextPtr = NULL;

    (void) TclGetBgErrorHandler(interp);







|














>
>
>
>
>
>
>
>
>
>
>













|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
			    const char *name2, int flags);
static void		InvokeExitHandlers(void);
static void		FinalizeThread(int quick);

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#undef Tcl_BackgroundError
void
Tcl_BackgroundError(
    Tcl_Interp *interp)		/* Interpreter in which an error has
				 * occurred. */
{
    Tcl_BackgroundException(interp, TCL_ERROR);
}
#endif /* TCL_NO_DEPRECATED */

void
Tcl_BackgroundException(
    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*)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);
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
	 */

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

	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);
	    }
	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr = NULL;







|














|
|












|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);

	errPtr = assocPtr->firstBgPtr;

	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	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;
	ckfree(errPtr);
	ckfree(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);
		ckfree(errPtr);
	    }
	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr = NULL;
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = (ErrAssocData*)Tcl_Alloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
    }
    if (assocPtr->cmdPrefix) {







|







524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = (ErrAssocData*)ckalloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
    }
    if (assocPtr->cmdPrefix) {
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	Tcl_Free(errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
    Tcl_DecrRefCount(assocPtr->cmdPrefix);
    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
}

/*







|







603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	ckfree(errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
    Tcl_DecrRefCount(assocPtr->cmdPrefix);
    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
}

/*
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);







|







633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);







|







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}








|







711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstLateExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}








|







754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstLateExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*







|







788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------







|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    ckfree(exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
	 * 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);
}









|







908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
	 * 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);
	ckfree(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);
}


1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
	     * 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
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */







|







1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
	     * 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
					 * thread local storage */
#if defined(USE_TCLALLOC) && 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 */
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
	 * 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);
	Tcl_MutexLock(&exitMutex);
    }
    firstLateExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Now finalize the Tcl execution environment. Note that this must be done







|







1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
	 * 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);
	ckfree(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstLateExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Now finalize the Tcl execution environment. Note that this must be done
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
     * original state.
     */

    TclFinalizeLoad();
    TclResetFilesystem();

    /*
     * At this point, there should no longer be any Tcl_Alloc'ed memory.
     */

    TclFinalizeMemorySubsystem();

  alreadyFinalized:
    TclFinalizeLock();
}







|







1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
     * original state.
     */

    TclFinalizeLoad();
    TclResetFilesystem();

    /*
     * At this point, there should no longer be any ckalloc'ed memory.
     */

    TclFinalizeMemorySubsystem();

  alreadyFinalized:
    TclFinalizeLock();
}
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
	     * 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);
	}
	TclFinalizeIOSubsystem();
	TclFinalizeNotifier();
	TclFinalizeAsync();
	TclFinalizeThreadObjects();
    }








|







1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
	     * 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);
	    ckfree(exitPtr);
	}
	TclFinalizeIOSubsystem();
	TclFinalizeNotifier();
	TclFinalizeAsync();
	TclFinalizeThreadObjects();
    }

1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
    int done, foundEvent;
    const char *nameString;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    nameString = TclGetString(objv[1]);
    if (Tcl_TraceVar2(interp, nameString, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done) != TCL_OK) {
	return TCL_ERROR;
    };
    done = 0;
    foundEvent = 1;







|







1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
    int done, foundEvent;
    const char *nameString;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    nameString = Tcl_GetString(objv[1]);
    if (Tcl_TraceVar2(interp, nameString, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done) != TCL_OK) {
	return TCL_ERROR;
    };
    done = 0;
    foundEvent = 1;
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;
    int flags = 0;		/* Initialized to avoid compiler warning. */
    static const char *const updateOptions[] = {"idletasks", NULL};
    enum updateOptions {OPT_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 updateOptions) optionIndex) {
	case OPT_IDLETASKS:
	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
	    break;
	default:
	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
	}
    } else {







|








|







1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    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};

    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:
	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
	    break;
	default:
	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
	}
    } else {
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
{
    ThreadClientData *cdPtr = (ThreadClientData *)clientData;
    void *threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    Tcl_Free(clientData);		/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);

    TCL_THREAD_CREATE_RETURN;
}
#endif








|







1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
{
    ThreadClientData *cdPtr = (ThreadClientData *)clientData;
    void *threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);

    TCL_THREAD_CREATE_RETURN;
}
#endif

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
 */

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 */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	Tcl_Free(cdPtr);
    }
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}








|




|






|







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

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() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	ckfree(cdPtr);
    }
    return result;
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}

Changes to generic/tclExecute.c.
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

/*
 * Mapping from expression instruction opcodes to strings; used for error
 * messages. Note that these entries must match the order and number of the
 * expression opcodes (e.g., INST_LOR) in tclCompile.h.
 *
 * Does not include the string for INST_EXPON (and beyond), as that is
 * disjoint for backward-compatibility reasons.
 */

static const char *const operatorStrings[] = {
    "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
    "+", "-", "*", "/", "%", "+", "-", "~", "!"
};

/*
 * Mapping from Tcl result codes to strings; used for error and debugging
 * messages.
 */







|



|







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

/*
 * Mapping from expression instruction opcodes to strings; used for error
 * messages. Note that these entries must match the order and number of the
 * expression opcodes (e.g., INST_LOR) in tclCompile.h.
 *
 * Does not include the string for INST_EXPON (and beyond), as that is
 * disjoint for backward-compatability reasons.
 */

static const char *const operatorStrings[] = {
    "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
    "+", "-", "*", "/", "%", "+", "-", "~", "!"
};

/*
 * Mapping from Tcl result codes to strings; used for error and debugging
 * messages.
 */
97
98
99
100
101
102
103
104
105


























































106
107
108
109
110
111
112
113
114
115
116
117
118
 */

#ifdef TCL_COMPILE_STATS
size_t		tclObjsAlloced = 0;
size_t		tclObjsFreed = 0;
size_t		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */

/*


























































 * NR_TEBC
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    ptrdiff_t *catchTop;	/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
    CmdFrame cmdFrame;		/* new codePtr was received for NR */
                                /* execution. */
    void *stack[1];		/* Start of the actual combined catch and obj







|

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





|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
 */

#ifdef TCL_COMPILE_STATS
size_t		tclObjsAlloced = 0;
size_t		tclObjsFreed = 0;
size_t		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */

/*
 * Support pre-8.5 bytecodes unless specifically requested otherwise.
 */

#ifndef TCL_SUPPORT_84_BYTECODE
#define TCL_SUPPORT_84_BYTECODE 1
#endif

#if TCL_SUPPORT_84_BYTECODE
/*
 * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
 * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
 */

typedef struct {
    const char *name;		/* Name of function. */
    int numArgs;		/* Number of arguments for function. */
} BuiltinFunc;

/*
 * Table describing the built-in math functions. Entries in this table are
 * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
 * operand byte.
 */

static BuiltinFunc const tclBuiltinFuncTable[] = {
    {"acos", 1},
    {"asin", 1},
    {"atan", 1},
    {"atan2", 2},
    {"ceil", 1},
    {"cos", 1},
    {"cosh", 1},
    {"exp", 1},
    {"floor", 1},
    {"fmod", 2},
    {"hypot", 2},
    {"log", 1},
    {"log10", 1},
    {"pow", 2},
    {"sin", 1},
    {"sinh", 1},
    {"sqrt", 1},
    {"tan", 1},
    {"tanh", 1},
    {"abs", 1},
    {"double", 1},
    {"int", 1},
    {"rand", 0},
    {"round", 1},
    {"srand", 1},
    {"wide", 1},
    {NULL, 0},
};

#define LAST_BUILTIN_FUNC	25
#endif

/*
 * NR_TEBC
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct TEBCdata {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    ptrdiff_t *catchTop;	/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
    CmdFrame cmdFrame;		/* new codePtr was received for NR */
                                /* execution. */
    void *stack[1];		/* Start of the actual combined catch and obj
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    ((TclHasIntRep((objPtr), &tclIntType))					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (void *)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    TclHasIntRep((objPtr), &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (void *)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))

/*
 * Macro used to make the check for type overflow more mnemonic. This works by







|





|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    ((TclHasIntRep((objPtr), &tclIntType))					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    TclHasIntRep((objPtr), &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
    TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))

/*
 * Macro used to make the check for type overflow more mnemonic. This works by
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
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, size_t *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, size_t numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, size_t numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;
static Tcl_NRPostProc   TEBCresume;

/*







|









|
|







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
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, int *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;
static Tcl_NRPostProc   TEBCresume;

/*
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    Tcl_Free(searchPtr);

    dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);
}

/*
 *----------------------------------------------------------------------







|







767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);

    dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);
}

/*
 *----------------------------------------------------------------------
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    size_t size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords)
	    + size * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);







|


|
|







847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
 *----------------------------------------------------------------------
 */

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    int size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)ckalloc(offsetof(ExecStack, stackWords)
	    + size * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867

    if (esPtr->prevPtr) {
	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
    }
    if (esPtr->nextPtr) {
	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
    }
    Tcl_Free(esPtr);
}

void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;







|







911
912
913
914
915
916
917
918
919
920
921
922
923
924
925

    if (esPtr->prevPtr) {
	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
    }
    if (esPtr->nextPtr) {
	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
    }
    ckfree(esPtr);
}

void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
    TclDecrRefCount(eePtr->constants[1]);
    if (eePtr->callbackPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
    }
    if (eePtr->corPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with existing coroutine");
    }
    Tcl_Free(eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecution --
 *







|







943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
    TclDecrRefCount(eePtr->constants[1]);
    if (eePtr->callbackPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
    }
    if (eePtr->corPtr && !cachedInExit) {
	Tcl_Panic("Deleting execEnv with existing coroutine");
    }
    ckfree(eePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecution --
 *
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
				 * stack to enlarge. */
    int growth,			/* How much larger than the current used
				 * size. */
    int move)			/* 1 if move words since last marker. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
    size_t newBytes;
    int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
    int moveWords = 0;

    if (move) {
	if (!markerPtr) {
	    Tcl_Panic("STACK: Reallocating with no previous alloc");
	}







|
|







1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
				 * stack to enlarge. */
    int growth,			/* How much larger than the current used
				 * size. */
    int move)			/* 1 if move words since last marker. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
    int newBytes, newElems, currElems;
    int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
    int moveWords = 0;

    if (move) {
	if (!markerPtr) {
	    Tcl_Panic("STACK: Reallocating with no previous alloc");
	}
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
#else
    newElems = needed;
#endif

    newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = (ExecStack *)Tcl_Alloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:







|







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
#else
    newElems = needed;
#endif

    newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = (ExecStack *)ckalloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:
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
 *
 *--------------------------------------------------------------
 */

static Tcl_Obj **
StackAllocWords(
    Tcl_Interp *interp,
    size_t numWords)
{
    /*
     * Note that GrowEvaluationStack sets a marker in the stack. This marker
     * is read when rewinding, e.g., by TclStackFree.
     */

    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

static Tcl_Obj **
StackReallocWords(
    Tcl_Interp *interp,
    size_t numWords)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

void
TclStackFree(
    Tcl_Interp *interp,
    void *freePtr)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	Tcl_Free(freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.







|

















|




















|







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

static Tcl_Obj **
StackAllocWords(
    Tcl_Interp *interp,
    int numWords)
{
    /*
     * Note that GrowEvaluationStack sets a marker in the stack. This marker
     * is read when rewinding, e.g., by TclStackFree.
     */

    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

static Tcl_Obj **
StackReallocWords(
    Tcl_Interp *interp,
    int numWords)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

void
TclStackFree(
    Tcl_Interp *interp,
    void *freePtr)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	ckfree(freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.
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
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    size_t numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) Tcl_Alloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    size_t numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    size_t numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Realloc(ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
    markerPtr = esPtr->markerPtr;

    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {







|


|


|


|






|





|


|







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
	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    int numBytes)
{
    Interp *iPtr = (Interp *) interp;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) ckalloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return (void *) StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    int numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    int numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) ckrealloc((char *) ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
    markerPtr = esPtr->markerPtr;

    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
 *--------------------------------------------------------------
 */

int
Tcl_ExprObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,		/* Points to Tcl object containing expression
				 * to evaluate. */
    Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
				 * result is stored if no errors occur. */
{
    NRE_callback *rootPtr = TOP_CB(interp);
    Tcl_Obj *resultPtr;








|







1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
 *--------------------------------------------------------------
 */

int
Tcl_ExprObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Points to Tcl object containing expression
				 * to evaluate. */
    Tcl_Obj **resultPtrPtr)	/* Where the Tcl_Obj* that is the expression
				 * result is stored if no errors occur. */
{
    NRE_callback *rootPtr = TOP_CB(interp);
    Tcl_Obj *resultPtr;

1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
    }

    if (codePtr == NULL) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

	size_t length;
	const char *string = TclGetStringFromObj(objPtr, &length);

	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
	TclCompileExpr(interp, string, length, &compEnv, 0);

	/*
	 * Successful compilation. If the expression yielded no instructions,
	 * push an zero object as the expression's result.
	 */

	if (compEnv.codeNext == compEnv.codeStart) {







<
|

|
|







1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
    }

    if (codePtr == NULL) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */


	const char *string = TclGetString(objPtr);

	TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
	TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);

	/*
	 * Successful compilation. If the expression yielded no instructions,
	 * push an zero object as the expression's result.
	 */

	if (compEnv.codeNext == compEnv.codeStart) {
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
    case INST_EXPAND_START:
	/*
	 * Push an element to the auxObjList. This records the current
	 * stack depth - i.e., the point in the stack where the expanded
	 * command starts.
	 *
	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
	 * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);







|







2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
    case INST_EXPAND_START:
	/*
	 * Push an element to the auxObjList. This records the current
	 * stack depth - i.e., the point in the stack where the expanded
	 * command starts.
	 *
	 * Use a Tcl_Obj as linked list element; slight mem waste, but faster
	 * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
2818
2819
2820
2821
2822
2823
2824





















































































2825
2826
2827
2828
2829
2830
2831

	DECACHE_STACK_INFO();

	pc += pcAdjustment;
	TEBC_YIELD();
	return TclNREvalObjv(interp, objc, objv,
		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);






















































































    case INST_INVOKE_REPLACE:
	objc = TclGetUInt4AtPtr(pc+1);
	opnd = TclGetUInt1AtPtr(pc+5);
	objPtr = POP_OBJECT();
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;







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







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

	DECACHE_STACK_INFO();

	pc += pcAdjustment;
	TEBC_YIELD();
	return TclNREvalObjv(interp, objc, objv,
		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);

#if TCL_SUPPORT_84_BYTECODE
    case INST_CALL_BUILTIN_FUNC1:
	/*
	 * Call one of the built-in pre-8.5 Tcl math functions. This
	 * translates to INST_INVOKE_STK1 with the first argument of
	 * ::tcl::mathfunc::$objv[0]. We need to insert the named math
	 * function into the stack.
	 */

	opnd = TclGetUInt1AtPtr(pc+1);
	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
	    Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
	}

	TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);

	/*
	 * Only 0, 1 or 2 args.
	 */

	{
	    int numArgs = tclBuiltinFuncTable[opnd].numArgs;
	    Tcl_Obj *tmpPtr1, *tmpPtr2;

	    if (numArgs == 0) {
		PUSH_OBJECT(objPtr);
	    } else if (numArgs == 1) {
		tmpPtr1 = POP_OBJECT();
		PUSH_OBJECT(objPtr);
		PUSH_OBJECT(tmpPtr1);
		Tcl_DecrRefCount(tmpPtr1);
	    } else {
		tmpPtr2 = POP_OBJECT();
		tmpPtr1 = POP_OBJECT();
		PUSH_OBJECT(objPtr);
		PUSH_OBJECT(tmpPtr1);
		PUSH_OBJECT(tmpPtr2);
		Tcl_DecrRefCount(tmpPtr1);
		Tcl_DecrRefCount(tmpPtr2);
	    }
	    objc = numArgs + 1;
	}
	pcAdjustment = 2;
	goto doInvocation;

    case INST_CALL_FUNC1:
	/*
	 * Call a non-builtin Tcl math function previously registered by a
	 * call to Tcl_CreateMathFunc pre-8.5. This is essentially
	 * INST_INVOKE_STK1 converting the first arg to
	 * ::tcl::mathfunc::$objv[0].
	 */

	objc = TclGetUInt1AtPtr(pc+1);	/* Number of arguments. The function
					 * name is the 0-th argument. */

	objPtr = OBJ_AT_DEPTH(objc-1);
	TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
	Tcl_AppendObjToObj(tmpPtr, objPtr);
	Tcl_DecrRefCount(objPtr);

	/*
	 * Variation of PUSH_OBJECT.
	 */

	OBJ_AT_DEPTH(objc-1) = tmpPtr;
	Tcl_IncrRefCount(tmpPtr);

	pcAdjustment = 2;
	goto doInvocation;
#else
    /*
     * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
     * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
     * remains for existing bytecode precompiled files.
     */

    case INST_CALL_BUILTIN_FUNC1:
	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
    case INST_CALL_FUNC1:
	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
#endif

    case INST_INVOKE_REPLACE:
	objc = TclGetUInt4AtPtr(pc+1);
	opnd = TclGetUInt1AtPtr(pc+5);
	objPtr = POP_OBJECT();
	objv = &OBJ_AT_DEPTH(objc-1);
	cleanup = objc;
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
			goto doneIncr;
		    }
		    w = (Tcl_WideInt)augend;

		    TRACE(("%u %ld => ", opnd, increment));
		    if (Tcl_IsShared(objPtr)) {
			objPtr->refCount--;	/* We know it's shared. */
			objResultPtr = Tcl_NewWideIntObj(w+increment);
			Tcl_IncrRefCount(objResultPtr);
			varPtr->value.objPtr = objResultPtr;
		    } else {
			objResultPtr = objPtr;

			/*
			 * We know the sum value is outside the long range;







|







3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
			goto doneIncr;
		    }
		    w = (Tcl_WideInt)augend;

		    TRACE(("%u %ld => ", opnd, increment));
		    if (Tcl_IsShared(objPtr)) {
			objPtr->refCount--;	/* We know it's shared. */
			TclNewIntObj(objResultPtr, w + increment);
			Tcl_IncrRefCount(objResultPtr);
			varPtr->value.objPtr = objResultPtr;
		    } else {
			objResultPtr = objPtr;

			/*
			 * We know the sum value is outside the long range;
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	arrayPtr = NULL;
	part1Ptr = part2Ptr = NULL;
	cleanup = 0;
	TRACE(("%u %s => ", opnd, TclGetString(incrPtr)));

    doIncrVar:
	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
	    objPtr = varPtr->value.objPtr;
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);







|







3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	arrayPtr = NULL;
	part1Ptr = part2Ptr = NULL;
	cleanup = 0;
	TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));

    doIncrVar:
	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
	    objPtr = varPtr->value.objPtr;
	    if (Tcl_IsShared(objPtr)) {
		objPtr->refCount--;	/* We know it's shared */
		objResultPtr = Tcl_DuplicateObj(objPtr);
3906
3907
3908
3909
3910
3911
3912























3913
3914
3915
3916
3917
3918
3919
	TRACE_APPEND(("OK\n"));
	NEXT_INST_V(2, cleanup, 0);

    errorInUnset:
	CACHE_STACK_INFO();
	TRACE_ERROR(interp);
	goto gotError;























    }
    break;

    /*
     *	   End of INST_UNSET instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_ARRAY instructions.







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







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
	TRACE_APPEND(("OK\n"));
	NEXT_INST_V(2, cleanup, 0);

    errorInUnset:
	CACHE_STACK_INFO();
	TRACE_ERROR(interp);
	goto gotError;

	/*
	 * This is really an unset operation these days. Do not issue.
	 */

    case INST_DICT_DONE:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => OK\n", opnd));
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    if (!TclIsVarUndefined(varPtr)) {
		TclDecrRefCount(varPtr->value.objPtr);
	    }
	    varPtr->value.objPtr = NULL;
	} else {
	    DECACHE_STACK_INFO();
	    TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd);
	    CACHE_STACK_INFO();
	}
	NEXT_INST_F(5, 0, 0);
    }
    break;

    /*
     *	   End of INST_UNSET instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_ARRAY instructions.
4228
4229
4230
4231
4232
4233
4234













































4235
4236
4237
4238
4239
4240
4241
	} else {
	    TRACE_APPEND(("not found in table\n"));
	    NEXT_INST_F(5, 1, 0);
	}
    }
    break;














































    /*
     * -----------------------------------------------------------------
     *	   Start of general introspector instructions.
     */

    case INST_NS_CURRENT: {
	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);







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







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
	} else {
	    TRACE_APPEND(("not found in table\n"));
	    NEXT_INST_F(5, 1, 0);
	}
    }
    break;

    /*
     * These two instructions are now redundant: the complete logic of the LOR
     * and LAND is now handled by the expression compiler.
     */

    case INST_LOR:
    case INST_LAND: {
	/*
	 * Operands must be boolean or numeric. No int->double conversions are
	 * performed.
	 */

	int i1, i2, iResult;

	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

	if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    CACHE_STACK_INFO();
	    goto gotError;
	}

	if (*pc == INST_LOR) {
	    iResult = (i1 || i2);
	} else {
	    iResult = (i1 && i2);
	}
	objResultPtr = TCONST(iResult);
	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
	NEXT_INST_F(1, 2, 1);
    }
    break;

    /*
     * -----------------------------------------------------------------
     *	   Start of general introspector instructions.
     */

    case INST_NS_CURRENT: {
	Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
    /*
     *     End of TclOO support instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int numIndices, nocase, match, cflags;
	size_t slength, length2, fromIdx, toIdx, index, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
	 */







|
|







4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
    /*
     *     End of TclOO support instructions.
     * -----------------------------------------------------------------
     *	   Start of INST_LIST and related instructions.
     */

    {
	int index, numIndices, fromIdx, toIdx;
	int nocase, match, length2, cflags, s1len, s2len;
	const char *s1, *s2;

    case INST_LIST:
	/*
	 * Pop the opnd (objc) top stack elements into a new list obj and then
	 * decrement their ref counts.
	 */
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718

	/* Decode end-offset index values. */

	index = TclIndexDecode(opnd, objc - 1);
	pcAdjustment = 5;

    lindexFastPath:
	if (index < (size_t)objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(pcAdjustment, 1, 1);







|







4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928

	/* Decode end-offset index values. */

	index = TclIndexDecode(opnd, objc - 1);
	pcAdjustment = 5;

    lindexFastPath:
	if (index >= 0 && index < objc) {
	    objResultPtr = objv[index];
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(pcAdjustment, 1, 1);
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
	if (toIdx == TCL_INDEX_NONE) {
	emptyList:
	    TclNewObj(objResultPtr);
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyList;
	} else if (toIdx + 1 >= (size_t)objc + 1) {
	    toIdx = objc - 1;
	}

	assert (toIdx < (size_t)objc);
	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;







|

|



|







5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
	if (toIdx == TCL_INDEX_NONE) {
	emptyList:
	    TclNewObj(objResultPtr);
	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
	    NEXT_INST_F(9, 1, 1);
	}
	toIdx = TclIndexDecode(toIdx, objc - 1);
	if (toIdx < 0) {
	    goto emptyList;
	} else if (toIdx >= objc) {
	    toIdx = objc - 1;
	}

	assert ( toIdx >= 0 && toIdx < objc);
	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
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

	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	slength = Tcl_GetCharLength(valuePtr);
	TclNewIntObj(objResultPtr, slength);
	TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToUpper(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToUpper(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_LOWER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToLower(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToLower(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_TITLE:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &slength);
	    TclNewStringObj(objResultPtr, s1, slength);
	    slength = Tcl_UtfToTitle(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, slength);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    slength = Tcl_UtfToTitle(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, slength);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calulate what 'end' means.
	 */

	slength = Tcl_GetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if (index >= slength) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && slength == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {
		TclNewObj(objResultPtr);
	    } else {
		slength = Tcl_UniCharToUtf(ch, buf);
		if ((ch >= 0xD800) && (slength < 3)) {
		    slength += Tcl_UniCharToUtf(-1, buf + slength);
		}
		objResultPtr = Tcl_NewStringObj(buf, slength);
	    }
	}

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
	slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;

	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength,
		    &fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (TclGetIntForIndexM(interp, OBJ_AT_TOS, slength,
		    &toIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}
	if (toIdx + 1 >= slength + 1) {
	    toIdx = slength;
	}
	if (toIdx + 1 >= fromIdx + 1) {
	    objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
	} else {
	    TclNewObj(objResultPtr);
	}
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(1, 3, 1);

    case INST_STR_RANGE_IMM:
	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);
	slength = Tcl_GetCharLength(valuePtr);
	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), (int)(fromIdx), (int)(toIdx)));

	/* Every range of an empty value is an empty value */
	if (slength == 0) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}

	/* Decode index operands. */

	/*
	assert ( toIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyRange;
	}

	toIdx = TclIndexDecode(toIdx, slength - 1);
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyRange;
	} else if (toIdx >= slength) {
	    toIdx = slength - 1;
	}

	assert ( toIdx != TCL_INDEX_NONE && toIdx < slength );

	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, slength - 1);
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	if (fromIdx + 1 <= toIdx + 1) {
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	} else {
	emptyRange:
	    TclNewObj(objResultPtr);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	size_t length3;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	slength = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength,
		    &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength,
		    &toIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TclDecrRefCount(value3Ptr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();

	if ((toIdx == TCL_INDEX_NONE) ||
		(fromIdx + 1 > slength + 1) ||
		(toIdx + 1 < fromIdx + 1)) {
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    TclDecrRefCount(value3Ptr);
	    NEXT_INST_F(1, 0, 0);
	}

	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	if (toIdx + 1 > slength + 1) {
	    toIdx = slength;
	}

	if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,







|
|
|






|
|
|
|



|
|








|
|
|
|



|
|








|
|
|
|



|
|














|

|






|




|














|
|
|

|









|


|





|







|
|

|
|

|











|
|


|















|
|

|
|


|










|
|
|


|










|





|



|

|












|
|
|





|
|


|
|


|







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

	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;
	length = Tcl_GetCharLength(valuePtr);
	TclNewIntObj(objResultPtr, length);
	TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &length);
	    TclNewStringObj(objResultPtr, s1, length);
	    length = Tcl_UtfToUpper(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, length);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    length = Tcl_UtfToUpper(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, length);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_LOWER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &length);
	    TclNewStringObj(objResultPtr, s1, length);
	    length = Tcl_UtfToLower(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, length);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    length = Tcl_UtfToLower(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, length);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
    case INST_STR_TITLE:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));
	if (Tcl_IsShared(valuePtr)) {
	    s1 = TclGetStringFromObj(valuePtr, &length);
	    TclNewStringObj(objResultPtr, s1, length);
	    length = Tcl_UtfToTitle(TclGetString(objResultPtr));
	    Tcl_SetObjLength(objResultPtr, length);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	} else {
	    length = Tcl_UtfToTitle(TclGetString(valuePtr));
	    Tcl_SetObjLength(valuePtr, length);
	    TclFreeIntRep(valuePtr);
	    TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Get char length to calulate what 'end' means.
	 */

	length = Tcl_GetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {
		TclNewObj(objResultPtr);
	    } else {
		length = Tcl_UniCharToUtf(ch, buf);
		if ((ch >= 0xD800) && (length < 3)) {
		    length += Tcl_UniCharToUtf(-1, buf + length);
		}
		objResultPtr = Tcl_NewStringObj(buf, length);
	    }
	}

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
	length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;

	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
		    &fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
		    &toIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if (fromIdx < 0) {
	    fromIdx = 0;
	}
	if (toIdx >= length) {
	    toIdx = length;
	}
	if (toIdx >= fromIdx) {
	    objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
	} else {
	    TclNewObj(objResultPtr);
	}
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(1, 3, 1);

    case INST_STR_RANGE_IMM:
	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);
	length = Tcl_GetCharLength(valuePtr);
	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));

	/* Every range of an empty value is an empty value */
	if (length == 0) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}

	/* Decode index operands. */

	/*
	assert ( toIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (toIdx == TCL_INDEX_NONE) {
	    goto emptyRange;
	}

	toIdx = TclIndexDecode(toIdx, length - 1);
	if (toIdx < 0) {
	    goto emptyRange;
	} else if (toIdx >= length) {
	    toIdx = length - 1;
	}

	assert ( toIdx >= 0 && toIdx < length );

	/*
	assert ( fromIdx != TCL_INDEX_NONE );
	 *
	 * Extra safety for legacy bytecodes:
	 */
	if (fromIdx == TCL_INDEX_NONE) {
	    fromIdx = TCL_INDEX_START;
	}

	fromIdx = TclIndexDecode(fromIdx, length - 1);
	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (fromIdx <= toIdx) {
	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
	} else {
	emptyRange:
	    TclNewObj(objResultPtr);
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	int length3, endIdx;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	endIdx = Tcl_GetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
		    &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
		    &toIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TclDecrRefCount(value3Ptr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();
	TclDecrRefCount(OBJ_AT_TOS);
	(void) POP_OBJECT();

	if ((toIdx < 0) ||
		(fromIdx > endIdx) ||
		(toIdx < fromIdx)) {
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    TclDecrRefCount(value3Ptr);
	    NEXT_INST_F(1, 0, 0);
	}

	if (fromIdx < 0) {
	    fromIdx = 0;
	}

	if (toIdx > endIdx) {
	    toIdx = endIdx;
	}

	if (fromIdx == 0 && toIdx == endIdx) {
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
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
	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    goto doneStringMap;
	}
	ustring1 = TclGetUnicodeFromObj(valuePtr, &slength);
	if (slength == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2);
	if (length2 > slength || length2 == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (length2 == slength) {
	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) {
		objResultPtr = valuePtr;
	    } else {
		objResultPtr = value3Ptr;
	    }
	    goto doneStringMap;
	}
	ustring3 = TclGetUnicodeFromObj(value3Ptr, &length3);

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + slength;
	for (; ustring1 < end; ustring1++) {
	    if ((*ustring1 == *ustring2) && (length2==1 ||
		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
			    == 0)) {
		if (p != ustring1) {
		    TclAppendUnicodeToObj(objResultPtr, p, ustring1-p);
		    p = ustring1 + length2;
		} else {
		    p += length2;
		}
		ustring1 = p - 1;

		TclAppendUnicodeToObj(objResultPtr, ustring3, length3);
	    }
	}
	if (p != ustring1) {
	    /*
	     * Put the rest of the unmapped chars onto result.
	     */

	    TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p);
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:







|
|



|
|


|
|






|



|





|






|







|







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
	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    goto doneStringMap;
	}
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	if (length == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	if (length2 > length || length2 == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (length2 == length) {
	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
		objResultPtr = valuePtr;
	    } else {
		objResultPtr = value3Ptr;
	    }
	    goto doneStringMap;
	}
	ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);

	objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + length;
	for (; ustring1 < end; ustring1++) {
	    if ((*ustring1 == *ustring2) && (length2==1 ||
		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
			    == 0)) {
		if (p != ustring1) {
		    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
		    p = ustring1 + length2;
		} else {
		    p += length2;
		}
		ustring1 = p - 1;

		Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
	    }
	}
	if (p != ustring1) {
	    /*
	     * Put the rest of the unmapped chars onto result.
	     */

	    Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
		O2S(valuePtr)));
	ustring1 = TclGetUnicodeFromObj(valuePtr, &slength);
	match = 1;
	if (slength > 0) {
	    int ch;
	    end = ustring1 + slength;
	    for (p=ustring1 ; p<end ; ) {
		p += TclUniCharToUCS4(p, &ch);
		if (!tclStringClassTable[opnd].comparator(ch)) {
		    match = 0;
		    break;
		}
	    }







|

|

|







5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
		O2S(valuePtr)));
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	match = 1;
	if (length > 0) {
	    int ch;
	    end = ustring1 + length;
	    for (p=ustring1 ; p<end ; ) {
		p += TclUniCharToUCS4(p, &ch);
		if (!tclStringClassTable[opnd].comparator(ch)) {
		    match = 0;
		    break;
		}
	    }
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
	 * both.
	 */

	if (TclHasIntRep(valuePtr, &tclStringType)
		|| TclHasIntRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = TclGetUnicodeFromObj(valuePtr, &slength);
	    ustring2 = TclGetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, slength, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;
	    size_t wlen1 = 0, wlen2 = 0;

	    bytes1 = TclGetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = TclGetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*
	 * Reuse value2Ptr object already on stack if possible. Adjustment is
	 * 2 due to the nocase byte
	 */

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	size_t trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	trim1 = TclTrimLeft(string1, slength, string2, length2);
	trim2 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM_RIGHT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	trim2 = TclTrimRight(string1, slength, string2, length2);
	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &slength);
	trim1 = TclTrim(string1, slength, string2, length2, &trim2);
    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */

#ifdef TCL_COMPILE_DEBUG







|
|
|



<

|
|
|




















|





|
|






|
|






|
|







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

	if (TclHasIntRep(valuePtr, &tclStringType)
		|| TclHasIntRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;


	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
	    match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

	/*
	 * Reuse value2Ptr object already on stack if possible. Adjustment is
	 * 2 due to the nocase byte
	 */

	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));

	/*
	 * Peep-hole optimisation: if you're about to jump, do jump from here.
	 */

	JUMP_PEEPHOLE_F(match, 2, 2);

    {
	const char *string1, *string2;
	int trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrimLeft(string1, length, string2, length2);
	trim2 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM_RIGHT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim2 = TclTrimRight(string1, length, string2, length2);
	trim1 = 0;
	goto createTrimmedString;
    case INST_STR_TRIM:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = TclGetStringFromObj(value2Ptr, &length2);
	string1 = TclGetStringFromObj(valuePtr, &length);
	trim1 = TclTrim(string1, length, string2, length2, &trim2);
    createTrimmedString:
	/*
	 * Careful here; trim set often contains non-ASCII characters so we
	 * take care when printing. [Bug 971cb4f1db]
	 */

#ifdef TCL_COMPILE_DEBUG
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
	    if (traceInstructions) {
		TclPrintObject(stdout, valuePtr, 30);
		printf("\n");
	    }
#endif
	    NEXT_INST_F(1, 1, 0);
	} else {
	    objResultPtr = Tcl_NewStringObj(string1+trim1, slength-trim1-trim2);
#ifdef TCL_COMPILE_DEBUG
	    if (traceInstructions) {
		TclPrintObject(stdout, objResultPtr, 30);
		printf("\n");
	    }
#endif
	    NEXT_INST_F(1, 2, 1);







|







5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
	    if (traceInstructions) {
		TclPrintObject(stdout, valuePtr, 30);
		printf("\n");
	    }
#endif
	    NEXT_INST_F(1, 1, 0);
	} else {
	    objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
#ifdef TCL_COMPILE_DEBUG
	    if (traceInstructions) {
		TclPrintObject(stdout, objResultPtr, 30);
		printf("\n");
	    }
#endif
	    NEXT_INST_F(1, 2, 1);
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957

		if (Overflowing(w1, ~w2, wResult)) {
		    goto overflow;
		}
	    wideResultOfArithmetic:
		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    objResultPtr = Tcl_NewWideIntObj(wResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		TclSetIntObj(valuePtr, wResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);
	    break;







|







6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166

		if (Overflowing(w1, ~w2, wResult)) {
		    goto overflow;
		}
	    wideResultOfArithmetic:
		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		if (Tcl_IsShared(valuePtr)) {
		    TclNewIntObj(objResultPtr, wResult);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		}
		TclSetIntObj(valuePtr, wResult);
		TRACE(("%s\n", O2S(valuePtr)));
		NEXT_INST_F(1, 1, 0);
	    break;
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (TclHasIntRep(valuePtr,  &tclBooleanType)) {
	    objResultPtr = TCONST(1);
	} else {
	    int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(result);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    break;

    case INST_BREAK:
	/*







|
|







6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (TclHasIntRep(valuePtr,  &tclBooleanType)) {
	    objResultPtr = TCONST(1);
	} else {
	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(res);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);
    break;

    case INST_BREAK:
	/*
6245
6246
6247
6248
6249
6250
6251




































































































































































6252
6253
6254
6255
6256
6257
6258
6259
	result = TCL_CONTINUE;
	cleanup = 0;
	TRACE(("=> CONTINUE!\n"));
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;




































































































































































	Tcl_Obj *listPtr, **elements, *tmpPtr;
	ForeachVarList *varListPtr;
	int numLists, listLen, numVars;
	int listTmpDepth;
	size_t iterNum, iterMax, iterTmp;
	int varIndex, valIndex, j;
	long i;








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







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
	result = TCL_CONTINUE;
	cleanup = 0;
	TRACE(("=> CONTINUE!\n"));
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;
	Var *iterVarPtr, *listVarPtr;
	Tcl_Obj *oldValuePtr, *listPtr, **elements;
	ForeachVarList *varListPtr;
	int numLists, listTmpIndex, listLen, numVars;
	size_t iterNum;
	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
	long i;

    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {
	    TclNewIntObj(iterVarPtr->value.objPtr, -1);
	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
	} else {
	    TclSetIntObj(oldValuePtr, -1);
	}
	TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));

#ifndef TCL_COMPILE_DEBUG
	/*
	 * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
	 * after INST_FOREACH_START4 - let us just fall through instead of
	 * jumping back to the top.
	 */

	pc += 5;
	TCL_DTRACE_INST_NEXT();
#else
	NEXT_INST_F(5, 0, 0);
#endif

    case INST_FOREACH_STEP4: /* DEPRECATED */
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;

	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
	valuePtr = iterVarPtr->value.objPtr;
	iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
	TclSetIntObj(valuePtr, iterNum);

	/*
	 * Check whether all value lists are exhausted and we should stop the
	 * loop.
	 */

	continueLoop = 0;
	listTmpIndex = infoPtr->firstValueTemp;
	for (i = 0;  i < numLists;  i++) {
	    varListPtr = infoPtr->varLists[i];
	    numVars = varListPtr->numVars;

	    listVarPtr = LOCAL(listTmpIndex);
	    listPtr = listVarPtr->value.objPtr;
	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
		TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    if ((size_t)listLen > iterNum * numVars) {
		continueLoop = 1;
	    }
	    listTmpIndex++;
	}

	/*
	 * If some var in some var list still has a remaining list element
	 * iterate one more time. Assign to var the next element from its
	 * value list. We already checked above that each list temp holds a
	 * valid list object (by calling Tcl_ListObjLength), but cannot rely
	 * on that check remaining valid: one list could have been shimmered
	 * as a side effect of setting a traced variable.
	 */

	if (continueLoop) {
	    listTmpIndex = infoPtr->firstValueTemp;
	    for (i = 0;  i < numLists;  i++) {
		varListPtr = infoPtr->varLists[i];
		numVars = varListPtr->numVars;

		listVarPtr = LOCAL(listTmpIndex);
		listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
		TclListObjGetElements(interp, listPtr, &listLen, &elements);

		valIndex = (iterNum * numVars);
		for (j = 0;  j < numVars;  j++) {
		    if (valIndex >= listLen) {
			TclNewObj(valuePtr);
		    } else {
			valuePtr = elements[valIndex];
		    }

		    varIndex = varListPtr->varIndexes[j];
		    varPtr = LOCAL(varIndex);
		    while (TclIsVarLink(varPtr)) {
			varPtr = varPtr->value.linkPtr;
		    }
		    if (TclIsVarDirectWritable(varPtr)) {
			value2Ptr = varPtr->value.objPtr;
			if (valuePtr != value2Ptr) {
			    if (value2Ptr != NULL) {
				TclDecrRefCount(value2Ptr);
			    }
			    varPtr->value.objPtr = valuePtr;
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_APPEND((
				    "ERROR init. index temp %d: %s\n",
				    varIndex, O2S(Tcl_GetObjResult(interp))));
			    TclDecrRefCount(listPtr);
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}
	TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n",
		numLists, iterNum, (continueLoop? "continue" : "exit")));

	/*
	 * Run-time peep-hole optimisation: the compiler ALWAYS follows
	 * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
	 * instruction and jump direct from here.
	 */

	pc += 5;
	if (*pc == INST_JUMP_FALSE1) {
	    NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
	} else {
	    NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
	}

    }
    {
	ForeachInfo *infoPtr;
	Tcl_Obj *listPtr, **elements;
	ForeachVarList *varListPtr;
	int numLists, listLen, numVars;
	int listTmpDepth;
	size_t iterNum, iterMax, iterTmp;
	int varIndex, valIndex, j;
	long i;

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
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = (Tcl_DictSearch *)Tcl_Alloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
	     */

	    Tcl_DecrRefCount(dictPtr);
	    Tcl_Free(searchPtr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	{
	    Tcl_ObjIntRep ir;
	    TclNewObj(statePtr);
	    ir.twoPtrValue.ptr1 = searchPtr;







|










|







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
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
	     */

	    Tcl_DecrRefCount(dictPtr);
	    ckfree(searchPtr);
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	{
	    Tcl_ObjIntRep ir;
	    TclNewObj(statePtr);
	    ir.twoPtrValue.ptr1 = searchPtr;
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if ((size_t)length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);







|







7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
	}
	Tcl_IncrRefCount(dictPtr);
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		TRACE_ERROR(interp);
		Tcl_DecrRefCount(dictPtr);
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
	    case 3:		/* seconds */
		Tcl_GetTime(&now);
		wval = (Tcl_WideInt) now.sec;
		break;
	    default:
		Tcl_Panic("clockRead instruction with unknown clock#");
	    }
	    objResultPtr = Tcl_NewWideIntObj(wval);
	    TRACE_WITH_OBJ(("=> "), objResultPtr);
	    NEXT_INST_F(2, 0, 1);
	}
	break;

    default:
	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);







|







7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
	    case 3:		/* seconds */
		Tcl_GetTime(&now);
		wval = (Tcl_WideInt) now.sec;
		break;
	    default:
		Tcl_Panic("clockRead instruction with unknown clock#");
	    }
	    TclNewIntObj(objResultPtr, wval);
	    TRACE_WITH_OBJ(("=> "), objResultPtr);
	    NEXT_INST_F(2, 0, 1);
	}
	break;

    default:
	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;
	    size_t xxx1length;

	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? xxx1length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.







<

|


|







7714
7715
7716
7717
7718
7719
7720

7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732

    checkForCatch:
	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;


	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
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

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;
	    size_t xxx1length;

	    xxx1length = 0;

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }

	    /*
	     * We used to switch to direct eval; for NRE-awareness we now
	     * compile and eval the command so that this evaluation does not
	     * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07]
	     *
	     * TODO: recompile, search this command and eval a code starting from,
	     * so that this evaluation does not add a new TEBC instance without
	     * NRE-trampoline.
	     */

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    assert(bytes);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length));
	    goto instEvalStk;
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr







<

|
















|



|







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

     * case INST_START_CMD:
     */

	instStartCmdFailed:
	{
	    const char *bytes;


	    length = 0;

	    if (TclInterpReady(interp) == TCL_ERROR) {
		goto gotError;
	    }

	    /*
	     * We used to switch to direct eval; for NRE-awareness we now
	     * compile and eval the command so that this evaluation does not
	     * add a new TEBC instance. Bug [2910748], bug [fa6bf38d07]
	     *
	     * TODO: recompile, search this command and eval a code starting from,
	     * so that this evaluation does not add a new TEBC instance without
	     * NRE-trampoline.
	     */

	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
	    opnd = TclGetUInt4AtPtr(pc+1);
	    pc += (opnd-1);
	    assert(bytes);
	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
	    goto instEvalStk;
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr
8701
8702
8703
8704
8705
8706
8707
8708
8709
8710

8711
8712
8713
8714
8715
8716
8717
PrintByteCodeInfo(
    ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
	    iPtr->compileEpoch);

    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 60);

    fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    codePtr->numCommands, codePtr->numSrcBytes,
	    codePtr->numCodeBytes, codePtr->numLitObjects,
	    codePtr->numAuxDataItems, codePtr->maxStackDepth,







|
|

>







9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
9082
9083
9084
9085
9086
9087
9088
9089
PrintByteCodeInfo(
    ByteCode *codePtr)	/* The bytecode whose summary is printed to
				 * stdout. */
{
    Proc *procPtr = codePtr->procPtr;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;

    fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
	    codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
	    iPtr->compileEpoch);

    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 60);

    fprintf(stdout, "\n  Cmds %d, src %d, inst %u, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    codePtr->numCommands, codePtr->numSrcBytes,
	    codePtr->numCodeBytes, codePtr->numLitObjects,
	    codePtr->numAuxDataItems, codePtr->maxStackDepth,
8729
8730
8731
8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
	    (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 (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		procPtr->numCompiledLocals);
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*







|







9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
	    (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 (procPtr != NULL) {
	fprintf(stdout,
		"  Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		procPtr->numCompiledLocals);
    }
}
#endif /* TCL_COMPILE_DEBUG */

/*
8781
8782
8783
8784
8785
8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
    unsigned char opCode = *pc;

    if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) {
	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
		pc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
    }
    if ((unsigned) opCode >= LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		(unsigned) opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
	size_t numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;








|






|







9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
9164
9165
9166
9167
9168
9169
9170
9171
9172
9173
9174
    unsigned char opCode = *pc;

    if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) {
	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
		pc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
    }
    if ((unsigned) opCode > LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		(unsigned) opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
	int numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

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
    int type;
    const unsigned char opcode = *pc;
    const char *description, *op = "unknown";

    if (opcode == INST_EXPON) {
	op = "**";
    } else if (opcode <= INST_LNOT) {
	op = operatorStrings[opcode - INST_BITOR];
    }

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {








	description = "non-numeric string";

    } else if (type == TCL_NUMBER_NAN) {
	description = "non-numeric floating-point value";
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "can't use %s \"%s\" as operand of \"%s\"", description,
	    TclGetString(opndPtr), op));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --







|



>
>
>
>
>
>
>
>
|
>










|
<







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
    int type;
    const unsigned char opcode = *pc;
    const char *description, *op = "unknown";

    if (opcode == INST_EXPON) {
	op = "**";
    } else if (opcode <= INST_LNOT) {
	op = operatorStrings[opcode - INST_LOR];
    }

    if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
	int numBytes;
	const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);

	if (numBytes == 0) {
	    description = "empty string";
	} else if (TclCheckBadOctal(NULL, bytes)) {
	    description = "invalid octal number";
	} else {
	    description = "non-numeric string";
	}
    } else if (type == TCL_NUMBER_NAN) {
	description = "non-numeric floating-point value";
    } else if (type == TCL_NUMBER_DOUBLE) {
	description = "floating-point value";
    } else {
	/* TODO: No caller needs this. Eliminate? */
	description = "(big) integer";
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "can't use %s as operand of \"%s\"", description, op));

    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSourceFromFrame --
8937
8938
8939
8940
8941
8942
8943
8944
8945
8946
8947
8948
8949
8950
8951
8952
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	size_t srcOffset;
	int i;
	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}







|
<







9317
9318
9319
9320
9321
9322
9323
9324

9325
9326
9327
9328
9329
9330
9331
	/*
	 * We now have the command. We can get the srcOffset back and from
	 * there find the list of word locations for this command.
	 */

	ExtCmdLoc *eclPtr;
	ECL *locPtr = NULL;
	int srcOffset, i;

	Interp *iPtr = (Interp *) *codePtr->interpHandle;
	Tcl_HashEntry *hePtr =
		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}
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
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    size_t *lengthPtr,		/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    size_t pcOffset = (size_t)(pc - codePtr->codeStart);
    size_t numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert (pcOffset < (size_t)codePtr->numCodeBytes);

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */








|









|
|


|






|







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
GetSrcInfoForPc(
    const unsigned char *pc,	/* The program counter value for which to
				 * return the closest command's source info.
				 * This points within a bytecode instruction
				 * in codePtr's code. */
    ByteCode *codePtr,		/* The bytecode sequence in which to look up
				 * the command source for the pc. */
    int *lengthPtr,		/* If non-NULL, the location where the length
				 * of the command's source should be stored.
				 * If NULL, no length is stored. */
    const unsigned char **pcBeg,/* If non-NULL, the bytecode location
				 * where the current instruction starts.
				 * If NULL; no pointer is stored. */
    int *cmdIdxPtr)		/* If non-NULL, the location where the index
				 * of the command containing the pc should
				 * be stored. */
{
    int pcOffset = (pc - codePtr->codeStart);
    int numCmds = codePtr->numCommands;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

9148
9149
9150
9151
9152
9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    ExceptionRange *rangePtr;
    size_t pcOffset = pc - codePtr->codeStart;
    size_t start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always







|
|







9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542
				 * point or a catch range. */
    ByteCode *codePtr)		/* Points to the ByteCode in which to search
				 * for the enclosing ExceptionRange. */
{
    ExceptionRange *rangeArrayPtr;
    int numRanges = codePtr->numExceptRanges;
    ExceptionRange *rangePtr;
    int pcOffset = pc - codePtr->codeStart;
    int start;

    if (numRanges == 0) {
	return NULL;
    }

    /*
     * This exploits peculiarities of our compiler: nested ranges are always
9327
9328
9329
9330
9331
9332
9333
9334
9335

9336
9337
9338
9339
9340
9341
9342
    ByteCodeStats *statsPtr = &iPtr->stats;
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;

    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

#define Percent(a,b) ((a) * 100.0 / (b))

    TclNewObj(objPtr);







|

>







9706
9707
9708
9709
9710
9711
9712
9713
9714
9715
9716
9717
9718
9719
9720
9721
9722
    ByteCodeStats *statsPtr = &iPtr->stats;
    double totalCodeBytes, currentCodeBytes;
    double totalLiteralBytes, currentLiteralBytes;
    double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved;
    double strBytesSharedMultX, strBytesSharedOnce;
    double numInstructions, currentHeaderBytes;
    size_t numCurrentByteCodes, numByteCodeLits;
    size_t refCountSum, literalMgmtBytes, sum;
    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
    int decadeHigh, length;
    char *litTableStats;
    LiteralEntry *entryPtr;
    Tcl_Obj *objPtr;

#define Percent(a,b) ((a) * 100.0 / (b))

    TclNewObj(objPtr);
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385

    /*
     * Summary statistics, total and current source and ByteCode sizes.
     */

    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
    Tcl_AppendPrintfToObj(objPtr,
	    "Compilation and execution statistics for interpreter %p\n",
	    iPtr);

    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numExecutions);
    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
	    statsPtr->numExecutions / (float)statsPtr->numCompilations);







|
|







9750
9751
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765

    /*
     * Summary statistics, total and current source and ByteCode sizes.
     */

    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
    Tcl_AppendPrintfToObj(objPtr,
	    "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n",
	    (size_t)iPtr);

    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numExecutions);
    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numCompilations);
    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
	    statsPtr->numExecutions / (float)statsPtr->numCompilations);
9418
9419
9420
9421
9422
9423
9424
9425
9426
9427
9428
9429
9430
9431
9432
9433
9434
9435
9436
	    statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    currentCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->currentByteCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
	    currentLiteralBytes);
    Tcl_AppendPrintfToObj(objPtr, "      table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n",
	    sizeof(LiteralTable),
	    iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
	    iPtr->literalTable.numEntries * sizeof(LiteralEntry),
	    iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
	    statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
	    currentCodeBytes / statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
	    (currentCodeBytes + statsPtr->currentSrcBytes),
	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);








|
|
|
|
|







9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808
9809
9810
9811
9812
9813
9814
9815
9816
	    statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
	    currentCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
	    statsPtr->currentByteCodeBytes);
    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
	    currentLiteralBytes);
    Tcl_AppendPrintfToObj(objPtr, "      table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
	    (unsigned long) sizeof(LiteralTable),
	    (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
	    (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
	    statsPtr->currentLitStringBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
	    currentCodeBytes / statsPtr->currentSrcBytes);
    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
	    (currentCodeBytes + statsPtr->currentSrcBytes),
	    (currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);

9493
9494
9495
9496
9497
9498
9499
9500
9501
9502
9503
9504
9505
9506
9507
    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);







|







9873
9874
9875
9876
9877
9878
9879
9880
9881
9882
9883
9884
9885
9886
9887
    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);
9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
9604
9605
9606
	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);

    /*
     * Source and ByteCode size distributions.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");







|






|







9965
9966
9967
9968
9969
9970
9971
9972
9973
9974
9975
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    ckfree(litTableStats);

    /*
     * Source and ByteCode size distributions.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {







|







9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009
10010
10011
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {







|







10020
10021
10022
10023
10024
10025
10026
10027
10028
10029
10030
10031
10032
10033
10034
	    break;
	}
    }
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
9672
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683
9684
9685
9686
9687
9688
9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
    }

    /*
     * Instruction counts.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
    for (i = 0;  i < LAST_INST_OPCODE;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ",
		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
	if (statsPtr->instructionCount[i]) {
	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
		    Percent(statsPtr->instructionCount[i], numInstructions));
	} else {
	    Tcl_AppendPrintfToObj(objPtr, "0\n");
	}
    }

#ifdef TCL_MEM_DEBUG
    Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
    TclDumpMemoryInfo(objPtr, 1);
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;







|












|







10052
10053
10054
10055
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
10071
10072
10073
10074
10075
10076
10077
10078
10079
    }

    /*
     * Instruction counts.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
    for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
	Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ",
		tclInstructionTable[i].name, statsPtr->instructionCount[i]);
	if (statsPtr->instructionCount[i]) {
	    Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n",
		    Percent(statsPtr->instructionCount[i], numInstructions));
	} else {
	    Tcl_AppendPrintfToObj(objPtr, "0\n");
	}
    }

#ifdef TCL_MEM_DEBUG
    Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
    TclDumpMemoryInfo((ClientData) objPtr, 1);
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
Changes to generic/tclFCmd.c.
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
    }

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








|







1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
    }

    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	int length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = TclGetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

Changes to generic/tclFileName.c.
382
383
384
385
386
387
388

389
390
391
392
393
394
395
396
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;

    const char *path = TclGetString(pathPtr);

    if (path[0] == '~') {
	/*
	 * This case is common to all platforms. Paths that begin with ~ are
	 * absolute.
	 */








>
|







382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
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 = TclGetStringFromObj(pathPtr, &pathLen);

    if (path[0] == '~') {
	/*
	 * This case is common to all platforms. Paths that begin with ~ are
	 * absolute.
	 */

499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517

    /*
     * Perform platform specific splitting.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	resultPtr = SplitUnixPath(TclGetString(pathPtr));
	break;

    case TCL_PLATFORM_WINDOWS:
	resultPtr = SplitWinPath(TclGetString(pathPtr));
	break;
    }

    /*
     * Compute the number of elements in the result.
     */








|



|







500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518

    /*
     * Perform platform specific splitting.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
	break;

    case TCL_PLATFORM_WINDOWS:
	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
 * 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:
 *	*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;
    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);
	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((((*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];







|



















<
|




















|








>
|







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

560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
 * 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 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, 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);
	TclGetStringFromObj(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 **)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];
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitUnixPath(
    const char *path)		/* Pointer to string containing a path. */
{
    size_t length;
    const char *origPath = path, *elementStart;
    Tcl_Obj *result;

    /*
     * Deal with the root directory as a special case.
     */








|







639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitUnixPath(
    const char *path)		/* Pointer to string containing a path. */
{
    int length;
    const char *origPath = path, *elementStart;
    Tcl_Obj *result;

    /*
     * Deal with the root directory as a special case.
     */

728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitWinPath(
    const char *path)		/* Pointer to string containing a path. */
{
    size_t length;
    const char *p, *elementStart;
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_DString buf;
    Tcl_Obj *result;
    Tcl_DStringInit(&buf);

    TclNewObj(result);







|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitWinPath(
    const char *path)		/* Pointer to string containing a path. */
{
    int length;
    const char *p, *elementStart;
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_DString buf;
    Tcl_Obj *result;
    Tcl_DStringInit(&buf);

    TclNewObj(result);
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	Tcl_Free(elemv);
	return ret;
    }
}

/*
 *---------------------------------------------------------------------------
 *







|




|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	ckfree(elemv);
	return ret;
    }
}

/*
 *---------------------------------------------------------------------------
 *
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
 */

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{
    int needsSep;
    size_t length;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);

    /*







<
|







851
852
853
854
855
856
857

858
859
860
861
862
863
864
865
 */

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{

    int length, needsSep;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);

    /*
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
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));

	dest = TclGetString(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);
	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);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));
	dest = TclGetString(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);
	Tcl_SetObjLength(prefix, length);
	break;
    }
    return;
}

/*







|









|













|











|








|













|







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
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));

	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 - 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);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));
	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 - Tcl_GetString(prefix);
	Tcl_SetObjLength(prefix, length);
	break;
    }
    return;
}

/*
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990

char *
Tcl_JoinPath(
    int argc,
    const char *const *argv,
    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
{
    int i;
    size_t len;
    Tcl_Obj *listObj;
    Tcl_Obj *resultObj;
    const char *resultStr;

    /*
     * Build the list of paths.
     */







|
<







975
976
977
978
979
980
981
982

983
984
985
986
987
988
989

char *
Tcl_JoinPath(
    int argc,
    const char *const *argv,
    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
{
    int i, len;

    Tcl_Obj *listObj;
    Tcl_Obj *resultObj;
    const char *resultStr;

    /*
     * Build the list of paths.
     */
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
    Tcl_Obj *typePtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static const char *const options[] = {
	"-directory", "-join", "-nocomplain", "-path", "-tails",
	"-types", "--", NULL
    };
    enum options {
	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;

    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]);
	    if (string[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 first glob
		 * pattern. We must clear the error.
		 */

		Tcl_ResetResult(interp);
		break;
	    }
	}

	switch (index) {
	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(


			"\"-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];







|













|


















|












>
>
|
>







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
    Tcl_Obj *typePtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static const char *const 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;

    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 = TclGetStringFromObj(objv[i], &length);
	    if (string[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 first glob
		 * pattern. We must clear the error.
		 */

		Tcl_ResetResult(interp);
		break;
	    }
	}

	switch ((enum globOptionsEnum) index) {
	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];
1306
1307
1308
1309
1310
1311
1312


1313

1314
1315
1316
1317
1318
1319
1320
		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(


			"\"-path\" cannot be used with \"-directory\"", -1));

		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_GENERAL;
	    pathOrDir = objv[i+1];
	    i++;







>
>
|
>







1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
		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++;
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
	break;
    case TCL_PLATFORM_WINDOWS:
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	size_t pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */








|







1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
	break;
    case TCL_PLATFORM_WINDOWS:
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	int pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
		/*
		 * 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) {
		    Tcl_AppendToObj(pathOrDir, last-1, 1);
		}
	    }

	    /*
	     * Need to quote 'prefix'.
	     */







|







1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
		/*
		 * 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(Tcl_GetString(pathOrDir), "\\/") == NULL) {
		    Tcl_AppendToObj(pathOrDir, last-1, 1);
		}
	    }

	    /*
	     * Need to quote 'prefix'.
	     */
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
	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;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = TclGetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {







|







1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
	globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    int len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = TclGetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
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
		    goto badMacTypesArg;
		}
		globTypes->macType = look;
		Tcl_IncrRefCount(look);

	    } else {
		Tcl_Obj *item;
		int llen;

		if ((Tcl_ListObjLength(NULL, look, &llen) == TCL_OK)
			&& (llen == 3)) {
		    Tcl_ListObjIndex(interp, look, 0, &item);
		    if (!strcmp("macintosh", TclGetString(item))) {
			Tcl_ListObjIndex(interp, look, 1, &item);
			if (!strcmp("type", TclGetString(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))) {
			    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);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(







<

|
|

|

|







|



















|







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
		    goto badMacTypesArg;
		}
		globTypes->macType = look;
		Tcl_IncrRefCount(look);

	    } else {
		Tcl_Obj *item;


		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
			&& (len == 3)) {
		    Tcl_ListObjIndex(interp, look, 0, &item);
		    if (!strcmp("macintosh", Tcl_GetString(item))) {
			Tcl_ListObjIndex(interp, look, 1, &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", 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",
			Tcl_GetString(look)));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
		Tcl_DStringFree(&str);
		goto endOfGlob;
	    }
	}
	Tcl_DStringFree(&str);
    } else {
	for (i = 0; i < objc; i++) {
	    string = TclGetString(objv[i]);
	    if (TclGlob(interp, string, pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		goto endOfGlob;
	    }
	}
    }







|







1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
		Tcl_DStringFree(&str);
		goto endOfGlob;
	    }
	}
	Tcl_DStringFree(&str);
    } else {
	for (i = 0; i < objc; i++) {
	    string = Tcl_GetString(objv[i]);
	    if (TclGlob(interp, string, pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		goto endOfGlob;
	    }
	}
    }
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
	    if (join) {
		Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
	    } else {
		const char *sep = "";

		for (i = 0; i < objc; i++) {
		    Tcl_AppendPrintfToObj(errorMsg, "%s%s",
			    sep, TclGetString(objv[i]));
		    sep = " ";
		}
	    }
	    Tcl_AppendToObj(errorMsg, "\"", -1);
	    Tcl_SetObjResult(interp, errorMsg);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
		    NULL);







|







1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
	    if (join) {
		Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
	    } else {
		const char *sep = "";

		for (i = 0; i < objc; i++) {
		    Tcl_AppendPrintfToObj(errorMsg, "%s%s",
			    sep, Tcl_GetString(objv[i]));
		    sep = " ";
		}
	    }
	    Tcl_AppendToObj(errorMsg, "\"", -1);
	    Tcl_SetObjResult(interp, errorMsg);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
		    NULL);
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860

		Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

		if (cwd == NULL) {
		    Tcl_DecrRefCount(temp);
		    return TCL_ERROR;
		}
		pathPrefix = Tcl_NewStringObj(TclGetString(cwd), 3);
		Tcl_DecrRefCount(cwd);
		if (tail[0] == '/') {
		    tail++;
		} else {
		    tail += 2;
		}
		Tcl_IncrRefCount(pathPrefix);







|







1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864

		Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

		if (cwd == NULL) {
		    Tcl_DecrRefCount(temp);
		    return TCL_ERROR;
		}
		pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3);
		Tcl_DecrRefCount(cwd);
		if (tail[0] == '/') {
		    tail++;
		} else {
		    tail += 2;
		}
		Tcl_IncrRefCount(pathPrefix);
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
     *
     * We do it by rewriting the result list in-place.
     */

    if (globFlags & TCL_GLOBMODE_TAILS) {
	int objc, i;
	Tcl_Obj **objv;
	size_t prefixLen;
	const char *pre;

	/*
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {







|







1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
     *
     * We do it by rewriting the result list in-place.
     */

    if (globFlags & TCL_GLOBMODE_TAILS) {
	int objc, i;
	Tcl_Obj **objv;
	int prefixLen;
	const char *pre;

	/*
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
		    || (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);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");







|







2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    int len;
	    const char *oldStr = TclGetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
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
	    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] == '~') {
		    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;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = TclGetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);







|
















|







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
	    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 && 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;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = TclGetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	size_t 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







|







2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	int length;
	Tcl_DString append;

	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
	} 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);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),







|







2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		int len;
		const char *joined = TclGetStringFromObj(joinedPtr,&len);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
	     * 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);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }







|







2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
	     * 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.
	     */

	    int len;
	    const char *joined = TclGetStringFromObj(joinedPtr,&len);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
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
 *
 *	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().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return (Tcl_StatBuf *)Tcl_Alloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *







|










|







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
 *
 *	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
 *	ckfree().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *
Changes to generic/tclFileSystem.h.
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, void *clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE size_t	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */







|







26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
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);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE size_t	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */
Changes to generic/tclGet.c.
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
    obj.typePtr = NULL;

    code = TclSetBooleanFromAny(interp, &obj);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    if (code == TCL_OK) {
	*boolPtr = obj.internalRep.wideValue != 0;
    }
    return code;
}

/*
 * Local Variables:
 * mode: c







|







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
    obj.typePtr = NULL;

    code = TclSetBooleanFromAny(interp, &obj);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    if (code == TCL_OK) {
	TclGetBooleanFromObj(NULL, &obj, boolPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
Changes to generic/tclGetDate.y.
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((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)







|
|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#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)
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(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;







|







972
973
974
975
976
977
978
979
980
981
982
983
984
985
986

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    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

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

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







|







998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
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
    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;
    }

    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    resultElement = Tcl_NewObj();
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}








|
|


|

|

|




|





|


|





|


|

|

|



|


|

|



|


|

|







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
    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);
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    TclNewObj(resultElement);
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) -yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TcNewObj(resultElement);
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		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
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"








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

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);







>
>
>
>
>
>
>















|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 *
 * 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)*1103515245L) >> (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);
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208








209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238











239
240
241
242
243
244
245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */









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












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;
    const Tcl_HashKeyType *typePtr;

    size_t hash, 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);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = (size_t) key;
	index = RANDOM_INDEX(tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	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;
	    }
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;







|












>
>
>
>
>
>
>
>













|
















>
>
>
>
>
>
>
>
>
>
>











>
|




















|












|















|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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 void *key)		/* Key to use to find matching entry. */
{
    return (*((tablePtr)->findProc))(tablePtr, (const char *)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);
}


/*
 *----------------------------------------------------------------------
 *
 * 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 void *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, (const char *)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;
    const Tcl_HashKeyType *typePtr;
    unsigned int hash;
    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);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	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;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != PTR2UINT(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 != PTR2UINT(hPtr->hash)) {
		continue;
	    }
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	Tcl_SetHashValue(hPtr, NULL);
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = hash;
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.







|

|



|







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    size_t index;

    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 (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, entryPtr->hash);
    } else {
	index = entryPtr->hash & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {







|
















|

|







392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    int index;

    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 (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
    } else {
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
	}
    }

    tablePtr->numEntries--;
    if (typePtr->freeEntryProc) {
	typePtr->freeEntryProc(entryPtr);
    } else {
	Tcl_Free(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --







|







434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
	}
    }

    tablePtr->numEntries--;
    if (typePtr->freeEntryProc) {
	typePtr->freeEntryProc(entryPtr);
    } else {
	ckfree(entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448

void
Tcl_DeleteHashTable(
    Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    size_t 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) {







|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475

void
Tcl_DeleteHashTable(
    Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    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) {
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    if (typePtr->freeEntryProc) {
		typePtr->freeEntryProc(hPtr);
	    } else {
		Tcl_Free(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);
	}
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */







|













|







485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    if (typePtr->freeEntryProc) {
		typePtr->freeEntryProc(hPtr);
	    } else {
		ckfree(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 {
	    ckfree(tablePtr->buckets);
	}
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */







|







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
	}
    }

    /*
     * 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",
	    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",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    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
	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    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 %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    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
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count;
    size_t 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);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *







|





|







|





|







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

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count;
    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 *)ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    hPtr->clientData = 0;

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareArrayKeys(
    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;
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
    int count;

    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	if (count == 0) {
	    return 1;
	}







|


|
|







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareArrayKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    const int *iPtr1 = (const int *) keyPtr;
    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;
	}
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)				/* Key from which to compute hash value. */
{
    const int *array = (const int *) keyPtr;
    TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {







|







763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    const int *array = (const int *) keyPtr;
    TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
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
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocStringEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)			/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    size_t 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);
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --







|









|


|







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

static Tcl_HashEntry *
AllocStringEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    hPtr->clientData = 0;
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --
804
805
806
807
808
809
810
811
812
813



814
815
816
817
818
819
820
821
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareStringKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{



    return !strcmp((char *)keyPtr, hPtr->key.string);
}

/*
 *----------------------------------------------------------------------
 *
 * HashStringKey --
 *







|


>
>
>
|







831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareStringKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    const char *p1 = (const char *) keyPtr;
    const char *p2 = (const char *) hPtr->key.string;

    return !strcmp(p1, p2);
}

/*
 *----------------------------------------------------------------------
 *
 * HashStringKey --
 *
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashStringKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)			/* Key from which to compute hash value. */
{
    const char *string = (const char *)keyPtr;
    TCL_HASH_TYPE result;
    char c;

    /*
     * I tried a zillion different hash functions and asked many other people







|







860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashStringKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key from which to compute hash value. */
{
    const char *string = (const char *)keyPtr;
    TCL_HASH_TYPE result;
    char c;

    /*
     * I tried a zillion different hash functions and asked many other people
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    size_t count, index, oldSize = tablePtr->numBuckets;
    Tcl_HashEntry **oldBuckets = tablePtr->buckets;
    Tcl_HashEntry **oldChainPtr, **newChainPtr;
    Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    /* Avoid outgrowing capability of the memory allocators */
    if (oldSize > 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
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    int count, index, oldSize = tablePtr->numBuckets;
    Tcl_HashEntry **oldBuckets = tablePtr->buckets;
    Tcl_HashEntry **oldChainPtr, **newChainPtr;
    Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    /* Avoid outgrowing capability of the memory allocators */
    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
    /*
     * 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 *));
    } else {
	tablePtr->buckets =
		(Tcl_HashEntry **)Tcl_Alloc(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->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 (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, hPtr->hash);
	    } else {
		index = hPtr->hash & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
	}
    }

    /*
     * 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);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
|


|






<
|
<











|

|














|











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
    /*
     * 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 *), 0);
    } else {
	tablePtr->buckets =
		(Tcl_HashEntry **)ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;

    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 (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
	    } else {
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
	}
    }

    /*
     * 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 {
	    ckfree(oldBuckets);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclHistory.c.
69
70
71
72
73
74
75







76
77
78
79
80
81
82
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, -1);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);








	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {
	/*







>
>
>
>
>
>
>







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, -1);
	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 {
	/*
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	    (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);
    }







|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
	    (HistoryObjs *)Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = (HistoryObjs *)ckalloc(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);
    }
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
    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:
 */







|









213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    HistoryObjs *histObjsPtr = (HistoryObjs *)clientData;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    ckfree(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIO.c.
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
			    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,
			    int allowShortReads);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t 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);







|

|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
			    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, int bytesToRead,
			    int allowShortReads);
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);
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247

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







|







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247

/*
 * 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.
 *
 * --------------------------------------------------------------------------
 * 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
 * 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 SpaceLeft(bufPtr)	((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded))

#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)

#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)

#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)

#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)

#define InsertPoint(bufPtr)	((bufPtr)->buf + (bufPtr)->nextAdded)

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







|

|









|

|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
 * char *RemovePoint(ChannelBuffer *bufPtr)
 *
 *	Returns a pointer to where characters should be removed from the
 *	buffer.
 * --------------------------------------------------------------------------
 */

#define BytesLeft(bufPtr)	((bufPtr)->nextAdded - (bufPtr)->nextRemoved)

#define SpaceLeft(bufPtr)	((bufPtr)->bufLength - (bufPtr)->nextAdded)

#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)

#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)

#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)

#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)

#define InsertPoint(bufPtr)	(&(bufPtr)->buf[(bufPtr)->nextAdded])

#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))
370
371
372
373
374
375
376





377
378
379
380
381
382
383
 */

static inline int
ChanClose(
    Channel *chanPtr,
    Tcl_Interp *interp)
{





    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * ChanRead --







>
>
>
>
>







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
 */

static inline int
ChanClose(
    Channel *chanPtr,
    Tcl_Interp *interp)
{
#ifndef TCL_NO_DEPRECATED
    if ((chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) && (chanPtr->typePtr->closeProc != NULL)) {
	return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
    }
#endif
    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * ChanRead --
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463









464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480









481
482

483
484
485
486
487
488
489
     */

    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) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * 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 ((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 (bytesRead < dstSize) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	}









    }
    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) {









	*errnoPtr = EINVAL;
	return -1;

    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
}

static inline void







|















|
<
<
<
<
<
<
<
<
<










>
>
>
>
>
>
>
>
>

















>
>
>
>
>
>
>
>
>


>







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449









450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
     */

    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) < 0) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * 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 > 0) {









	/*
	 * 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) {
#ifndef TCL_NO_DEPRECATED
	if (offset<LONG_MIN || offset>LONG_MAX) {
	    *errnoPtr = EOVERFLOW;
	    return -1;
	}

	return Tcl_ChannelSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
#else
	*errnoPtr = EINVAL;
	return -1;
#endif
    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
		offset, mode, errnoPtr);
}

static inline void
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    if (statePtr->refCount + 1 <= 1) {
		/*
		 * 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);
	    } else {
		/*
		 * The refcount is greater than zero, so flush the channel.
		 */

		Tcl_Flush((Tcl_Channel) chanPtr);








|






|







662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    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_Close(NULL, (Tcl_Channel) chanPtr);
	    } else {
		/*
		 * The refcount is greater than zero, so flush the channel.
		 */

		Tcl_Flush((Tcl_Channel) chanPtr);

834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
				 * 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->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}








|







849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    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
	    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);
	    break;
	}
	cbPrevPtr = cbPtr;
    }
}

/*







|







895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
	    if (cbPrevPtr == NULL) {
		statePtr->closeCbPtr = cbPtr->nextPtr;
	    } else {
		cbPrevPtr->nextPtr = cbPtr->nextPtr;
	    }
	    ckfree(cbPtr);
	    break;
	}
	cbPrevPtr = cbPtr;
    }
}

/*
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_Alloc(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).







|







930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	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).
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
		    prevPtr->nextPtr = nextPtr;
		}

		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
			TclChannelEventScriptInvoker, sPtr);

		TclDecrRefCount(sPtr->scriptPtr);
		Tcl_Free(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++;
	if (statePtr->refCount-- <= 1) {
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_CloseEx(interp, (Tcl_Channel) chanPtr, 0);
	    }
	}

    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CheckForStdChannelsBeingClosed --
 *







|
















|





|







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
		    prevPtr->nextPtr = nextPtr;
		}

		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
			TclChannelEventScriptInvoker, sPtr);

		TclDecrRefCount(sPtr->scriptPtr);
		ckfree(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++;
	if (statePtr->refCount-- <= 1) {
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree(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
{
    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) {
	    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) {
	    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) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}








|







|







|







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
{
    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 < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	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 < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}

1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265

    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount + 1 <= 1) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_CloseEx().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
		if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
		    SetFlag(statePtr, CHANNEL_CLOSED);
		    Tcl_Release(statePtr);
		    return TCL_ERROR;
		}
	    }
	}
	SetFlag(statePtr, CHANNEL_CLOSED);







|



|



|







1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280

    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount <= 0) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_Close().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
		if (Tcl_Close(interp, chan) != TCL_OK) {
		    SetFlag(statePtr, CHANNEL_CLOSED);
		    Tcl_Release(statePtr);
		    return TCL_ERROR;
		}
	    }
	}
	SetFlag(statePtr, CHANNEL_CLOSED);
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
    }

    if (resPtr && resPtr->refCount == 1) {
	/*
         * Re-use the ResolvedCmdName struct.
         */

	Tcl_Release(resPtr->statePtr);
    } else {
	resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName));
	resPtr->refCount = 0;
	ChanSetIntRep(objPtr, resPtr);		/* Overwrites, if needed */
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve(statePtr);
    resPtr->interp = interp;
    resPtr->epoch = statePtr->epoch;

  valid:
    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;

    if (modePtr != NULL) {







|

|





|







1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
    }

    if (resPtr && resPtr->refCount == 1) {
	/*
         * Re-use the ResolvedCmdName struct.
         */

	Tcl_Release((ClientData) resPtr->statePtr);
    } else {
	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
	resPtr->refCount = 0;
	ChanSetIntRep(objPtr, resPtr);		/* Overwrites, if needed */
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve((ClientData) statePtr);
    resPtr->interp = interp;
    resPtr->epoch = statePtr->epoch;

  valid:
    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;

    if (modePtr != NULL) {
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
     * 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(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->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;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = (char *)Tcl_Alloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.







>
>
>
>
>
|





>









>
>
>
>
>






|
|


















|


|







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
     * 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(typePtr->typeName != NULL);
#ifndef TCL_NO_DEPRECATED
    if (((NULL == typePtr->closeProc) || (TCL_CLOSE2PROC == typePtr->closeProc)) && (typePtr->close2Proc == NULL)) {
	Tcl_Panic("channel type %s must define closeProc or close2Proc", typePtr->typeName);
    }
#else
    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);
    }
#endif
    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);
    }
#ifndef TCL_NO_DEPRECATED
    if ((NULL != typePtr->wideSeekProc) && (NULL == typePtr->seekProc)) {
	Tcl_Panic("channel type %s must define seekProc if defining wideSeekProc", typePtr->typeName);
    }
#endif

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    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;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = (char *)ckalloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = (char *)ckalloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = (Channel *)Tcl_Alloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */







|







1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    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:
     */
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
    if (chanPtr->refCount == 0) {
	Tcl_Panic("Channel released more than preserved");
    }
    if (--chanPtr->refCount) {
	return;
    }
    if (chanPtr->typePtr == NULL) {
	Tcl_Free(chanPtr);
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (!chanPtr->refCount) {
	Tcl_Free(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------







|







|
|







2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
    if (chanPtr->refCount == 0) {
	Tcl_Panic("Channel released more than preserved");
    }
    if (--chanPtr->refCount) {
	return;
    }
    if (chanPtr->typePtr == NULL) {
	ckfree(chanPtr);
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (chanPtr->refCount == 0) {
	ckfree(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
	}
    } 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) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * "TclChanCaughtErrorBypass" is not required here, it was
		 * done already by "Tcl_Close".
		 */

		return TCL_ERROR;







|
|







2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
	}
    } else {
	/*
	 * This channel does not cover another one. Simply do a close, if
	 * necessary.
	 */

	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;
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
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->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);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount + 1 > 2;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *







|












|












|






|







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
AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)ckalloc(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 == 0) {
	Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
    }
    bufPtr->refCount++;
}

static void
ReleaseChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (--bufPtr->refCount) {
	return;
    }
    ckfree(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931

    /*
     * 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) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }








|







2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957

    /*
     * 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 <= 0) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }

3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
    /*
     * 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);
	    statePtr->channelName = NULL;
	}

	Tcl_FreeEncoding(statePtr->encoding);
    }

    /*







|







3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
    /*
     * 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) {
	    ckfree(statePtr->channelName);
	    statePtr->channelName = NULL;
	}

	Tcl_FreeEncoding(statePtr->encoding);
    }

    /*
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
	tsdPtr->firstCSPtr = statePtr;

	statePtr->topChanPtr = downChanPtr;
	downChanPtr->upChanPtr = NULL;

	ChannelFree(chanPtr);

	return Tcl_CloseEx(interp, (Tcl_Channel) downChanPtr, 0);
    }

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







|







3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
	tsdPtr->firstCSPtr = statePtr;

	statePtr->topChanPtr = downChanPtr;
	downChanPtr->upChanPtr = NULL;

	ChannelFree(chanPtr);

	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.
     */
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
 *	background flush scheduled. The device itself is eventually closed and
 *	the channel record removed, in CloseChannel, above.
 *
 *----------------------------------------------------------------------
 */

int
TclClose(
    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. */







|







3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
 *	background flush scheduled. The device itself is eventually closed and
 *	the channel record removed, in CloseChannel, above.
 *
 *----------------------------------------------------------------------
 */

int
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. */
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
     * 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) {
	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"







|







3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    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"
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
     * 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);
    }

    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) {
	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.
     */








|









>
>
>
>
>
>
>
>
>




>







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
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
	cbPtr->proc(cbPtr->clientData);
	ckfree(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.
     */

#ifndef TCL_NO_DEPRECATED
    if ((chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) || (chanPtr->typePtr->closeProc == NULL)) {
	/* If this half-close gives a EINVAL or ENOTCONN, just continue the full close */
	result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
	if ((result == EINVAL) || result == ENOTCONN) {
	    result = 0;
	}
    }
#else
    result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
    if ((result == EINVAL) || result == ENOTCONN) {
	result = 0;
    }
#endif

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

3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
	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;
    }







|







3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
	return TCL_OK;
    }

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;

    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
	return Tcl_Close(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;
    }
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945

    /*
     * 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);
    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */








|







3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981

    /*
     * Remove all the channel handler records attached to the channel itself.
     */

    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
	chNext = chPtr->nextPtr;
	ckfree(chPtr);
    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */

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
    /*
     * Remove any EventScript records for this channel.
     */

    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
	eNextPtr = ePtr->nextPtr;
	TclDecrRefCount(ePtr->scriptPtr);
	Tcl_Free(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.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
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
				 * 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;
    }

    if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }
    if (WriteBytes(chanPtr, src, srcLen) == -1) {
	return TCL_IO_FAILURE;
    }
    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.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
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
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode;
    size_t written;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_IO_FAILURE;
    }

    if (srcLen == TCL_INDEX_NONE) {
	srcLen = strlen(src);
    }

    /*
     * Go immediately to the driver, do all the error handling by ourselves.
     * The code was stolen from 'FlushChannel'.
     */

    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
    if (written == TCL_IO_FAILURE) {
	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.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
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
				 * 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;
    }

    chanPtr = statePtr->topChanPtr;

    if (len == TCL_INDEX_NONE) {
	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);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------







|


















|
|








|



|













|


|


|
|


















|
|








|



|





|
<


|


|









|



















|
|








|




|








|




|


















|







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
    /*
     * Remove any EventScript records for this channel.
     */

    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
	eNextPtr = ePtr->nextPtr;
	TclDecrRefCount(ePtr->scriptPtr);
	ckfree(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 -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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    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 -1;
    }

    if (srcLen < 0) {
	srcLen = strlen(src);
    }
    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 -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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    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, written;


    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return -1;
    }

    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 = ChanWrite(chanPtr, 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 -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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    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 -1;
    }

    chanPtr = statePtr->topChanPtr;

    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 *) 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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

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

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
WillWrite(
    Channel *chanPtr)
{
    int inputBuffered;

    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)



	    ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
	int ignore;

	DiscardInputQueued(chanPtr->state, 0);
	ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
    }
}







|











|





|


|














>
>
>







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
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

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;
    int srcLen;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return -1;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
WillWrite(
    Channel *chanPtr)
{
    int inputBuffered;

    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
#ifndef TCL_NO_DEPRECATED
	    || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL)
#endif
	    ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
	int ignore;

	DiscardInputQueued(chanPtr->state, 0);
	ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
    }
}
4225
4226
4227
4228
4229
4230
4231



4232
4233
4234
4235
4236
4237
4238
	 */

	DiscardInputQueued(chanPtr->state, 0);
	Tcl_SetErrno(EINVAL);
	return -1;
    }
    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != 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







>
>
>







4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
	 */

	DiscardInputQueued(chanPtr->state, 0);
	Tcl_SetErrno(EINVAL);
	return -1;
    }
    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
#ifndef TCL_NO_DEPRECATED
	    || (Tcl_ChannelSeekProc(chanPtr->typePtr) != NULL)
#endif
	    ) && (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
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
	     * 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);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}







|







4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
	     * 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 = -SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}
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
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

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

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored + 1 > 1) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*







|








|



|







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
 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

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;
    int charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    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
 *
 *	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
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;
    size_t oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_IO_FAILURE;
    }

    /*
     * 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));

	/* TODO: Do we need this? */
	UpdateInterest(chanPtr);
	return TCL_IO_FAILURE;
    }

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







|










|
<





|














|







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

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, oldLength, oldFlags, oldRemoved;

    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	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));

	/* TODO: Do we need this? */
	UpdateInterest(chanPtr);
	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
    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);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|







4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

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

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }







|







4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
		    /*
		     * 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) {
			int offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }
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
    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 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);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }








|
|
<
















|







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
    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, oldLength, oldFlags, oldRemoved;
    int rawLen, byteLen, 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 = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}

static Tcl_Encoding
GetBinaryEncoding()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding == NULL) {
	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
	Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
    }







|







5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}

static Tcl_Encoding
GetBinaryEncoding(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding == NULL) {
	tsdPtr->binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
	Tcl_CreateThreadExitHandler(FreeBinaryEncoding, NULL);
    }
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
	    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);
	    nextPtr->nextRemoved -= extra;
	    bufPtr->nextAdded -= extra;
	}
    }

    gsPtr->bufPtr = bufPtr;
    return 0;







|







5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
	    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, (size_t) extra);
	    nextPtr->nextRemoved -= extra;
	    bufPtr->nextAdded -= extra;
	}
    }

    gsPtr->bufPtr = bufPtr;
    return 0;
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
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
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. */
{
    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 DoRead(chanPtr, dst, bytesToRead, 0);
}

/*
 *----------------------------------------------------------------------







|



|












|







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
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input 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 -1;
    }

    return DoRead(chanPtr, dst, bytesToRead, 0);
}

/*
 *----------------------------------------------------------------------
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
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
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. */
{
    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;
    }

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

	/*
	 * Copy the current chunk into the read buffer.
	 */

	memcpy(readBuf, RemovePoint(bufPtr), toCopy);
	bufPtr->nextRemoved += toCopy;







|



|








|









|
|







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
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input 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 -1;
    }

    /*
     * First read bytes from the push-back buffers.
     */

    while (chanPtr->inQueueHead && bytesToRead > 0) {
	ChannelBuffer *bufPtr = chanPtr->inQueueHead;
	int bytesInBuffer = BytesLeft(bufPtr);
	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
		: bytesToRead;

	/*
	 * Copy the current chunk into the read buffer.
	 */

	memcpy(readBuf, RemovePoint(bufPtr), toCopy);
	bufPtr->nextRemoved += toCopy;
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
    /*
     * This test not needed.
     */

    if (bytesToRead > 0) {
	int nread = ChanRead(chanPtr, readBuf, bytesToRead);

	if (nread == -1) {






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







|
>
>
>
>
>
>













<
<
<
<
<
<







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
    /*
     * This test not needed.
     */

    if (bytesToRead > 0) {
	int nread = ChanRead(chanPtr, readBuf, bytesToRead);

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

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }






	} 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
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

size_t
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
				 * -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. */
{







|



|







5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    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
 *---------------------------------------------------------------------------
 */

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







|







5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    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. */
{
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
     */

    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; ) {
	copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }







|







5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    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);
	    }
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
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
				 * 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. */
{







|







6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
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 < 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
    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);

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







<
|







6122
6123
6124
6125
6126
6127
6128

6129
6130
6131
6132
6133
6134
6135
6136
    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);

    int 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.
     */
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) TclGetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	size_t size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }








|







6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) TclGetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	unsigned int size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }

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
 *
 * 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.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

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







|







|



|







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
 *
 * 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 -1 on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    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

    /*
     * CheckChannelErrors clears too many flag bits in this one case.
     */

    flags = statePtr->flags;
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	len = TCL_IO_FAILURE;
	goto done;
    }
    statePtr->flags = flags;

    /*
     * Clear the EOF flags, and clear the BLOCKED bit.
     */







|







6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701

    /*
     * CheckChannelErrors clears too many flag bits in this one case.
     */

    flags = statePtr->flags;
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	len = -1;
	goto done;
    }
    statePtr->flags = flags;

    /*
     * Clear the EOF flags, and clear the BLOCKED bit.
     */
6992
6993
6994
6995
6996
6997
6998



6999
7000
7001
7002
7003
7004
7005

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



    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output







>
>
>







7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046

    /*
     * 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)
#ifndef TCL_NO_DEPRECATED
	    && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL)
#endif
    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
7157
7158
7159
7160
7161
7162
7163



7164
7165
7166
7167
7168
7169
7170

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



    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output







>
>
>







7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214

    /*
     * 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)
#ifndef TCL_NO_DEPRECATED
	    && (Tcl_ChannelSeekProc(chanPtr->typePtr) == NULL)
#endif
    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
    }

    /*
     * Compute how much input and output is buffered. If both input and output
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
        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.
     */







|







7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    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.
     */
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	Tcl_Free((void *)argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------







|







7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_DStringFree(&ds);
	ckfree(argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
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

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		}
		Tcl_Free((void *)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(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)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.
	 */







|














|



|







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

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		}
		ckfree(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(
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    ckfree(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.
	 */
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", -1));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    if (*readMode == '\0') {







|







8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -translation: must be a one or two"
			" element list", -1));
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    if (*readMode == '\0') {
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
		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_Free((void *)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.







|







8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
		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));
		}
		ckfree(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.
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
		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_Free((void *)argv);
		return TCL_ERROR;
	    }
	}
	Tcl_Free((void *)argv);
	return TCL_OK;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }







|



|







8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
		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));
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	}
	ckfree(argv);
	return TCL_OK;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
		prevPtr->nextPtr = nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, sPtr);

	    TclDecrRefCount(sPtr->scriptPtr);
	    Tcl_Free(sPtr);
	} else {
	    prevPtr = sPtr;
	}
    }
}

/*







|







8302
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
		prevPtr->nextPtr = nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, sPtr);

	    TclDecrRefCount(sPtr->scriptPtr);
	    ckfree(sPtr);
	} else {
	    prevPtr = sPtr;
	}
    }
}

/*
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
    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->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }







|







8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
8697
8698
8699
8700
8701
    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 *)ckalloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
     */

    if (prevChPtr == NULL) {
	statePtr->chPtr = chPtr->nextPtr;
    } else {
	prevChPtr->nextPtr = chPtr->nextPtr;
    }
    Tcl_Free(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;







|







8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
     */

    if (prevChPtr == NULL) {
	statePtr->chPtr = chPtr->nextPtr;
    } else {
	prevChPtr->nextPtr = chPtr->nextPtr;
    }
    ckfree(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;
8806
8807
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
		prevEsPtr->nextPtr = esPtr->nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);

	    TclDecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);

	    break;
	}
    }
}

/*







|







8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
		prevEsPtr->nextPtr = esPtr->nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);

	    TclDecrRefCount(esPtr->scriptPtr);
	    ckfree(esPtr);

	    break;
	}
    }
}

/*
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to







|







8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
9092
9093
9094
9095
9096
9097
9098














9099
9100
9101
9102
9103
9104
9105
 * Side effects:
 *	May schedule a background copy operation that causes both channels to
 *	be marked busy.
 *
 *----------------------------------------------------------------------
 */















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. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */







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







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
 * Side effects:
 *	May schedule a background copy operation that causes both channels to
 *	be marked busy.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
int
TclCopyChannelOld(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    int toRead,			/* Amount of data to copy, or -1 for all. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
{
    return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
            cmdPtr);
}
#endif

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. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
9174
9175
9176
9177
9178
9179
9180
9181
9182
9183
9184
9185
9186
9187
9188

    /*
     * 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->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;







|







9232
9233
9234
9235
9236
9237
9238
9239
9240
9241
9242
9243
9244
9245
9246

    /*
     * 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 *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
9468
9469
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
    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;
    size_t sizeb;
    Tcl_WideInt total;
    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    inChan	= (Tcl_Channel) csPtr->readPtr;







|
<







9526
9527
9528
9529
9530
9531
9532
9533

9534
9535
9536
9537
9538
9539
9540
    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, sizeb;

    Tcl_WideInt total;
    const char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    inChan	= (Tcl_Channel) csPtr->readPtr;
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
	     * Read up to bufSize bytes.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			0 /* No append */);
	    }
	    underflow = (size >= 0) && ((size_t)size < sizeb);	/* Input underflow */
	}

	if (size < 0) {
	readError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error reading \"",







|









|







9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
9604
9605
9606
9607
9608
9609
9610
9611
9612
9613
9614
9615
9616
	     * Read up to bufSize bytes.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = (int) csPtr->toRead;
	    }

	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			0 /* No append */);
	    }
	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
	}

	if (size < 0) {
	readError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error reading \"",
9629
9630
9631
9632
9633
9634
9635
9636
9637
9638
9639
9640
9641
9642
9643
	 * 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) {
	writeError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error writing \"",
			Tcl_GetChannelName(outChan), "\": ", NULL);
		if (msg != NULL) {
		    Tcl_AppendObjToObj(errObj, msg);







|







9686
9687
9688
9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
	 * 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 < 0) {
	writeError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error writing \"",
			Tcl_GetChannelName(outChan), "\": ", NULL);
		if (msg != NULL) {
		    Tcl_AppendObjToObj(errObj, msg);
9797
9798
9799
9800
9801
9802
9803
9804
9805
9806
9807
9808


9809
9810
9811
9812
9813
9814
9815
 *----------------------------------------------------------------------
 */

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. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;



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







|




>
>







9854
9855
9856
9857
9858
9859
9860
9861
9862
9863
9864
9865
9866
9867
9868
9869
9870
9871
9872
9873
9874
 *----------------------------------------------------------------------
 */

static int
DoRead(
    Channel *chanPtr,		/* The channel from which 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
9856
9857
9858
9859
9860
9861
9862
9863
9864
9865
9866
9867
9868
9869
9870

	/*
	 * 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 */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;







|







9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929

	/*
	 * 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 */
		(BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;
10100
10101
10102
10103
10104
10105
10106
10107
10108
10109
10110
10111
10112
10113
10114
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
    }
    inStatePtr->csPtrR = NULL;
    outStatePtr->csPtrW = NULL;
    Tcl_Free(csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *







|







10159
10160
10161
10162
10163
10164
10165
10166
10167
10168
10169
10170
10171
10172
10173
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
    }
    inStatePtr->csPtrR = NULL;
    outStatePtr->csPtrW = NULL;
    ckfree(csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *
10402
10403
10404
10405
10406
10407
10408
10409
10410
10411
10412
10413
10414
10415
10416
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);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *







|







10461
10462
10463
10464
10465
10466
10467
10468
10469
10470
10471
10472
10473
10474
10475
int
Tcl_IsChannelShared(
    Tcl_Channel chan)		/* The channel to query */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    return ((statePtr->refCount > 1) ? 1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *
10498
10499
10500
10501
10502
10503
10504










10505
10506
10507
10508
10509
10510
10511
 */

Tcl_ChannelTypeVersion
Tcl_ChannelVersion(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{










    return chanTypePtr->version;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelBlockModeProc --







>
>
>
>
>
>
>
>
>
>







10557
10558
10559
10560
10561
10562
10563
10564
10565
10566
10567
10568
10569
10570
10571
10572
10573
10574
10575
10576
10577
10578
10579
10580
 */

Tcl_ChannelTypeVersion
Tcl_ChannelVersion(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if ((chanTypePtr->version < TCL_CHANNEL_VERSION_2)
	    || (chanTypePtr->version > TCL_CHANNEL_VERSION_5)) {
	/*
	 * In <v2 channel versions, the version field is occupied by the
	 * Tcl_DriverBlockModeProc
	 */
	return TCL_CHANNEL_VERSION_1;
    }
#endif
    return chanTypePtr->version;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelBlockModeProc --
10521
10522
10523
10524
10525
10526
10527








10528
10529
10530


























10531
10532
10533
10534
10535
10536
10537
 *---------------------------------------------------------------------- */

Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{








    return chanTypePtr->blockModeProc;
}



























/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelClose2Proc --
 *
 *	Return the Tcl_DriverClose2Proc of the channel type.
 *







>
>
>
>
>
>
>
>



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







10590
10591
10592
10593
10594
10595
10596
10597
10598
10599
10600
10601
10602
10603
10604
10605
10606
10607
10608
10609
10610
10611
10612
10613
10614
10615
10616
10617
10618
10619
10620
10621
10622
10623
10624
10625
10626
10627
10628
10629
10630
10631
10632
10633
10634
10635
10636
10637
10638
10639
10640
 *---------------------------------------------------------------------- */

Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
	/*
	 * The v1 structure had the blockModeProc in a different place.
	 */
	return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
    }
#endif
    return chanTypePtr->blockModeProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelCloseProc --
 *
 *	Return the Tcl_DriverCloseProc of the channel type.
 *
 * Results:
 *	A pointer to the proc.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
Tcl_DriverCloseProc *
Tcl_ChannelCloseProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->closeProc;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelClose2Proc --
 *
 *	Return the Tcl_DriverClose2Proc of the channel type.
 *
10596
10597
10598
10599
10600
10601
10602


























10603
10604
10605
10606
10607
10608
10609
Tcl_ChannelOutputProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->outputProc;
}



























/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelSetOptionProc --
 *
 *	Return the Tcl_DriverSetOptionProc of the channel type.
 *







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







10699
10700
10701
10702
10703
10704
10705
10706
10707
10708
10709
10710
10711
10712
10713
10714
10715
10716
10717
10718
10719
10720
10721
10722
10723
10724
10725
10726
10727
10728
10729
10730
10731
10732
10733
10734
10735
10736
10737
10738
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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
Tcl_DriverSeekProc *
Tcl_ChannelSeekProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->seekProc;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelSetOptionProc --
 *
 *	Return the Tcl_DriverSetOptionProc of the channel type.
 *
10713
10714
10715
10716
10717
10718
10719





10720
10721
10722
10723
10724
10725
10726
 */

Tcl_DriverFlushProc *
Tcl_ChannelFlushProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{





    return chanTypePtr->flushProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelHandlerProc --







>
>
>
>
>







10842
10843
10844
10845
10846
10847
10848
10849
10850
10851
10852
10853
10854
10855
10856
10857
10858
10859
10860
 */

Tcl_DriverFlushProc *
Tcl_ChannelFlushProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
	return NULL;
    }
#endif
    return chanTypePtr->flushProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelHandlerProc --
10737
10738
10739
10740
10741
10742
10743





10744
10745
10746
10747
10748
10749
10750
 */

Tcl_DriverHandlerProc *
Tcl_ChannelHandlerProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{





    return chanTypePtr->handlerProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelWideSeekProc --







>
>
>
>
>







10871
10872
10873
10874
10875
10876
10877
10878
10879
10880
10881
10882
10883
10884
10885
10886
10887
10888
10889
 */

Tcl_DriverHandlerProc *
Tcl_ChannelHandlerProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_2) {
	return NULL;
    }
#endif
    return chanTypePtr->handlerProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelWideSeekProc --
10761
10762
10763
10764
10765
10766
10767





10768
10769
10770
10771
10772
10773
10774
 */

Tcl_DriverWideSeekProc *
Tcl_ChannelWideSeekProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{





    return chanTypePtr->wideSeekProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelThreadActionProc --







>
>
>
>
>







10900
10901
10902
10903
10904
10905
10906
10907
10908
10909
10910
10911
10912
10913
10914
10915
10916
10917
10918
 */

Tcl_DriverWideSeekProc *
Tcl_ChannelWideSeekProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_3) {
	return NULL;
    }
#endif
    return chanTypePtr->wideSeekProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelThreadActionProc --
10786
10787
10788
10789
10790
10791
10792





10793
10794
10795
10796
10797
10798
10799
 */

Tcl_DriverThreadActionProc *
Tcl_ChannelThreadActionProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{





    return chanTypePtr->threadActionProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetChannelErrorInterp --







>
>
>
>
>







10930
10931
10932
10933
10934
10935
10936
10937
10938
10939
10940
10941
10942
10943
10944
10945
10946
10947
10948
 */

Tcl_DriverThreadActionProc *
Tcl_ChannelThreadActionProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
#ifndef TCL_NO_DEPRECATED
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_4) {
	return NULL;
    }
#endif
    return chanTypePtr->threadActionProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetChannelErrorInterp --
10963
10964
10965
10966
10967
10968
10969
10970
10971
10972
10973
10974
10975
10976
10977
    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)Tcl_Alloc(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.
     */







|







11112
11113
11114
11115
11116
11117
11118
11119
11120
11121
11122
11123
11124
11125
11126
    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    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.
     */
11016
11017
11018
11019
11020
11021
11022
11023
11024
11025
11026
11027
11028
11029
11030

    if (explicitResult) {
	lvn[j++] = lv[i];
    }

    msg = Tcl_NewListObj(j, lvn);

    Tcl_Free(lvn);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelErrorInterp --







|







11165
11166
11167
11168
11169
11170
11171
11172
11173
11174
11175
11176
11177
11178
11179

    if (explicitResult) {
	lvn[j++] = lv[i];
    }

    msg = Tcl_NewListObj(j, lvn);

    ckfree(lvn);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelErrorInterp --
11098
11099
11100
11101
11102
11103
11104



11105
11106
11107
11108
11109
11110
11111
 */

Tcl_DriverTruncateProc *
Tcl_ChannelTruncateProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{



    return chanTypePtr->truncateProc;
}

/*
 *----------------------------------------------------------------------
 *
 * DupChannelIntRep --







>
>
>







11247
11248
11249
11250
11251
11252
11253
11254
11255
11256
11257
11258
11259
11260
11261
11262
11263
 */

Tcl_DriverTruncateProc *
Tcl_ChannelTruncateProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (Tcl_ChannelVersion(chanTypePtr) < TCL_CHANNEL_VERSION_5) {
	return NULL;
    }
    return chanTypePtr->truncateProc;
}

/*
 *----------------------------------------------------------------------
 *
 * DupChannelIntRep --
11161
11162
11163
11164
11165
11166
11167
11168
11169
11170
11171
11172
11173
11174
11175

    ChanGetIntRep(objPtr, resPtr);
    assert(resPtr);
    if (resPtr->refCount-- > 1) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    Tcl_Free(resPtr);
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */







|







11313
11314
11315
11316
11317
11318
11319
11320
11321
11322
11323
11324
11325
11326
11327

    ChanGetIntRep(objPtr, resPtr);
    assert(resPtr);
    if (resPtr->refCount-- > 1) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    ckfree(resPtr);
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */
Changes to generic/tclIO.h.
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    size_t 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. */







|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    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. */
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
     * 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;
} 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







|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
     * 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. */

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







|







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. */
    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. */
Changes to generic/tclIOCmd.c.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

#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. */
} AcceptCallback;

/*
 * Thread local storage used to maintain a per-thread stdout channel obj.
 * It must be per-thread because of std channel limitations.







|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct AcceptCallback {
    Tcl_Obj *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.
128
129
130
131
132
133
134













135
136
137
138
139
140
141
    case 4:			/* [puts -nonewline $chan $x] or
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;













	}
	/* Fall through */
    default:			/* [puts] or
				 * [puts some bad number of arguments...] */
	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
	return TCL_ERROR;
    }







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







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    case 4:			/* [puts -nonewline $chan $x] or
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	} 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;
#endif
	}
	/* Fall through */
    default:			/* [puts] or
				 * [puts some bad number of arguments...] */
	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
	return TCL_ERROR;
    }
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result == -1) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result == -1) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*







|




|







172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
		"channel \"%s\" wasn't opened for writing",
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result < 0) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result < 0) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*
414
415
416
417
418
419
420










421
422
423
424
425




426
427
428
429
430
431
432
     * 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;




	}
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);







>
>
>
>
>
>
>
>
>
>





>
>
>
>







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
     * Compute how many bytes to read.
     */

    toRead = -1;
    if (i < objc) {
	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
		|| (toRead < 0)) {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    /*
	     * 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) {
#endif
		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 !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    }
	    newline = 1;
#endif
	}
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	size_t length;

	result = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);







|







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

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	int length;

	result = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
	 * 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;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = TclGetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {







|







720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
	 * 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;
	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')) {
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr;
    const char **argv;		/* An array for the string arguments. Stored
				 * on the _Tcl_ stack. */
    const char *string;
    Tcl_Channel chan;
    int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
    size_t length;
    static const char *const options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum options {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };

    /*
     * Check for any leading option arguments.
     */








|
|



|







879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr;
    const char **argv;		/* An array for the string arguments. Stored
				 * on the _Tcl_ stack. */
    const char *string;
    Tcl_Channel chan;
    int argc, background, i, index, keepNewline, result, skip, length;
    int ignoreStderr;
    static const char *const options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum execOptionsEnum {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };

    /*
     * Check for any leading option arguments.
     */

938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
    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) {
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    TclNewObj(resultPtr);
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {







|







965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
    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_Close(interp, chan) != TCL_OK) {
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    TclNewObj(resultPtr);
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984

    /*
     * 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);
    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));

    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */








|







997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011

    /*
     * 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_Close(interp, chan);
    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));

    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */

1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (binary && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
	    }
	}
	Tcl_Free((void *)cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;







|







1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (binary && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
	    }
	}
	ckfree(cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *







|







1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree(hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    if (!isNew) {







|







1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    if (!isNew) {
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
	Tcl_Release(interp);
    } else {
	/*
	 * The interpreter has been deleted, so there is no useful way to use
	 * the client socket - just close it.
	 */

	Tcl_CloseEx(NULL, chan, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpServerCloseProc --







|







1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
	Tcl_Release(interp);
    } else {
	/*
	 * The interpreter has been deleted, so there is no useful way to use
	 * the client socket - just close it.
	 */

	Tcl_Close(NULL, chan);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpServerCloseProc --
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    Tcl_Free(acceptCallbackPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *







|







1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    ckfree(acceptCallbackPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *
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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
	NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
	const char *arg = TclGetString(objv[a]);

	if (arg[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option",
		TCL_EXACT, &optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum socketOptions) optionIndex) {
	case SKT_ASYNC:
	    if (server == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		return TCL_ERROR;
	    }
	    async = 1;







|















|








|







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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
	NULL
    };
    enum socketOptionsEnum {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; 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) {
	case SKT_ASYNC:
	    if (server == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		return TCL_ERROR;
	    }
	    async = 1;
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
    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_Alloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    Tcl_Free(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







|









|







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
    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    ckfree(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
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
    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 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 options) index) {
    case PENDING_INPUT:
	if (!(mode & TCL_READABLE)) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_InputBuffered(chan)));
	}
	break;







|















|







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

    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) {
    case PENDING_INPUT:
	if (!(mode & TCL_READABLE)) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_InputBuffered(chan)));
	}
	break;
Changes to generic/tclIOGT.c.
23
24
25
26
27
28
29




30
31
32
33
34
35
36
			    int mode);
static int		TransformCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
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		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);







>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
			    int mode);
static int		TransformCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
static int		TransformInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCodePtr);
static int		TransformOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCodePtr);
#ifndef TCL_NO_DEPRECATED
static int		TransformSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCodePtr);
#endif
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);
113
114
115
116
117
118
119
120
121
122



123

124
125
126
127
128
129
130
 * This structure describes the channel type structure for Tcl-based
 * transformations.
 */

static const Tcl_ChannelType transformChannelType = {
    "transform",		/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    TransformInputProc,		/* Input proc. */
    TransformOutputProc,	/* Output proc. */



    NULL,			/* Seek proc. */

    TransformSetOptionProc,	/* Set option proc. */
    TransformGetOptionProc,	/* Get option proc. */
    TransformWatchProc,		/* Initialize notifier. */
    TransformGetFileHandleProc,	/* Get OS handles out of channel. */
    TransformCloseProc,		/* close2proc */
    TransformBlockModeProc,	/* Set blocking/nonblocking mode.*/
    NULL,			/* Flush proc. */







|


>
>
>

>







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 * This structure describes the channel type structure for Tcl-based
 * transformations.
 */

static const Tcl_ChannelType transformChannelType = {
    "transform",		/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* Close proc. */
    TransformInputProc,		/* Input proc. */
    TransformOutputProc,	/* Output proc. */
#ifndef TCL_NO_DEPRECATED
    TransformSeekProc,		/* Seek proc. */
#else
    NULL,			/* Seek proc. */
#endif
    TransformSetOptionProc,	/* Set option proc. */
    TransformGetOptionProc,	/* Get option proc. */
    TransformWatchProc,		/* Initialize notifier. */
    TransformGetFileHandleProc,	/* Get OS handles out of channel. */
    TransformCloseProc,		/* close2proc */
    TransformBlockModeProc,	/* Set blocking/nonblocking mode.*/
    NULL,			/* Flush proc. */
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    Tcl_Free(dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *







|







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    ckfree(dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

    /*
     * 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->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;







|







288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

    /*
     * 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 *)ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
				 * 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;
    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);







|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
				 * 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). */
    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
	break;

    case TRANSMIT_DOWN:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(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);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */







|









|





|







444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
	break;

    case TRANSMIT_DOWN:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	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 = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */
809
810
811
812
813
814
815





































































816
817
818
819
820
821
822

    return toWrite;
}

/*
 *----------------------------------------------------------------------
 *





































































 * TransformWideSeekProc --
 *
 *	This procedure is called by the generic IO level to move the access
 *	point in a channel, with a (potentially) 64-bit offset.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future







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







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

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

#ifndef TCL_NO_DEPRECATED
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 = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const 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);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TransformWideSeekProc --
 *
 *	This procedure is called by the generic IO level to move the access
 *	point in a channel, with a (potentially) 64-bit offset.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
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
    Tcl_WideInt offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);



    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

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

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);




	} else {
	    *errorCodePtr = EINVAL;
	    return -1;
	}
    }

    /*







>
>
>












>
>
>
>







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
    Tcl_WideInt offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
#ifndef TCL_NO_DEPRECATED
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
#endif
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

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

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
#ifndef TCL_NO_DEPRECATED
	} else if (parentSeekProc) {
	    return parentSeekProc(parentData, 0, mode, errorCodePtr);
#endif
	} else {
	    *errorCodePtr = EINVAL;
	    return -1;
	}
    }

    /*
880
881
882
883
884
885
886

















887
888

889
890
891
892
893
894
895
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */

    if (parentWideSeekProc == NULL) {

















	*errorCodePtr = EINVAL;
	return -1;

    }
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *







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


>







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
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */

    if (parentWideSeekProc == NULL) {
	/*
	 * 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.
	 */

#ifndef TCL_NO_DEPRECATED
	if (offset<LONG_MIN || offset>LONG_MAX) {
	    *errorCodePtr = EOVERFLOW;
	    return -1;
	}

	return parentSeekProc(parentData, offset,
		mode, errorCodePtr);
#else
	*errorCodePtr = EINVAL;
	return -1;
#endif
    }
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
static inline void
ResultClear(
    ResultBuffer *r)		/* Reference to the buffer to clear out. */
{
    r->used = 0;

    if (r->allocated) {
	Tcl_Free(r->buf);
	r->buf = NULL;
	r->allocated = 0;
    }
}

/*
 *----------------------------------------------------------------------







|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
static inline void
ResultClear(
    ResultBuffer *r)		/* Reference to the buffer to clear out. */
{
    r->used = 0;

    if (r->allocated) {
	ckfree(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
    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);
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = (unsigned char *)Tcl_Realloc(r->buf, r->allocated);
	}
    }

    /*
     * Now we may copy the data.
     */








|


|







1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
    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 *)ckalloc(r->allocated);
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated);
	}
    }

    /*
     * Now we may copy the data.
     */

Changes to generic/tclIORChan.c.
42
43
44
45
46
47
48




49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68



69

70
71
72
73
74
75
76
#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		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.				  */
    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 */







>
>
>
>

















|


>
>
>

>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#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);
#ifndef TCL_NO_DEPRECATED
static int		ReflectSeek(ClientData clientData, long offset,
			    int mode, int *errorCodePtr);
#endif
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.				  */
    TCL_CHANNEL_VERSION_5, /* v5 channel */
    TCL_CLOSE2PROC,	   /* Close channel, clean instance data	  */
    ReflectInput,	   /* Handle read request			  */
    ReflectOutput,	   /* Handle write request			  */
#ifndef TCL_NO_DEPRECATED
    ReflectSeek,	   /* Move location of access point.	NULL'able */
#else
    NULL,
#endif
    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 */
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
 * 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,
				 * 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 */







|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
 * 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 */
    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 */
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
static void		ForwardOpToHandlerThread(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);                           \
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	FreeReceivedError(p)







|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
static void		ForwardOpToHandlerThread(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) {                               \
	    ckfree((p)->base.msgStr);                           \
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	FreeReceivedError(p)
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
    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));

	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->wideSeekProc = NULL;
	}

	chanPtr->typePtr = clonePtr;
    }

    /*







|














>
>
>







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
    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 *)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))) {
#ifndef TCL_NO_DEPRECATED
	    clonePtr->seekProc = NULL;
#endif
	    clonePtr->wideSeekProc = NULL;
	}

	chanPtr->typePtr = clonePtr;
    }

    /*
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    Tcl_Free(rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

/*







|







739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree(rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

/*
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent));

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

        /*
         * We are not preserving the structure here. When the channel is







|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent));

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

        /*
         * We are not preserving the structure here. When the channel is
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
		FreeReceivedError(&p);
	    }
	}
#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);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);







|







1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
		FreeReceivedError(&p);
	    }
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree(tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
	if (rcPtr->readTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->readTimer);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
	if (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);
    }
    if (rcPtr->writeTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);







|







1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	ckfree(tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    if (rcPtr->readTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->readTimer);
    }
    if (rcPtr->writeTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *toReadObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

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








|







1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *toReadObj;
    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?
     */

1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
		 */

		*errorCodePtr = -p.base.code;
	    } else {
		PassReceivedError(rcPtr->chan, &p);
		*errorCodePtr = EINVAL;
	    }
	    p.input.toRead = TCL_INDEX_NONE;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.input.toRead;
    }
#endif







|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
		 */

		*errorCodePtr = -p.base.code;
	    } else {
		PassReceivedError(rcPtr->chan, &p);
		*errorCodePtr = EINVAL;
	    }
	    p.input.toRead = -1;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.input.toRead;
    }
#endif
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);

    if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec + 1 > 1) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);







|

|

|




|







1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if (toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
        goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec > 0) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
    }
#endif

    /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */

    Tcl_Preserve(rcPtr);

    offObj  = Tcl_NewWideIntObj(offset);
    baseObj = Tcl_NewStringObj(
            (seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_CUR) ? "current" : "end", -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {







|







1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
    }
#endif

    /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */

    Tcl_Preserve(rcPtr);

    TclNewIntObj(offObj, offset);
    baseObj = Tcl_NewStringObj(
            (seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_CUR) ? "current" : "end", -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
1610
1611
1612
1613
1614
1615
1616




















1617
1618
1619
1620
1621
1622
1623
    Tcl_Release(rcPtr);
    return newLoc;
 invalid:
    *errorCodePtr = EINVAL;
    newLoc = -1;
    goto stop;
}





















/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
 *
 *	This function is invoked to tell the channel what events the I/O







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







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
    Tcl_Release(rcPtr);
    return newLoc;
 invalid:
    *errorCodePtr = EINVAL;
    newLoc = -1;
    goto stop;
}

#ifndef TCL_NO_DEPRECATED
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 ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
 *
 *	This function is invoked to tell the channel what events the I/O
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
	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);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;







|







2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
	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 {
	int len;
	const char *str = TclGetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    int mn = 0;

    rcPtr = (ReflectedChannel *)Tcl_Alloc(sizeof(ReflectedChannel));

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

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
    rcPtr->readTimer = 0;







|







2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    int mn = 0;

    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;
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
    }
    Tcl_Free(rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *







|







2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
    }
    ckfree(rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
	     * 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);

		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,







|







2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
	     * 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) {
		int cmdLen;
		const char *cmdString = TclGetStringFromObj(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,
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}

/*







|







2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}

/*
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

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

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

    /*







|







2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

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

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

    /*
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692

static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}








|







2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723

static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}

2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_Free(rcmPtr);
}

static void
ForwardOpToHandlerThread(
    ReflectedChannel *rcPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */







|







2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(rcmPtr);
}

static void
ForwardOpToHandlerThread(
    ReflectedChannel *rcPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
	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->rcPtr = rcPtr;
    evPtr->param = (ForwardParam *) param;








|
|







2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    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;

2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
     * returning the success code.
     *
     * Note: The event structure has already been deleted.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    Tcl_Free(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    TCL_UNUSED(int) /* mask */)
{







|







2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
     * returning the success code.
     *
     * Note: The event structure has already been deleted.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    ckfree(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    TCL_UNUSED(int) /* mask */)
{
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

    case ForwardedInput: {
	Tcl_Obj *toReadObj;

	TclNewIntObj(toReadObj, paramPtr->input.toRead);
	Tcl_IncrRefCount(toReadObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->input.toRead = TCL_IO_FAILURE;
	} else {
	    /*
	     * Process a regular result.
	     */

	    size_t bytec = 0;		/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = TCL_IO_FAILURE;
	    } else {
		if (bytec + 1 > 1) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);







|








|





|


|



|

|







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

    case ForwardedInput: {
	Tcl_Obj *toReadObj;

	TclNewIntObj(toReadObj, paramPtr->input.toRead);
	Tcl_IncrRefCount(toReadObj);

	Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->input.toRead = -1;
	} else {
	    /*
	     * Process a regular result.
	     */

	    int bytec;			/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = -1;
	    } else {
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
3092
3093
3094
3095
3096
3097
3098
3099
3100



3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedSeek: {
	Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
	Tcl_Obj *baseObj = Tcl_NewStringObj(



                (paramPtr->seek.seekMode==SEEK_SET) ? "start" :
                (paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);

        Tcl_IncrRefCount(offObj);
        Tcl_IncrRefCount(baseObj);

        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.







|
|
>
>
>
|
|

|
|

|







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
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedSeek: {
	Tcl_Obj *offObj;
	Tcl_Obj *baseObj;

	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_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.
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = (char *)Tcl_Alloc(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);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }







|






|







3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = (char *)ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
		const char *str = TclGetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
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
}

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

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







|



|













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
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */
Changes to generic/tclIORTrans.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
			    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.







>
>
>
>

















|


>
>
>

>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
			    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);
#ifndef TCL_NO_DEPRECATED
static int		ReflectSeek(ClientData clientData, long offset,
			    int mode, int *errorCodePtr);
#endif
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. */
    TCL_CLOSE2PROC,		/* Close channel, clean instance data. */
    ReflectInput,		/* Handle read request. */
    ReflectOutput,		/* Handle write request. */
#ifndef TCL_NO_DEPRECATED
    ReflectSeek,		/* Move location of access point. */
#else
	NULL,			/* Move location of access point. */
#endif
    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.
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
/*
 * 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);







|
|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
/*
 * 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. */
    int allocated;		/* Allocated size of the buffer area. */
    int used;			/* Number of bytes in the buffer,
				 * <= allocated. */
} ResultBuffer;

#define ResultLength(r) ((r)->used)
/* static int		ResultLength(ResultBuffer *r); */

static void		ResultClear(ResultBuffer *r);
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
 * 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 */
};








|







268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
 * 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 */
    int 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 */
};

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
			    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));	\







|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
			    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) {					\
		ckfree((p)->base.msgStr);				\
	    }								\
	} while (0)
#define PassReceivedErrorInterp(i,p) \
	do {								\
	    if ((i) != NULL) {						\
		Tcl_SetChannelErrorInterp((i),				\
			Tcl_NewStringObj((p)->base.msgStr, -1));	\
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
    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--;
    }







|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
    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_GetString(Tcl_GetObjResult(interp))));
	    Tcl_DecrRefCount(resObj);
	    goto error;
	}

	methods |= FLAG(methIndex);
	listc--;
    }
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
     *
     * 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







|







1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
     *
     * 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, Tcl_GetString(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
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
    /*
     * 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







>
>
>
>
>
>
>
>
>
>


>












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







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
    /*
     * 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) {
#ifndef TCL_NO_DEPRECATED
	if (offset < LONG_MIN || offset > LONG_MAX) {
	    *errorCodePtr = EOVERFLOW;
	    curPos = -1;
	} else {
	    curPos = Tcl_ChannelSeekProc(parent->typePtr)(
	    parent->instanceData, offset, seekMode,
	    errorCodePtr);
	}
#else
	*errorCodePtr = EINVAL;
	curPos = -1;
#endif
    } else {
    	curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
    		seekMode, errorCodePtr);
    }
    if (curPos == -1) {
	Tcl_SetErrno(*errorCodePtr);
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return curPos;
}

#ifndef TCL_NO_DEPRECATED
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 ReflectSeekWide(clientData, offset, seekMode,
	    errorCodePtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
 *
 *	This function is invoked to tell the channel what events the I/O
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
    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







|







1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    int listc;
    Tcl_Obj **listv;
    int i;

    rtPtr = (ReflectedTransform *)ckalloc(sizeof(ReflectedTransform));

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

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
     *
     * 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];







|







1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
     *
     * 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 **)ckalloc(sizeof(Tcl_Obj *) * (listc+4));

    /*
     * Duplicate object references.
     */

    for (i=0; i<listc ; i++) {
	Tcl_Obj *word = rtPtr->argv[i] = listv[i];
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
    ReflectedTransform *rtPtr)
{
    TimerKill(rtPtr);
    ResultClear(&rtPtr->result);

    FreeReflectedTransformArgs(rtPtr);

    Tcl_Free(rtPtr->argv);
    Tcl_Free(rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *







|
|







1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
    ReflectedTransform *rtPtr)
{
    TimerKill(rtPtr);
    ResultClear(&rtPtr->result);

    FreeReflectedTransformArgs(rtPtr);

    ckfree(rtPtr->argv);
    ckfree(rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
	     * 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);







|







2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
	     * 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);
		int 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);
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
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;
}








|







2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
static ReflectedTransformMap *
GetReflectedTransformMap(
    Tcl_Interp *interp)
{
    ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL);

    if (rtmPtr == NULL) {
	rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RTMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
    }
    return rtmPtr;
}

2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
	    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.
     */

    /*







|







2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

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

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

    /*
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251

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







|







2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290

static ReflectedTransformMap *
GetThreadReflectedTransformMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rtmPtr) {
	tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
    }

    return tsdPtr->rtmPtr;
}

2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
	    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.
     */








|







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	ReflectedTransform *rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(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.
     */

2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
	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;








|
|







2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rtPtr = rtPtr;
    evPtr->param = (ForwardParam *) param;

2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
     *
     * 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*/)
{







|







2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
     *
     * Note: The event structure has already been deleted by the destination
     * notifier, after it serviced the event.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    ckfree(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    TCL_UNUSED(int) /*mask*/)
{
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
    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;








|






|



|




|

















|






|



|




|













|






|


|




|










|






|



|




|







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
    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 = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)ckalloc(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 = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)ckalloc(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 = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev; /* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)ckalloc(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 = -1;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    int bytec;		/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
}

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 */

/*
 *----------------------------------------------------------------------
 *







|



|







2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    Tcl_Free(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *







|







2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    ckfree(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
	/*
	 * 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.
     */







|


|







2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
	/*
	 * 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(ckalloc(rPtr->allocated));
	} else {
	    rPtr->allocated += toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(ckrealloc((char *) rPtr->buf,
		    rPtr->allocated));
	}
    }

    /*
     * Now copy data.
     */
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019

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







|







|







3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058

    if (rPtr->used == 0) {
	/*
	 * Nothing to copy in the case of an empty buffer.
	 */

	copied = 0;
    } else if (rPtr->used == toRead) {
	/*
	 * We have just enough. Copy everything to the caller.
	 */

	memcpy(buf, rPtr->buf, toRead);
	rPtr->used = 0;
	copied = toRead;
    } else if (rPtr->used > 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);
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
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?
     */








|










|












|














|















|







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
static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

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

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

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

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);

	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);
	ckfree(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 = Tcl_GetByteArrayFromObj(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;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

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

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








|



















|




















|




















|










|
















|







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
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		p.transform.size);
	ckfree(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 = Tcl_GetByteArrayFromObj(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;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

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

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

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	ckfree(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 = Tcl_GetByteArrayFromObj(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;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

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

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








|











|







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
	*errorCodePtr = EOK;
	if (op == FLUSH_WRITE) {
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		    p.transform.size);
	} else {
	    res = 0;
	}
	ckfree(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 = Tcl_GetByteArrayFromObj(resObj, &bytec);
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
	} else {
	    res = 0;
	}
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

Changes to generic/tclIOSock.c.
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    /*
     * 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 */







|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    /*
     * 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: OpenBSD, NetBSD.
     * Causes failure when used on AIX 5.1 and HP-UX
     */

#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
    hints.ai_flags |= AI_ADDRCONFIG;
#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
#endif /* 0 */
Changes to generic/tclIOUtil.c.
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
     * Discard the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	Tcl_Free(fsRecPtr);
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;
    tsdPtr->initialized = 0;
}

int







|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
     * Discard the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	ckfree(fsRecPtr);
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;
    tsdPtr->initialized = 0;
}

int
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	size_t len1, len2;
	const char *str1, *str2;

	str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the







|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	int len1, len2;
	const char *str1, *str2;

	str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    /*
     * Refill the cache, honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = (FilesystemRecord *)Tcl_Alloc(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);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */








|














|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    /*
     * Refill the cache, honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	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;
	ckfree(toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */

659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    size_t len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }








|







659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }

766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	/*
	 * The native filesystem is static, so don't free it.
	 */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    Tcl_Free(fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }
    filesystemList = NULL;







|







766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	/*
	 * The native filesystem is static, so don't free it.
	 */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    ckfree(fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }
    filesystemList = NULL;
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = (FilesystemRecord *)Tcl_Alloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    Tcl_MutexLock(&filesystemMutex);

    newFilesystemPtr->nextPtr = filesystemList;







|







848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    Tcl_MutexLock(&filesystemMutex);

    newFilesystemPtr->nextPtr = filesystemList;
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
	     * information about the removed filesystem is not used.
	     */

	    if (++theFilesystemEpoch == 0) {
		++theFilesystemEpoch;
	    }

	    Tcl_Free(fsRecPtr);

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }








|







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
	     * information about the removed filesystem is not used.
	     */

	    if (++theFilesystemEpoch == 0) {
		++theFilesystemEpoch;
	    }

	    ckfree(fsRecPtr);

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
		    gLength--;
		}
		break;		/* Break out of for loop. */
	    }
	}
	if (!found && dir) {
	    Tcl_Obj *norm;
	    size_t 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.
	     */








|







1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
		    gLength--;
		}
		break;		/* Break out of for loop. */
	    }
	}
	if (!found && dir) {
	    Tcl_Obj *norm;
	    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.
	     */

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







|












|







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

    int 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
     * normalizePathProc.
     */
    path = Tcl_GetStringFromObj(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;
	}
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
	    mode |= O_NOCTTY;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    Tcl_Free((void *)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",
			flag));
	    }
	    Tcl_Free((void *)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,"
			" or TRUNC", flag));
	    }
	    Tcl_Free((void *)modeArgv);
	    return -1;
	}
    }

    Tcl_Free((void *)modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, WRONLY, or RDWR",
		    -1));
	}







|












|















|




|







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
	    mode |= O_NOCTTY;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
			flag));
	    }
	    ckfree(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",
			flag));
	    }
	    ckfree(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,"
			" or TRUNC", flag));
	    }
	    ckfree(modeArgv);
	    return -1;
	}
    }

    ckfree(modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, WRONLY, or RDWR",
		    -1));
	}
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
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
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the system encoding. */
{
    size_t length;
	int result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const 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)));
	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)));
	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]
     */

    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");

    /*
     * If the encoding is specified, set the channel to that encoding.
     * Otherwise don't touch it, leaving things up to the system encoding.  If
     * the encoding is unknown report an error.
     */

    if (encodingName != NULL) {


	if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
		!= TCL_OK) {
	    Tcl_CloseEx(interp,chan,0);
	    return result;
	}
    }

    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)));
	goto end;
    }
    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)));
	goto end;
    }

    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);







|

<
|















|






|












<
|


|
>
>
|
|
|
|
<










|


|


|








|


|



|







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
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
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
{

    int length, result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const 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",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	return result;
    }
    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
    if (chan == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	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]
     */

    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_Close(interp,chan);
	return result;

    }

    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_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	goto end;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {
	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);
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
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	unsigned 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 system encoding. */
{
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile, *objPtr;
    Interp *iPtr;
    Tcl_Channel chan;
    const char *string;

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);
	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 don't touch it, leaving things up to the system encoding.  If
     * the encoding is unknown report an error.
     */

    if (encodingName != NULL) {


	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;







|




|















|















|






|


|










<
|


|
>
>
|
|
|
|
<










|


|



|








|


|




|







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
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : 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",
		Tcl_GetString(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",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    TclPkgFileSeen(interp, Tcl_GetString(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_Close(interp, chan);
	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_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
    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)));
    }

    Tcl_DecrRefCount(objPtr);
    return result;
}








|

|




|







1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	int length;
	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	const int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    Tcl_DecrRefCount(objPtr);
    return result;
}

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
	 */

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

    /*
     * 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)));
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *







|

|
















|







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

	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",
			Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    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",
		Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
	     * 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.
	     */

	    size_t len1, len2;
	    const 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







|







2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
	     * 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.
	     */

	    int len1, len2;
	    const 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
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
	 */
#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)) {
	    return 1;
	}
    }
#endif /* ... NO_FSTATFS */
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */








|







3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
	 */
#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(Tcl_GetString(shlibFile), &fs) == 0)
		&& (fs.f_type == AUFS_SUPER_MAGIC)) {
	    return 1;
	}
    }
#endif /* ... NO_FSTATFS */
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */

3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184

    if (fsPtr == NULL) {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    if (fsPtr->loadFileProc != NULL) {
	int retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
		(interp, pathPtr, handlePtr, &unloadProcPtr, flags);

	if (retVal == TCL_OK) {
	    if (*handlePtr == NULL) {
		return TCL_ERROR;
	    }
	    if (interp) {







|







3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183

    if (fsPtr == NULL) {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    if (fsPtr->loadFileProc != NULL) {
	retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
		(interp, pathPtr, handlePtr, &unloadProcPtr, flags);

	if (retVal == TCL_OK) {
	    if (*handlePtr == NULL) {
		return TCL_ERROR;
	    }
	    if (interp) {
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
     * 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)));
	}
	return TCL_ERROR;
    }

#ifdef TCL_LOAD_FROM_MEMORY
    /*
     * The platform supports loading a dynamic shared object from memory.







|







3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
     * 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",
		    Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

#ifdef TCL_LOAD_FROM_MEMORY
    /*
     * The platform supports loading a dynamic shared object from memory.
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
	}
	data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
	if (!data) {
	    goto mustCopyToTempAnyway;
	}
	buffer = TclpLoadMemoryGetBuffer(interp, size);
	if (!buffer) {
	    Tcl_CloseEx(interp, data, 0);
	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, (char *)buffer, size);
	Tcl_CloseEx(interp, data, 0);
	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
		&unloadProcPtr, flags);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    goto resolveSymbols;
	}
    }








|



|







3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
	}
	data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
	if (!data) {
	    goto mustCopyToTempAnyway;
	}
	buffer = TclpLoadMemoryGetBuffer(interp, size);
	if (!buffer) {
	    Tcl_Close(interp, data);
	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, (char *)buffer, size);
	Tcl_Close(interp, data);
	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
		&unloadProcPtr, flags);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    goto resolveSymbols;
	}
    }

3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
	return TCL_OK;
    }

    /*
     * Divert the unloading in order to unload and cleanup the temporary file.
     */

    tvdlPtr = (FsDivertLoad *)Tcl_Alloc(sizeof(FsDivertLoad));

    /*
     * Remember three pieces of information in order to clean up the diverted
     * load completely on platforms which allow proper unloading of code.
     */

    tvdlPtr->loadHandle = newLoadHandle;







|







3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
	return TCL_OK;
    }

    /*
     * Divert the unloading in order to unload and cleanup the temporary file.
     */

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

    tvdlPtr->loadHandle = newLoadHandle;
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    divertedLoadHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);







|







3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    divertedLoadHandle = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
	 * corresponding to this file. which might cause the filesystem to be
	 * deallocated if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *







|
|







3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
	 * corresponding to this file. which might cause the filesystem to be
	 * deallocated if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree(tvdlPtr);
    ckfree(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
	 * corresponding to this file. which might case filesystem to be freed
	 * if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *







|







3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
	 * corresponding to this file. which might case filesystem to be freed
	 * if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    ckfree(tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
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
    /* Assume each separator is a single character. */

    if (fsPtr->filesystemSeparatorProc != NULL) {
	Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr);

	if (sep != NULL) {
	    Tcl_IncrRefCount(sep);
	    separator = TclGetString(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.
     */

    TclNewObj(result);
    p = TclGetString(pathPtr);
    Tcl_ListObjAppendElement(NULL, result,
	    Tcl_NewStringObj(p, driveNameLength));
    p += driveNameLength;

    /*
     * Add the remaining pathname elements to the list.
     */







|











|







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
    /* Assume each separator is a single character. */

    if (fsPtr->filesystemSeparatorProc != NULL) {
	Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr);

	if (sep != NULL) {
	    Tcl_IncrRefCount(sep);
	    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.
     */

    TclNewObj(result);
    p = Tcl_GetString(pathPtr);
    Tcl_ListObjAppendElement(NULL, result,
	    Tcl_NewStringObj(p, driveNameLength));
    p += driveNameLength;

    /*
     * Add the remaining pathname elements to the list.
     */
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
    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
				 * place to store a pointer to an object with a
				 * refCount of 1, and whose value is the name
				 * of the volume. */
{
    size_t pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {







|







3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
    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
				 * place to store a pointer to an object with a
				 * refCount of 1, and whose value is the name
				 * of the volume. */
{
    int pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
		     * Tcl_Panic seems a bit excessive.
		     */

		    numVolumes = -1;
		}
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    size_t len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    if ((size_t) pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
			}







|





|







4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
		     * Tcl_Panic seems a bit excessive.
		     */

		    numVolumes = -1;
		}
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    int len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
			}
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

    in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
    if (in == NULL) {
	/*
	 * Could not open an input channel.  Why didn't the caller check this?
	 */

	Tcl_CloseEx(interp, out, 0);
	goto done;
    }

    /*
     * Copy the file synchronously.  TO DO:  Maybe add an asynchronous option
     * to support virtual filesystems that 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.
     */

    Tcl_CloseEx(interp, in, 0);
    Tcl_CloseEx(interp, out, 0);

    /*
     * Set modification date of copied file.
     */

    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
	tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf);







|
















|
|







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

    in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
    if (in == NULL) {
	/*
	 * Could not open an input channel.  Why didn't the caller check this?
	 */

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

    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
	result = TCL_OK;
    }

    /*
     * If the copy failed, assume that copy channel left an error message.
     */

    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);
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
	return -1;
    }

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

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

		    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
			    TCL_PATH_DIRNAME);







|






|







4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
	return -1;
    }

    if (recursive) {
	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
	if (cwdPtr != NULL) {
	    const 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,
			(size_t) normLen) == 0)) {
		    /*
		     * The cwd is inside the directory to be removed.  Change
		     * the cwd to [file dirname $path].
		     */

		    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
			    TCL_PATH_DIRNAME);
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
 *---------------------------------------------------------------------------
 */

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *	Produce the type of a pathname and the type of its filesystem.







|







4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
 *---------------------------------------------------------------------------
 */

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    ckfree(clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *	Produce the type of a pathname and the type of its filesystem.
Changes to generic/tclIndexObj.c.
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77





































































78
79
80
81
82
83
84
 * 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. */
} 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 --
 *
 *	This procedure looks up an object's value in a table of strings and
 *	returns the index of the matching string, if any.







|
|













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







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 * 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 */
    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)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIndexFromObj --
 *
 *	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 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 flag '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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetIndexFromObj
int
Tcl_GetIndexFromObj(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const char *const*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. */
{
    if (!(flags & TCL_INDEX_TEMP_TABLE)) {

    /*
     * See if there is a valid cached result from a previous lookup (doing the
     * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
     * the common case where the result is cached).
     */

    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType);

    if (irPtr) {
	IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

	/*
	 * Here's hoping we don't get hit by unfortunate packing constraints
	 * on odd platforms like a Cray PVP...
	 */

	if (indexRep->tablePtr == (void *) tablePtr
		&& indexRep->offset == sizeof(char *)) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}
    }
    }
    return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
	    msg, flags, indexPtr);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * GetIndexFromObjList --
 *
 *	This procedure looks up an object's value in a table of strings and
 *	returns the index of the matching string, if any.
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
	return result;
    }

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

	    Tcl_Free((void *)tablePtr);
	    *indexPtr = t;
	    return TCL_OK;
	}

	tablePtr[t] = TclGetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);

    Tcl_Free((void *)tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *







|






|




|






|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
	return result;
    }

    /*
     * Build a string table from the list.
     */

    tablePtr = (const char **)ckalloc((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.
	     */

	    ckfree(tablePtr);
	    *indexPtr = t;
	    return TCL_OK;
	}

	tablePtr[t] = Tcl_GetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);

    ckfree(tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    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 */
    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;
    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 *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);







|














|
|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    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. */
    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;
    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 < (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);
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    if (!(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (irPtr) {
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
    } else {
	Tcl_ObjIntRep ir;

	indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
	ir.twoPtrValue.ptr1 = indexRep;
	Tcl_StoreIntRep(objPtr, &indexType, &ir);
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;
    }







|







347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
    if (!(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (irPtr) {
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
    } else {
	Tcl_ObjIntRep ir;

	indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
	ir.twoPtrValue.ptr1 = indexRep;
	Tcl_StoreIntRep(objPtr, &indexType, &ir);
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;
    }
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_ObjIntRep ir;
    IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));

    memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
	    sizeof(IndexRep));

    ir.twoPtrValue.ptr1 = dupIndexRep;
    Tcl_StoreIntRep(dupPtr, &indexType, &ir);
}







|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463

static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_ObjIntRep ir;
    IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));

    memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
	    sizeof(IndexRep));

    ir.twoPtrValue.ptr1 = dupIndexRep;
    Tcl_StoreIntRep(dupPtr, &indexType, &ir);
}
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
 *----------------------------------------------------------------------
 */

static void
FreeIndex(
    Tcl_Obj *objPtr)
{
    Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --







|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
 *----------------------------------------------------------------------
 */

static void
FreeIndex(
    Tcl_Obj *objPtr)
{
    ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
    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 matchOptions {
	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 matchOptions) 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;







|













|











|







549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    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 = Tcl_GetString(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;
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
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;
    }







|
<







665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
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, length, elemLength;

    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
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;
    }







|
<







722
723
724
725
726
727
728
729

730
731
732
733
734
735
736
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, i, t, length, elemLength, resultLength;

    const char *string, *elemString, *resultString;
    Tcl_Obj **tableObjv;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }
778
779
780
781
782
783
784
785
786
787
788
789
790























791
792
793
794
795
796
797
    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;
    char flags;
    Interp *iPtr = (Interp *) interp;
    const char *elementStr;
























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







<
|




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







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
    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, len, elemLen;
    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);
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866


867
868
869
870
871
872
873
		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);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }



	    /*
	     * 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) {







|









>
>







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
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, 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) {
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
	     * 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);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }
	}



	/*
	 * 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) {







|










>
>







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
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, 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) {
933
934
935
936
937
938
939


940
941
942
943
944
945
946

    if (message != NULL) {
	Tcl_AppendStringsToObj(objPtr, message, NULL);
    }
    Tcl_AppendStringsToObj(objPtr, "\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    Tcl_SetObjResult(interp, objPtr);


}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseArgsObjv --
 *







>
>







1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041

    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
#undef AFTER_FIRST_WORD
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseArgsObjv --
 *
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
				 * '-'). */
    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;
    }

    /*







|










|







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
				 * '-'). */
    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. */
    int 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 **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

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







|










|







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
	    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, Tcl_GetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_STRING:
	    if (objc == 0) {
		goto missingArg;
	    }
	    *((const char **) infoPtr->dstPtr) =
		    Tcl_GetString(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.
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
	    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 *)







|







1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
	    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, Tcl_GetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_FUNC: {
	    Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)
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

    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;
}

/*
 *----------------------------------------------------------------------
 *







|












|







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

    if (objc > 0) {
	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
	nrem += objc;
    }
    leftovers[nrem] = NULL;
    *objcPtr = nrem++;
    *remObjv = (Tcl_Obj **)ckrealloc(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) {
	ckfree(leftovers);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
    /*
     * 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.
     */







|





|







1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
    /*
     * 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++) {
	int length;

	if (infoPtr->keyStr == NULL) {
	    continue;
	}
	length = strlen(infoPtr->keyStr);
	if (length > width) {
	    width = length;
	}
    }

    /*
     * Now add the option information, with pretty-printing.
     */
Changes to generic/tclInt.decls.
44
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)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(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)







|

<
|
|
|
<
>







44
45
46
47
48
49
50
51
52

53
54
55

56
57
58
59
60
61
62
63
    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
	    Tcl_Channel errorChan)
}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    int TclCopyAndCollapse(int count, const char *src, char *dst)
}

declare 8 {deprecated {}} {
    int TclCopyChannelOld(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
}
# 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)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)







|







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
}
# 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(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
#}
#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)
}
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)
}
declare 25 {
    void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)







|






|







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#}
#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,
	    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 {
    int TclFormatInt(char *buffer, Tcl_WideInt 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
    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)
#}

# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2:
#declare 36 {







<
|
|
|
<
>







147
148
149
150
151
152
153

154
155
156

157
158
159
160
161
162
163
164
    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}

declare 34 {deprecated {Use Tcl_GetIntForIndex}} {
    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 {
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
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)
}
# Removed in 8.5a2:
#declare 43 {
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 44 {







|







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
declare 40 {
    int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
    CONST86 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
#    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 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)
}
declare 54 {
    int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 55 {
    Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
#  declare 56 {







<
|
|
|
<
>









|



|







209
210
211
212
213
214
215

216
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)
#}

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(ClientData clientData, Tcl_Interp *interp,
	    int argc, const char **argv)
}
declare 54 {
    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
declare 61 {
    Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
declare 62 {
    int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
declare 63 {
    int TclObjInterpProc(void *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:







|







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(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
#    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)
}
#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)
}
declare 75 {
    Tcl_WideUInt TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
}

# Removed in 9.0:
#declare 77 {
#    void TclpGetTime(Tcl_Time *time)
#}

# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
#	    char *modeString, int permissions)
#}
declare 81 {
    void *TclpRealloc(void *ptr, size_t size)
}
#declare 82 {
#    int TclpRemoveDirectory(const char *path, int recursive,
#	    Tcl_DString *errorPtr)
#}
#declare 83 {
#    int TclpRenameFile(const char *source, const char *dest)







|


















|


|

<
<
|
|
<
>














|







285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315


316
317

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
# Replaced by Tcl_FSAccess in 8.4:
#declare 68 {
#    int TclpAccess(const char *path, int mode)
#}
declare 69 {
    void *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)
}
declare 75 {
    unsigned long TclpGetClicks(void)
}
declare 76 {
    unsigned long TclpGetSeconds(void)
}


declare 77 {deprecated {}} {
    void TclpGetTime(Tcl_Time *time)

}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)
#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
#	    char *modeString, int permissions)
#}
declare 81 {
    void *TclpRealloc(void *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
#  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 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)
}
# 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:







<
|
|
|
<
>

















|







351
352
353
354
355
356
357

358
359
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
#  declare 86 {
#      int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }

declare 88 {deprecated {}} {
    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(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
#}
# 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)
}
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)
#}

# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
#    int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
#    int TclStatDeleteProc(TclStatProc_ *proc)
#}







|








<
|
|
<
>







404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419

420
421

422
423
424
425
426
427
428
429
#}
# Removed in 8.4b2:
#declare 100 {
#    Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    Tcl_Obj *objPtr, int flags)
#}
declare 101 {
    CONST86 char *TclSetPreInitScript(const char *string)
}
declare 102 {
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}

declare 104 {deprecated {}} {
    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
# 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)
#}
# Removed in 9.0:

#declare 113 {
#    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
#	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:

#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)
#}
# Removed in 9.0:

#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 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)
#}
# Removed in 9.0:

#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)
#}
# Removed in 9.0:

#declare 124 {
#    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:

#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 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)
#}

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







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












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




<
|
|
|
<
>


















<
|
|
<
>







448
449
450
451
452
453
454

455
456
457


458
459
460
461


462
463
464


465
466
467
468


469
470
471
472


473
474
475
476

477
478
479
480
481
482
483
484
485
486
487
488
489

490
491
492


493
494
495


496
497
498
499


500
501
502


503
504
505

506
507
508
509
510

511
512
513

514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532

533
534

535
536
537
538
539
540
541
542
# 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)
}

declare 112 {
    int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)


}
declare 113 {
    Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)


}
declare 114 {
    void TclDeleteNamespace(Tcl_Namespace *nsPtr)


}
declare 115 {
    int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern, int resetListFirst)


}
declare 116 {
    Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)


}
declare 117 {
    Tcl_Namespace *TclFindNamespace(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)
}

declare 121 {
    int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern)


}
declare 122 {
    Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)


}
declare 123 {
    void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
	    Tcl_Obj *objPtr)


}
declare 124 {
    Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)


}
declare 125 {
    Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)

}
declare 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}

declare 127 {
    int TclImport(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)
}

declare 133 {deprecated {}} {
    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)
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)
}
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,







|







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    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,
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627

# 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)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}







|
|







592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    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
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)
#}

# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
#    const 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)
}

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








|
<
|
<
>
|
<
|
<
>












|







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
declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {

    void TclSetStartupScriptFileName(const char *filename)

}
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {

    const 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(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.

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

# 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)
#}

# REMOVED - use public Tcl_GetStartupScript()
#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)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    size_t 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 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)
}

# added for 8.4.3

#declare 174 {
#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)







<
|
<
|
<
>
|
<
|
<
>


|



|




|









|
|







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

# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int index, Tcl_Obj *valuePtr)
}


declare 167 {deprecated {use public Tcl_SetStartupScript()}} {

    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)

}
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {

    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, unsigned long n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2

declare 173 {
    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
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 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)
#}

# Removed in 9.0
#declare 182 {
#     struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0

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







<
|
|
<
>
|
|
<
>











<
|
|
<
<
>
|
|
<
>







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

declare 178 {
    void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)

}
declare 179 {
    Tcl_Obj *TclGetStartupScript(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)
#}


declare 182 {deprecated {}} {
     struct tm *TclpLocaltime(const time_t *clock)


}
declare 183 {deprecated {}}  {
     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
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)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)







|







856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    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
    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,
            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)







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
    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, 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)
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
declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
             int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}



# TIP 337 made this one public
#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 {







|
>
|
<
<
<
<









|







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
declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
             int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
declare 236 {deprecated {use Tcl_BackgroundException}} {
    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(ClientData 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 {
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
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,







|
|







968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
	    int numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
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)
}

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







|







992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
declare 250 {
    void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const 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,
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
}

# TIP 431: temporary directory creation function
declare 258 {
    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)
}

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)
}
# Removed in 9.0:
#declare 1 win {
#    void TclWinConvertWSAError(int errCode)
#}
# Removed in 9.0:

#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 4 win {
    void *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)
#}
# Removed in 9.0:

#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)
}
# Removed in 9.0:
#declare 9 win {
#    int TclWinGetPlatformId(void)
#}

# Removed in 9.0:
#declare 10 win {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}

# 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








|

|
|



|
<

<












|

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

|









<
|
|
<
<
>
|
|
|
<
>

|

<
|
|
<
>
|
|
|
<
>







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
}

# TIP 431: temporary directory creation function
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}

declare 259 {
    unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *lengthPtr)
}

declare 260 {
    void TclUnusedStubEntry(void)

}

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

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tclIntPlat

################################
# Windows specific functions

declare 0 win {
    void TclWinConvertError(DWORD errCode)
}

declare 1 win {
    void TclWinConvertWSAError(DWORD errCode)


}
declare 2 win {
    struct servent *TclWinGetServByName(const char *nm,
	    const char *proto)


}
declare 3 win {
    int TclWinGetSockOpt(SOCKET s, int level, int optname,
	    char *optval, int *optlen)

}
declare 4 win {
    HINSTANCE TclWinGetTclInstance(void)
}
# 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)
#  }

declare 6 win {
    unsigned short TclWinNToHS(unsigned short ns)


}
declare 7 win {
    int TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char *optval, int optlen)

}
declare 8 win {
    int TclpGetPid(Tcl_Pid pid)
}

declare 9 win {
    int TclWinGetPlatformId(void)

}
# 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):
#declare 10 win {
#    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}

# Pipe channel functions

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
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)
}
# Removed in 9.0:
#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 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)
#}


# 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)
#}


################################
# Unix specific functions

# Pipe channel functions

declare 0 unix {







|

<
|
|
<
>




















<
|
|
<
>









<
|
|
<
>







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
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(HANDLE hProcess, DWORD id)
}

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 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by generic TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}

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


declare 28 win {
    void TclWinResetInterfaces(void)

}

################################
# Unix specific functions

# Pipe channel functions

declare 0 unix {
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

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)
#}
# Removed in 9.0:

#declare 12 unix {
#    struct tm *TclpGmtime_unix(const time_t *clock)
#}
# Removed in 9.0:

#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)
}







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







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

declare 9 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

# Added in 8.4:


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)


}
declare 12 unix {
    struct tm *TclpGmtime_unix(const time_t *clock)


}
declare 13 unix {
    char *TclpInetNtoa(struct in_addr addr)

}

# Added in 8.5:

declare 14 unix {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
Changes to generic/tclInt.h.
20
21
22
23
24
25
26














27
28
29
30
31
32
33
#define _TCLINT

/*
 * Some numerics configuration options.
 */

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








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







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#define _TCLINT

/*
 * Some numerics configuration options.
 */

#undef ACCEPT_NAN

/*
 * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
 * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
 * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
 * releases.  Perhaps Tcl 8.7 will add even better public interfaces
 * supporting all the re-invocation mechanisms extensions like Itcl 3
 * need.  As an absolute last resort, folks who must make Itcl 3 work
 * unchanged with Tcl 8.7 can remove this line to regain the migration
 * support.  Tcl 9 will no longer offer even that option.
 */

#define AVOID_HACKS_FOR_ITCL 1


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

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 */

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







<







75
76
77
78
79
80
81

82
83
84
85
86
87
88
 */

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>

#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
208
209
210
211
212
213
214



215
216
217
218
219
220
221
 * 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.







>
>
>







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
 * 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 TCL_AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------
 * Data structures related to namespaces.
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
				 * 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
				 * 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
				 * 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
				 * 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
				 * registered using "namespace export". */
    size_t maxExportPatterns;	/* Number of export patterns for which space
				 * is currently allocated. */
    size_t 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
				 * 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;







|
|



|



|




















|

|

|




|







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
				 * 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
    unsigned 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. */
    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. */
    unsigned 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. */
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    unsigned 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. */
    unsigned 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
    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
				 * 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. */
    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;







|










|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
    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. */
    unsigned 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. */
    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;
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namespace 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.) */
    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;
				/* Hash table of ensemble subcommand names,







|







463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namespace 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.) */
    unsigned 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,
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
    void *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
				 * 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)







|







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    void *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. */
    unsigned 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
				 * 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. */
	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
				 * 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. */







|









|







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
				 * 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
				 * 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;
    unsigned 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. */
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
 */

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







|







952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
 */

typedef struct CompiledLocal {
    struct CompiledLocal *nextPtr;
				/* Next compiler-recognized local variable for
				 * this procedure, or NULL if this is the last
				 * local. */
    int nameLength;		/* The number of bytes in local variable's name.
				 * Among others used to speed up var 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. */
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
 * 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
				 * 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







|







986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
 * 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. */
    unsigned 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
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101

/*
 * 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 numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])








|







1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117

/*
 * 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 {
    unsigned int refCount;
    int numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])

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
	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;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} 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
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    size_t 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 */







|










|





|







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
	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... */
    int len;			/* ... and its length. */
    const struct CFWordBC *litarg;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    unsigned int refCount;	/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    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 */
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
    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
				 * proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
    size_t length;			/* Length of array. */
    ExtraFrameInfoField fields[2];
				/* Really as long as necessary, but this is
				 * long enough for nearly anything. */
} ExtraFrameInfo;

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







|







1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
    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
				 * proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
    int length;			/* Length of array. */
    ExtraFrameInfoField fields[2];
				/* Really as long as necessary, but this is
				 * long enough for nearly anything. */
} ExtraFrameInfo;

/*
 *----------------------------------------------------------------
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, void *clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;







|







1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459

/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, ClientData clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;
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

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
				 * 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. */
    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
				 * **buckets. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t 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.
 */







|



|













|

|

|

|







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

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. */
    unsigned 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, (unsigned)-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. */
    unsigned int numBuckets; /* Total number of buckets allocated at
				 * **buckets. */
    unsigned int numEntries; /* Total number of entries present in
				 * table. */
    unsigned int rebuildSize; /* Enlarge table when numEntries gets to be
				 * this large. */
    unsigned 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.
 */
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
				 * 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
				 * 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
				 * 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. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */







|




|







1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
				 * 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. */
    unsigned 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. */
    unsigned 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. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */
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
 *----------------------------------------------------------------
 */

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





     */

    const char *legacyResult;


    void (*legacyFreeProc) (void);






    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
				 * enabled extensions check for a NULL pointer value
				 * and for a TCL_STUBS_MAGIC value to verify they
				 * are not [load]ing into one of those pre-stubs
				 * interps.
				 */

    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
				 * per-interp basis. */

    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







|













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


|
>
>
|
>
>
>
>
>
>




|
|
|
|
<
|
<
|
<












>
|
>
>
>
>
>
>
>







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

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. */
    int 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 {
    /*
     * 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.

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

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

				 * have to do some careful checking before we

				 * 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
				 * per-interp basis. */
    union {
	void (*optimizer)(void *envPtr);
	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
				 * unused space in interp was repurposed for
				 * pluggable bytecode optimizers. The core
				 * contains one optimizer, which can be
				 * selectively overridden by extensions. */
    } extra;

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

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







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
















|





>





|







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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    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. */
#else
    char *appendResultDontUse;
    int appendAvlDontUse;
    int appendUsedDontUse;
#endif

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

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








    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







>
>
>
>
>
>
>
>







1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
    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. */
#if TCL_MAJOR_VERSION < 9
# if !defined(TCL_NO_DEPRECATED)
    char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
				/* Static space holding small results. */
# else
    char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
# endif
#endif
    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
				 * 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
				 * 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. */








|







2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
				 * 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. */

	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

    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
				 * because of ensemble processing. */
	size_t numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */








|

|







2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079

    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. */
	int numRemovedObjs;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	int numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */

2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
#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 {







|







2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
#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 %u bytes", (size)),1)))

/*
 * The following enum values are used to specify the runtime platform setting
 * of the tclPlatform variable.
 */

typedef enum {
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
 * 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 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. */
} 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)







|













|







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
 * 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 {
    unsigned 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. */
} List;

#define LIST_MAX \
	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
#define LIST_SIZE(numElems) \
	(unsigned)(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)
2436
2437
2438
2439
2440
2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
2451
2452
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * 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) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))







|
>
|
|







2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * and Tcl_GetIntForIndex.
 *
 * WARNING: these macros eval their args more than once.
 */

#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
    (((objPtr)->typePtr == &tclIntType)			\
	? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: ((objPtr)->typePtr == &tclBooleanType)			\
	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=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) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (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) \
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (size_t)(endValue) + 1)) \
	    ? ((*(idxPtr) = (size_t)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

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







|
|







2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
	    && (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) \
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
	    ? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

/*
 * 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,
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
 * 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 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







|







2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
 * 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 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
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

/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *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.
 */

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
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the global string
				 * copy when a "get" request comes in before
				 * any "set" request has been received. */







|











|

|







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

/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned 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.
 */

typedef struct ProcessGlobalValue {
    unsigned int epoch;		/* Epoch counter to detect changes in the
				 * global value. */
    unsigned int numBytes;	/* Length of the global string. */
    char *value;		/* The global string value. */
    Tcl_Encoding encoding;	/* system encoding when global string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the global string
				 * copy when a "get" request comes in before
				 * any "set" request has been received. */
2654
2655
2656
2657
2658
2659
2660




2661
2662
2663
2664
2665
2666
2667
/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_INT		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.







>
>
>
>







2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_INT		2
#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
#   define TCL_NUMBER_LONG		1 /* deprecated, not used any more */
#   define TCL_NUMBER_WIDE		TCL_NUMBER_INT /* deprecated */
#endif
#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.
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
/*
 * 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;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;







|







2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
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;
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
/*
 *----------------------------------------------------------------
 * 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);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
			    int loc);
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 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);
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	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,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
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,
			    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. */
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;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *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);







|












|






|
|





>
>














|



|








|


|











|

|







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
/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    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,
			    int loc);
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, int 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 int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const void *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	TclCheckBadOctal(Tcl_Interp *interp,
			    const char *value);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
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,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
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, ClientData 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,
			    int *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    int 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;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    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);
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
MODULE_SCOPE double	TclFloor(const void *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,
			    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,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    size_t *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,
			    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,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(void *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);







|















|








|












|

|


|

|

|







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
MODULE_SCOPE double	TclFloor(const void *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,
			    ClientData 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, 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,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    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(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoCoroutineCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
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);
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
			    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 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	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);
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);
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);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
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);
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);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    size_t *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 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 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);







|
|







|

















|
|



|

|
|






|










|
|
|

|



















|







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
			    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, int fromIdx,
			    int toIdx);
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, 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,
			    int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, int numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    int numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    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);
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,
			    int len);
MODULE_SCOPE int	TclpDeleteFile(const void *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, ClientData clientData,
			    int stackSize, int flags);
MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    unsigned 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 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 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);
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
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE size_t	TclScanElement(const char *string, size_t length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    void *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, size_t subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    size_t 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,
			    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,
			    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);
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 *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
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);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);








#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







|

|














|


|


|



|




|




|




|
|
|
|
|
|






|













|















>
>
>
>
>
>
>







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
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE int	TclScanElement(const char *string, int length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    void *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    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, int 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, 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,
			    int numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    int 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 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 int	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(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
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);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(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
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

MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
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);


/*
 * 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);
#	define TclIsSpaceProcM(byte) \
		(((byte) > 0x20) ? 0 : TclIsSpaceProc(byte))

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	Tcl_AfterObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_AppendObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ApplyObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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_CatchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CdObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclChanCreateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPostEventObjCmd(void *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,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CloseObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ConcatObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ContinueObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/* Assemble command function */
MODULE_SCOPE int	Tcl_AssembleObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExecObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExprObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FblockedObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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_FlushObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForeachObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FormatObjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GetsObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobalObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IncrObjCmd(void *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,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LassignObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LindexObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LinsertObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LlengthObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ListObjCmd(void *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,
			    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,
			    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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreverseObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsearchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PackageObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PidObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PwdObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegexpObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegsubObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RenameObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ScanObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SeekObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SetObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SplitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SocketObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SourceObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SwitchObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeRateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(void *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,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpdateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UplevelObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpvarObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VariableObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VwaitObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_WhileObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------
 * Compilation procedures for commands in the generic core:
 *----------------------------------------------------------------







|




















|


|


|




|


>
>
>
>
>
|


|



|


|


|

|





|


|


|




|

|








|




|


|



|


|


|


|


|


|


|



|

|



|


|


|


|


|


|


|


|


|


|



|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|


|



|


|


|


|



|


|


|


|


|


|


|


|


|


|


|


|


|


|



|


|


|


|

|


|


|


|


|


|


|


|


|


|


|


|







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

MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
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, int length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);


/*
 * 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);
#	define TclIsSpaceProcM(byte) \
		(((byte) > 0x20) ? 0 : TclIsSpaceProc(byte))

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	Tcl_AfterObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_AppendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ApplyObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPostEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPushObjCmd(ClientData 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,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CloseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ConcatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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,
			    ClientData clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    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(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/* Assemble command function */
MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExecObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExprObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FblockedObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FlushObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForeachObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FormatObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GetsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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(ClientData clientData,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LassignObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LindexObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LinsertObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LmapObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LpopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LremoveObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreverseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsearchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclNamespaceEnsembleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_OpenObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PwdObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegexpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegsubObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RenameObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RepresentationCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReturnObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ScanObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SeekObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SplitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SocketObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
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(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeRateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpdateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UplevelObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpvarObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VariableObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VwaitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------
 * Compilation procedures for commands in the generic core:
 *----------------------------------------------------------------
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
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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,
			    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,







|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|





|







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
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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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(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,
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
 * 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)







|

|

|

|







4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
 * 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,
			    int start);
MODULE_SCOPE Tcl_Obj *	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int first, int 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)
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
 */

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







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







4160
4161
4162
4163
4164
4165
4166













4167
4168
4169
4170
4171
4172
4173
 */

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 int	TclFullFinalizationRequested(void);














/*
 * Just for the purposes of command-type registration.
 */

MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
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
} 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







|













|
|


|
|







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
} 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);

/*
 * 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,
			    int before, int after, int *indexPtr);
MODULE_SCOPE int	TclIndexDecode(int encoded, int endValue);

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           (-2)
#define TCL_INDEX_START         (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
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
    (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'.
 * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
 */

# define TclDecrRefCount(objPtr) \
    if ((objPtr)->refCount-- > 1) ; else { \
	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
	    TCL_DTRACE_OBJ_FREE(objPtr); \
	    if ((objPtr)->bytes \
		    && ((objPtr)->bytes != &tclEmptyString)) { \
		Tcl_Free((objPtr)->bytes); \
	    } \
	    (objPtr)->length = TCL_INDEX_NONE; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }








|









|

|







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
    (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 == -1'.
 * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
 */

# define TclDecrRefCount(objPtr) \
    if ((objPtr)->refCount-- > 1) ; else { \
	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
	    TCL_DTRACE_OBJ_FREE(objPtr); \
	    if ((objPtr)->bytes \
		    && ((objPtr)->bytes != &tclEmptyString)) { \
		ckfree((objPtr)->bytes); \
	    } \
	    (objPtr)->length = -1; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
 * 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) \
	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))

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

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

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from







|


|







4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
 * 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) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

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

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

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
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
 *----------------------------------------------------------------
 * 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);
 *
 * 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)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (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))

#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 \
	    ? NULL : Tcl_GetString((objPtr)), \
	    *(lenPtr) = (objPtr)->length, (objPtr)->bytes))
#define TclGetUnicodeFromObj(objPtr, lenPtr) \
    (Tcl_GetUnicodeFromObj((objPtr), NULL), \
	    *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \
	    Tcl_GetUnicodeFromObj((objPtr), NULL))
#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:
 *







|











|




















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

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







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
 *----------------------------------------------------------------
 * 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, 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)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *) ckalloc((len) + 1); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (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))




















#define TclGetStringFromObj(objPtr, lenPtr) \
    ((objPtr)->bytes \

	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\



	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))






/*
 *----------------------------------------------------------------
 * 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:
 *
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
 */

#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; \
	} \
    } while (0)

/*
 * These form part of the native filesystem support. They are needed here







|







4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
 */

#define TclInvalidateStringRep(objPtr) \
    do { \
	Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \
	if (_isobjPtr->bytes != NULL) { \
	    if (_isobjPtr->bytes != &tclEmptyString) { \
		ckfree((char *)_isobjPtr->bytes); \
	    } \
	    _isobjPtr->bytes = NULL; \
	} \
    } while (0)

/*
 * These form part of the native filesystem support. They are needed here
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
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) Tcl_AttemptRealloc((char *) oldPtr,	\
		    (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;					\
	}								\
    } while (0)

#define TclGrowParseTokenArray(parsePtr, append)			\
    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\







|
|





|
|




|







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
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
		    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 *) ckrealloc((char *) oldPtr,	\
			allocated * sizeof(Tcl_Token)); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			(used) * sizeof(Tcl_Token));		\
	    }								\
	    (tokenPtr) = newPtr;					\
	}								\
    } while (0)

#define TclGrowParseTokenArray(parsePtr, append)			\
    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
 *----------------------------------------------------------------
 * 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; \







|





|







4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
 *----------------------------------------------------------------
 * 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,
 *				int numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfChars(numChars, bytes, numBytes) \
    do { \
	int _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; \
4699
4700
4701
4702
4703
4704
4705


4706
4707
4708
4709
4710
4711
4712
 * 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))


#endif /* WORDS_BIGENDIAN */

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to increment a namespace's export epoch
 * counter. The ANSI C "prototype" for this macro is:
 *







>
>







4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
 * 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
 * counter. The ANSI C "prototype" for this macro is:
 *
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
 *----------------------------------------------------------------
 * 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	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);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewIndexObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)((w) + 1) - 1;	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
	(objPtr)->internalRep.doubleValue = (double)(d);	\







|

















<
<
<
<
<
<
<
<
<
<
<







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
 *----------------------------------------------------------------
 * 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	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    } while (0)












#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
	(objPtr)->internalRep.doubleValue = (double)(d);	\
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
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewIndexObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj((Tcl_WideInt)((w) + 1) - 1)

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

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







<
<
<












|












|







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
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)




#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), (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), (int) (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:
4899
4900
4901
4902
4903
4904
4905








4906
4907
4908
4909
4910
4911
4912
#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif









/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */
#ifndef offsetof
#   define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field))
#endif

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







>
>
>
>
>
>
>
>







4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
#    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 astructure.
 * Computes number of bytes from beginning of structure to a given field.
 */

#if !defined(TCL_NO_DEPRECATED) && !defined(BUILD_tcl)
#   define TclOffset(type, field) ((int) offsetof(type, field))
#endif
/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */
#ifndef offsetof
#   define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
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
 * 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)		\
    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 ((location) != NULL			    \
	    && (location--) <= 1) {		    \
	    Tcl_Free(((location)));		    \
	}					    \
	(location) = (cmdPtr);			    \
    } while (0)


#define TclRoutineHasName(cmdPtr) \
    ((cmdPtr)->hPtr != NULL)







|












|







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
 * 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)		\
    do {					\
	if ((cmdPtr)->refCount-- <= 1) {	\
	    ckfree(cmdPtr);			\
	}					\
    } while (0)


/*
 * inside this routine crement refCount first incase cmdPtr is replacing itself
 */
#define TclRoutineAssign(location, cmdPtr)	    \
    do {					    \
	(cmdPtr)->refCount++;			    \
	if ((location) != NULL			    \
	    && (location--) <= 1) {		    \
	    ckfree(((location)));		    \
	}					    \
	(location) = (cmdPtr);			    \
    } while (0)


#define TclRoutineHasName(cmdPtr) \
    ((cmdPtr)->hPtr != NULL)
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
	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;						\







|







5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
	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;						\
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
 * 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"

#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:
 */







|














|
|
|
|










|
|












|
|
|











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
 * 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;
    ClientData 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] = (ClientData)(data0);			\
	_callbackPtr->data[1] = (ClientData)(data1);			\
	_callbackPtr->data[2] = (ClientData)(data2);			\
	_callbackPtr->data[3] = (ClientData)(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 = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  ckfree(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif

#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"

#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc(size)        TclpAlloc(size)
#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
#define Tcl_Free(ptr)                 TclpFree(ptr)
#endif

#endif /* _TCLINT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIntDecls.h.
23
24
25
26
27
28
29

















30
31
32
33
34
35
36
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif


















/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tclInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */







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







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
#   define tclGetIntForIndex tcl_GetIntForIndex
/* Those macro's are especially for Itcl 3.4 compatibility */
#   define tclCreateNamespace tcl_CreateNamespace
#   define tclDeleteNamespace tcl_DeleteNamespace
#   define tclAppendExportList tcl_AppendExportList
#   define tclExport tcl_Export
#   define tclImport tcl_Import
#   define tclForgetImport tcl_ForgetImport
#   define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
#   define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
#   define tclFindNamespace tcl_FindNamespace
#   define tclFindCommand tcl_FindCommand
#   define tclGetCommandFromObj tcl_GetCommandFromObj
#   define tclGetCommandFullName tcl_GetCommandFullName
#endif /* !defined(TCL_NO_DEPRECATED) */

/*
 * 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. */
51
52
53
54
55
56
57
58
59
60




61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111



112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145


146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196


197
198
199
200
201
202
203
204
205
206
207
208




209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241


242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257


258



259

260


261


262



263
264
265
266
267
268
269
270
271
272
273
274


275


276


277

278

279
280
281
282


283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300


301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348


349


350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367


368


369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400


401

402
403
404


405


406
407
408
409
410
411
412
/* Slot 4 is reserved */
/* 5 */
EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
EXTERN void		TclCleanupCommand(Command *cmdPtr);
/* 7 */
EXTERN size_t		TclCopyAndCollapse(size_t count, const char *src,
				char *dst);
/* Slot 8 is reserved */




/* 9 */
EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
/* 10 */
EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
				const char *procName, Tcl_Obj *argsPtr,
				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
				CallFrame *framePtr);
/* 12 */
EXTERN void		TclDeleteVars(Interp *iPtr,
				TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclDumpMemoryInfo(void *clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
EXTERN int		TclFindElement(Tcl_Interp *interp,
				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, size_t *sizePtr,
				int *bracePtr);
/* 23 */
EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
EXTERN size_t		TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
EXTERN void		TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
/* Slot 30 is reserved */
/* 31 */
EXTERN const char *	TclGetExtension(const char *name);
/* 32 */
EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
				CallFrame **framePtrPtr);
/* Slot 33 is reserved */
/* Slot 34 is reserved */



/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
/* 38 */
EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
				const char *qualName, Namespace *cxtNsPtr,
				int flags, Namespace **nsPtrPtr,
				Namespace **altNsPtrPtr,
				Namespace **actualCxtPtrPtr,
				const char **simpleNamePtr);
/* 39 */
EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
/* 40 */
EXTERN int		TclGetOpenMode(Tcl_Interp *interp, const char *str,
				int *seekFlagPtr);
/* 41 */
EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
/* 42 */
EXTERN const char *	TclpGetUserHome(const char *name,
				Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
/* 44 */
EXTERN int		TclGuessPackageName(const char *fileName,
				Tcl_DString *bufPtr);
/* 45 */
EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
EXTERN int		TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
/* Slot 50 is reserved */


/* 51 */
EXTERN int		TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
EXTERN int		TclInvokeObjectCommand(void *clientData,
				Tcl_Interp *interp, int argc,
				const char **argv);
/* 54 */
EXTERN int		TclInvokeStringCommand(void *clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 55 */
EXTERN Proc *		TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* 58 */
EXTERN Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				const char *msg, int createPart1,
				int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
/* 60 */
EXTERN int		TclNeedSpace(const char *start, const char *end);
/* 61 */
EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
/* 62 */
EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
EXTERN int		TclObjInterpProc(void *clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 64 */
EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
EXTERN void *		TclpAlloc(size_t size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
EXTERN void		TclpFree(void *ptr);
/* 75 */
EXTERN Tcl_WideUInt	TclpGetClicks(void);
/* 76 */
EXTERN Tcl_WideUInt	TclpGetSeconds(void);
/* Slot 77 is reserved */


/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN void *		TclpRealloc(void *ptr, size_t size);
/* 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 */




/* 89 */
EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
EXTERN void		TclProcCleanupProc(Proc *procPtr);
/* 92 */
EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
				Tcl_Obj *bodyPtr, Namespace *nsPtr,
				const char *description,
				const char *procName);
/* 93 */
EXTERN void		TclProcDeleteProc(void *clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
/* 96 */
EXTERN int		TclRenameCommand(Tcl_Interp *interp,
				const char *oldName, const char *newName);
/* 97 */
EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
				Command *newCmdPtr);
/* 98 */
EXTERN int		TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
EXTERN const char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* Slot 104 is reserved */


/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
/* 110 */
EXTERN int		TclSockMinimumBuffers(void *sock, int size);
/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* Slot 112 is reserved */


/* Slot 113 is reserved */



/* Slot 114 is reserved */

/* Slot 115 is reserved */


/* Slot 116 is reserved */


/* Slot 117 is reserved */



/* 118 */
EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
				const char *name, Tcl_ResolverInfo *resInfo);
/* 119 */
EXTERN int		Tcl_GetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolverInfo *resInfo);
/* 120 */
EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
				const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* Slot 121 is reserved */


/* Slot 122 is reserved */


/* Slot 123 is reserved */


/* Slot 124 is reserved */

/* Slot 125 is reserved */

/* 126 */
EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
				Tcl_Var variable, Tcl_Obj *objPtr);
/* Slot 127 is reserved */


/* 128 */
EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
				Tcl_CallFrame *framePtr,
				Tcl_Namespace *nsPtr, int isProcCallFrame);
/* 130 */
EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
				const char *name);
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int		TclpHasSockets(Tcl_Interp *interp);
/* Slot 133 is reserved */


/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				void *clientData);
/* 143 */
EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
EXTERN void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
EXTERN TclHandle	TclHandleCreate(void *ptr);
/* 147 */
EXTERN void		TclHandleFree(TclHandle handle);
/* 148 */
EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				size_t *startPtr, size_t *endPtr);
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
				int status);
/* 157 */
EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* Slot 158 is reserved */


/* Slot 159 is reserved */


/* Slot 160 is reserved */
/* 161 */
EXTERN int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
EXTERN void		TclChannelEventScriptInvoker(void *clientData,
				int flags);
/* 163 */
EXTERN const void *	TclGetInstructionTable(void);
/* 164 */
EXTERN void		TclExpandCodeArray(void *envPtr);
/* 165 */
EXTERN void		TclpSetInitialEncodings(void);
/* 166 */
EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
/* Slot 167 is reserved */


/* Slot 168 is reserved */


/* 169 */
EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
				size_t n);
/* 170 */
EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 171 */
EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 172 */
EXTERN int		TclInThreadExit(void);
/* 173 */
EXTERN int		TclUniCharMatch(const Tcl_UniChar *string,
				size_t strLen, const Tcl_UniChar *pattern,
				size_t ptnLen, int flags);
/* Slot 174 is reserved */
/* 175 */
EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
				Var *varPtr, const char *part1,
				const char *part2, int flags,
				int leaveErrMsg);
/* 176 */
EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
/* 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 */

/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* Slot 182 is reserved */


/* Slot 183 is reserved */


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







|

|
>
>
>
>

















|












|




|














|
>
>
>




















|












|
>
>




|



|



















|










|







|

|
|
>
>




|






|
>
>
>
>












|













|





|
>
>















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











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



|
>
>

















|
>
>













|



















|
|












|
>
>
|
>
>





|











|
>
>
|
>
>


|


|




|






|
|












|
>
>
|
>


|
>
>
|
>
>







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
/* Slot 4 is reserved */
/* 5 */
EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
EXTERN void		TclCleanupCommand(Command *cmdPtr);
/* 7 */
EXTERN int		TclCopyAndCollapse(int count, const char *src,
				char *dst);
/* 8 */
TCL_DEPRECATED("")
int			TclCopyChannelOld(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				int toRead, Tcl_Obj *cmdPtr);
/* 9 */
EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
/* 10 */
EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
				const char *procName, Tcl_Obj *argsPtr,
				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
/* 11 */
EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
				CallFrame *framePtr);
/* 12 */
EXTERN void		TclDeleteVars(Interp *iPtr,
				TclVarHashTable *tablePtr);
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclDumpMemoryInfo(ClientData clientData, int flags);
/* Slot 15 is reserved */
/* 16 */
EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
EXTERN int		TclFindElement(Tcl_Interp *interp,
				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, int *sizePtr,
				int *bracePtr);
/* 23 */
EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
EXTERN int		TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
EXTERN void		TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* 28 */
EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
/* Slot 29 is reserved */
/* Slot 30 is reserved */
/* 31 */
EXTERN const char *	TclGetExtension(const char *name);
/* 32 */
EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
				CallFrame **framePtrPtr);
/* Slot 33 is reserved */
/* 34 */
TCL_DEPRECATED("Use Tcl_GetIntForIndex")
int			TclGetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int endValue, int *indexPtr);
/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
/* 38 */
EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
				const char *qualName, Namespace *cxtNsPtr,
				int flags, Namespace **nsPtrPtr,
				Namespace **altNsPtrPtr,
				Namespace **actualCxtPtrPtr,
				const char **simpleNamePtr);
/* 39 */
EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
/* 40 */
EXTERN int		TclGetOpenMode(Tcl_Interp *interp, const char *str,
				int *seekFlagPtr);
/* 41 */
EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
/* 42 */
EXTERN CONST86 char *	TclpGetUserHome(const char *name,
				Tcl_DString *bufferPtr);
/* Slot 43 is reserved */
/* 44 */
EXTERN int		TclGuessPackageName(const char *fileName,
				Tcl_DString *bufPtr);
/* 45 */
EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
EXTERN int		TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
/* 50 */
EXTERN void		TclInitCompiledLocals(Tcl_Interp *interp,
				CallFrame *framePtr, Namespace *nsPtr);
/* 51 */
EXTERN int		TclInterpInit(Tcl_Interp *interp);
/* Slot 52 is reserved */
/* 53 */
EXTERN int		TclInvokeObjectCommand(ClientData clientData,
				Tcl_Interp *interp, int argc,
				const char **argv);
/* 54 */
EXTERN int		TclInvokeStringCommand(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 55 */
EXTERN Proc *		TclIsProc(Command *cmdPtr);
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* 58 */
EXTERN Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				const char *msg, int createPart1,
				int createPart2, Var **arrayPtrPtr);
/* Slot 59 is reserved */
/* 60 */
EXTERN int		TclNeedSpace(const char *start, const char *end);
/* 61 */
EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
/* 62 */
EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
/* 63 */
EXTERN int		TclObjInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 64 */
EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
/* 69 */
EXTERN void *		TclpAlloc(unsigned int size);
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* 74 */
EXTERN void		TclpFree(void *ptr);
/* 75 */
EXTERN unsigned long	TclpGetClicks(void);
/* 76 */
EXTERN unsigned long	TclpGetSeconds(void);
/* 77 */
TCL_DEPRECATED("")
void			TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN void *		TclpRealloc(void *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
TCL_DEPRECATED("")
char *			TclPrecTraceProc(ClientData clientData,
				Tcl_Interp *interp, const char *name1,
				const char *name2, int flags);
/* 89 */
EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
/* Slot 90 is reserved */
/* 91 */
EXTERN void		TclProcCleanupProc(Proc *procPtr);
/* 92 */
EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
				Tcl_Obj *bodyPtr, Namespace *nsPtr,
				const char *description,
				const char *procName);
/* 93 */
EXTERN void		TclProcDeleteProc(ClientData clientData);
/* Slot 94 is reserved */
/* Slot 95 is reserved */
/* 96 */
EXTERN int		TclRenameCommand(Tcl_Interp *interp,
				const char *oldName, const char *newName);
/* 97 */
EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
				Command *newCmdPtr);
/* 98 */
EXTERN int		TclServiceIdle(void);
/* Slot 99 is reserved */
/* Slot 100 is reserved */
/* 101 */
EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* 104 */
TCL_DEPRECATED("")
int			TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
/* 110 */
EXTERN int		TclSockMinimumBuffers(void *sock, int size);
/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
EXTERN int		TclAppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
EXTERN Tcl_Namespace *	TclCreateNamespace(Tcl_Interp *interp,
				const char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
EXTERN void		TclDeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
EXTERN int		TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int resetListFirst);
/* 116 */
EXTERN Tcl_Command	TclFindCommand(Tcl_Interp *interp, const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
EXTERN Tcl_Namespace *	TclFindNamespace(Tcl_Interp *interp,
				const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 118 */
EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
				const char *name, Tcl_ResolverInfo *resInfo);
/* 119 */
EXTERN int		Tcl_GetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolverInfo *resInfo);
/* 120 */
EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
				const char *name,
				Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
EXTERN int		TclForgetImport(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
EXTERN Tcl_Command	TclGetCommandFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 123 */
EXTERN void		TclGetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
EXTERN Tcl_Namespace *	TclGetCurrentNamespace_(Tcl_Interp *interp);
/* 125 */
EXTERN Tcl_Namespace *	TclGetGlobalNamespace_(Tcl_Interp *interp);
/* 126 */
EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
				Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
EXTERN int		TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int allowOverwrite);
/* 128 */
EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
/* 129 */
EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
				Tcl_CallFrame *framePtr,
				Tcl_Namespace *nsPtr, int isProcCallFrame);
/* 130 */
EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
				const char *name);
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 132 */
EXTERN int		TclpHasSockets(Tcl_Interp *interp);
/* 133 */
TCL_DEPRECATED("")
struct tm *		TclpGetDate(const time_t *time, int useGMT);
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				ClientData clientData);
/* 143 */
EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
/* 144 */
EXTERN void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
/* 145 */
EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
/* 146 */
EXTERN TclHandle	TclHandleCreate(void *ptr);
/* 147 */
EXTERN void		TclHandleFree(TclHandle handle);
/* 148 */
EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
				int *startPtr, int *endPtr);
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
/* Slot 154 is reserved */
/* Slot 155 is reserved */
/* 156 */
EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
				int status);
/* 157 */
EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* 158 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void			TclSetStartupScriptFileName(const char *filename);
/* 159 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
const char *		TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
/* 161 */
EXTERN int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
/* 162 */
EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
				int flags);
/* 163 */
EXTERN const void *	TclGetInstructionTable(void);
/* 164 */
EXTERN void		TclExpandCodeArray(void *envPtr);
/* 165 */
EXTERN void		TclpSetInitialEncodings(void);
/* 166 */
EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
/* 167 */
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
void			TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
Tcl_Obj *		TclGetStartupScriptPath(void);
/* 169 */
EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
				unsigned long n);
/* 170 */
EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 171 */
EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
				const char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
/* 172 */
EXTERN int		TclInThreadExit(void);
/* 173 */
EXTERN int		TclUniCharMatch(const Tcl_UniChar *string,
				int strLen, const Tcl_UniChar *pattern,
				int ptnLen, int flags);
/* Slot 174 is reserved */
/* 175 */
EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
				Var *varPtr, const char *part1,
				const char *part2, int flags,
				int leaveErrMsg);
/* 176 */
EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
/* 177 */
EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *operation,
				const char *reason);
/* 178 */
EXTERN void		TclSetStartupScript(Tcl_Obj *pathPtr,
				const char *encodingName);
/* 179 */
EXTERN Tcl_Obj *	TclGetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
TCL_DEPRECATED("")
struct tm *		TclpLocaltime(const time_t *clock);
/* 183 */
TCL_DEPRECATED("")
struct tm *		TclpGmtime(const time_t *clock);
/* 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 */
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
EXTERN void		TclpFindExecutable(const char *argv0);
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp, size_t numBytes);
/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);







|







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
EXTERN void		TclpFindExecutable(const char *argv0);
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
/* 225 */
EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
/* 226 */
EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
EXTERN void		TclSetNsPath(Namespace *nsPtr, size_t pathLength,
				Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);
/* 230 */
EXTERN Var *		TclObjLookupVar(Tcl_Interp *interp,







|







549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
/* 225 */
EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
/* 226 */
EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
/* 227 */
EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
				Tcl_Namespace *pathAry[]);
/* Slot 228 is reserved */
/* 229 */
EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);
/* 230 */
EXTERN Var *		TclObjLookupVar(Tcl_Interp *interp,
501
502
503
504
505
506
507
508


509
510
511
512

513
514
515
516
517
518
519
520
EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
/* 234 */
EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
				const char *key, int *newPtr);
/* 235 */
EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* Slot 236 is reserved */


/* 237 */
EXTERN int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
EXTERN int		TclNRInterpProc(void *clientData, Tcl_Interp *interp,

				int objc, Tcl_Obj *const objv[]);
/* 239 */
EXTERN int		TclNRInterpProcCore(Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc *errorProc);
/* 240 */
EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
				struct NRE_callback *rootPtr);







|
>
>



|
>
|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
/* 234 */
EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
				const char *key, int *newPtr);
/* 235 */
EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* 236 */
TCL_DEPRECATED("use Tcl_BackgroundException")
void			TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
EXTERN int		TclNRInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
/* 239 */
EXTERN int		TclNRInterpProcCore(Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc *errorProc);
/* 240 */
EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
				struct NRE_callback *rootPtr);
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
EXTERN void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
EXTERN Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
EXTERN Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
EXTERN int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				size_t numRemoved, size_t numInserted,
				Tcl_Obj *const *objv);
/* 247 */
EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
EXTERN void		TclSetChildCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
EXTERN int		TclRegisterLiteral(void *envPtr, const char *bytes,
				size_t length, int flags);
/* 252 */
EXTERN Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, const int flags);
/* 253 */
EXTERN Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,







|
















|







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
EXTERN void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
EXTERN Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
EXTERN Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
EXTERN int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				int numRemoved, int numInserted,
				Tcl_Obj *const *objv);
/* 247 */
EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
EXTERN void		TclSetChildCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
EXTERN int		TclRegisterLiteral(void *envPtr, const char *bytes,
				int length, int flags);
/* 252 */
EXTERN Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, const int flags);
/* 253 */
EXTERN Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
578
579
580
581
582
583
584
585
586
587
588
589


590
591
592
593
594
595
596
597
598
599
600
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
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 258 */
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);



typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    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 */
    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 (*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 (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    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 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    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 */
    int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*reserved50)(void);
    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 */
    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 */
    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 (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
    void (*reserved90)(void);
    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 */
    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 (*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);
    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 (*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);
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    void (*reserved127)(void);
    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 */
    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 */
    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 */
    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 (*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);
    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 (*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 */
    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 */
    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);







<
<
<

|
>
>












|
|





|







|

|









|







|







|


|
|








|





|





|
|
|



|






|




|







|


|







|
|
|
|
|
|



|
|
|
|
|

|





|








|








|






|
|


|




|
|
|
|
|

|




|
|


|
|







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
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */



EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *lengthPtr);
/* 260 */
EXTERN void		TclUnusedStubEntry(void);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
    TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (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) (ClientData clientData, int flags); /* 14 */
    void (*reserved15)(void);
    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, int *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
    int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    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);
    TCL_DEPRECATED_API("Use Tcl_GetIntForIndex") int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
    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 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
    CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
    void (*reserved43)(void);
    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 (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
    void (*reserved52)(void);
    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const 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 */
    Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
    int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
    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);
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*reserved68)(void);
    void * (*tclpAlloc) (unsigned int size); /* 69 */
    void (*reserved70)(void);
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (void *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    void * (*tclpRealloc) (void *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
    void (*reserved86)(void);
    void (*reserved87)(void);
    TCL_DEPRECATED_API("") 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 (*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) (ClientData clientData); /* 93 */
    void (*reserved94)(void);
    void (*reserved95)(void);
    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);
    CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
    int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
    int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
    void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
    int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
    Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
    void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
    int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
    Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
    Tcl_Namespace * (*tclFindNamespace) (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 */
    int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
    Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
    void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
    Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
    Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    int (*tclImport) (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 */
    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
    int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
    TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
    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, 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 */
    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, 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 */
    TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
    TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
    void (*reserved160)(void);
    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
    const 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 */
    TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
    TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") 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, int strLen, const Tcl_UniChar *pattern, int 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 */
    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 (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
    Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
    void (*reserved180)(void);
    void (*reserved181)(void);
    TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
    TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
    void (*reserved184)(void);
    void (*reserved185)(void);
    void (*reserved186)(void);
    void (*reserved187)(void);
    void (*reserved188)(void);
    void (*reserved189)(void);
    void (*reserved190)(void);
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
    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 */
    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 */
    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);
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    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 */
    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 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    void (*reserved236)(void);
    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 (*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 */
    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 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 260 */

} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif







|











|








|

|







|




|







<
|
>







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
    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 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    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);
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    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, int 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 */
    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 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData 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 (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int 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 */

    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */
    void (*tclUnusedStubEntry) (void); /* 260 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif
875
876
877
878
879
880
881
882

883
884
885
886
887
888
889
/* Slot 4 is reserved */
#define TclCleanupChildren \
	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
#define TclCleanupCommand \
	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#define TclCopyAndCollapse \
	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
/* Slot 8 is reserved */

#define TclCreatePipeline \
	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
#define TclCreateProc \
	(tclIntStubsPtr->tclCreateProc) /* 10 */
#define TclDeleteCompiledLocalVars \
	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
#define TclDeleteVars \







|
>







951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
/* Slot 4 is reserved */
#define TclCleanupChildren \
	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
#define TclCleanupCommand \
	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#define TclCopyAndCollapse \
	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
#define TclCopyChannelOld \
	(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
#define TclCreatePipeline \
	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
#define TclCreateProc \
	(tclIntStubsPtr->tclCreateProc) /* 10 */
#define TclDeleteCompiledLocalVars \
	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
#define TclDeleteVars \
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#define TclGetExtension \
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
/* Slot 34 is reserved */

/* Slot 35 is reserved */
/* Slot 36 is reserved */
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \







|
>







991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#define TclGetExtension \
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
#define TclGetIntForIndex \
	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \
939
940
941
942
943
944
945
946

947
948
949
950
951
952
953
#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
/* Slot 50 is reserved */

#define TclInterpInit \
	(tclIntStubsPtr->tclInterpInit) /* 51 */
/* Slot 52 is reserved */
#define TclInvokeObjectCommand \
	(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
#define TclInvokeStringCommand \
	(tclIntStubsPtr->tclInvokeStringCommand) /* 54 */







|
>







1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
#define TclInitCompiledLocals \
	(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
#define TclInterpInit \
	(tclIntStubsPtr->tclInterpInit) /* 51 */
/* Slot 52 is reserved */
#define TclInvokeObjectCommand \
	(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
#define TclInvokeStringCommand \
	(tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
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
/* Slot 73 is reserved */
#define TclpFree \
	(tclIntStubsPtr->tclpFree) /* 74 */
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */

/* Slot 77 is reserved */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* Slot 88 is reserved */

#define TclPreventAliasLoop \
	(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
/* Slot 90 is reserved */
#define TclProcCleanupProc \
	(tclIntStubsPtr->tclProcCleanupProc) /* 91 */
#define TclProcCompileProc \
	(tclIntStubsPtr->tclProcCompileProc) /* 92 */







>
|











|
>







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
/* Slot 73 is reserved */
#define TclpFree \
	(tclIntStubsPtr->tclpFree) /* 74 */
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
	(tclIntStubsPtr->tclpGetTime) /* 77 */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
#define TclPrecTraceProc \
	(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
#define TclPreventAliasLoop \
	(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
/* Slot 90 is reserved */
#define TclProcCleanupProc \
	(tclIntStubsPtr->tclProcCleanupProc) /* 91 */
#define TclProcCompileProc \
	(tclIntStubsPtr->tclProcCompileProc) /* 92 */
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
/* Slot 100 is reserved */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */

/* Slot 104 is reserved */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#define TclTeardownNamespace \
	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */

/* Slot 112 is reserved */

/* Slot 113 is reserved */

/* Slot 114 is reserved */

/* Slot 115 is reserved */

/* Slot 116 is reserved */

/* Slot 117 is reserved */
#define Tcl_GetInterpResolvers \
	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */

/* Slot 121 is reserved */

/* Slot 122 is reserved */

/* Slot 123 is reserved */

/* Slot 124 is reserved */

/* Slot 125 is reserved */
#define Tcl_GetVariableFullName \
	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */

/* Slot 127 is reserved */
#define Tcl_PopCallFrame \
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#define Tcl_SetNamespaceResolvers \
	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#define TclpHasSockets \
	(tclIntStubsPtr->tclpHasSockets) /* 132 */

/* Slot 133 is reserved */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#define TclGetEnv \
	(tclIntStubsPtr->tclGetEnv) /* 138 */
/* Slot 139 is reserved */







>
|











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






>
|
>
|
>
|
>
|
>
|


>
|










>
|







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
/* Slot 100 is reserved */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */
#define TclSockMinimumBuffersOld \
	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#define TclTeardownNamespace \
	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define TclAppendExportList \
	(tclIntStubsPtr->tclAppendExportList) /* 112 */
#define TclCreateNamespace \
	(tclIntStubsPtr->tclCreateNamespace) /* 113 */
#define TclDeleteNamespace \
	(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
#define TclExport \
	(tclIntStubsPtr->tclExport) /* 115 */
#define TclFindCommand \
	(tclIntStubsPtr->tclFindCommand) /* 116 */
#define TclFindNamespace \
	(tclIntStubsPtr->tclFindNamespace) /* 117 */
#define Tcl_GetInterpResolvers \
	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#define TclForgetImport \
	(tclIntStubsPtr->tclForgetImport) /* 121 */
#define TclGetCommandFromObj \
	(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
#define TclGetCommandFullName \
	(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
#define TclGetCurrentNamespace_ \
	(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
#define TclGetGlobalNamespace_ \
	(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
#define Tcl_GetVariableFullName \
	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#define TclImport \
	(tclIntStubsPtr->tclImport) /* 127 */
#define Tcl_PopCallFrame \
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#define Tcl_SetNamespaceResolvers \
	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#define TclpHasSockets \
	(tclIntStubsPtr->tclpHasSockets) /* 132 */
#define TclpGetDate \
	(tclIntStubsPtr->tclpGetDate) /* 133 */
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#define TclGetEnv \
	(tclIntStubsPtr->tclGetEnv) /* 138 */
/* Slot 139 is reserved */
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
	(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
/* Slot 154 is reserved */
/* Slot 155 is reserved */
#define TclRegError \
	(tclIntStubsPtr->tclRegError) /* 156 */
#define TclVarTraceExists \
	(tclIntStubsPtr->tclVarTraceExists) /* 157 */

/* Slot 158 is reserved */

/* Slot 159 is reserved */
/* Slot 160 is reserved */
#define TclChannelTransform \
	(tclIntStubsPtr->tclChannelTransform) /* 161 */
#define TclChannelEventScriptInvoker \
	(tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
#define TclGetInstructionTable \
	(tclIntStubsPtr->tclGetInstructionTable) /* 163 */
#define TclExpandCodeArray \
	(tclIntStubsPtr->tclExpandCodeArray) /* 164 */
#define TclpSetInitialEncodings \
	(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
#define TclListObjSetElement \
	(tclIntStubsPtr->tclListObjSetElement) /* 166 */

/* Slot 167 is reserved */

/* Slot 168 is reserved */
#define TclpUtfNcmp2 \
	(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
#define TclCheckInterpTraces \
	(tclIntStubsPtr->tclCheckInterpTraces) /* 170 */
#define TclCheckExecutionTraces \
	(tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */
#define TclInThreadExit \
	(tclIntStubsPtr->tclInThreadExit) /* 172 */
#define TclUniCharMatch \
	(tclIntStubsPtr->tclUniCharMatch) /* 173 */
/* Slot 174 is reserved */
#define TclCallVarTraces \
	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
#define TclCleanupVar \
	(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
	(tclIntStubsPtr->tclVarErrMsg) /* 177 */

/* Slot 178 is reserved */

/* Slot 179 is reserved */
/* Slot 180 is reserved */
/* Slot 181 is reserved */

/* Slot 182 is reserved */

/* Slot 183 is reserved */
/* 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 */







>
|
>
|













>
|
>
|

















>
|
>
|


>
|
>
|







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
	(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
/* Slot 154 is reserved */
/* Slot 155 is reserved */
#define TclRegError \
	(tclIntStubsPtr->tclRegError) /* 156 */
#define TclVarTraceExists \
	(tclIntStubsPtr->tclVarTraceExists) /* 157 */
#define TclSetStartupScriptFileName \
	(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
#define TclGetStartupScriptFileName \
	(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
/* Slot 160 is reserved */
#define TclChannelTransform \
	(tclIntStubsPtr->tclChannelTransform) /* 161 */
#define TclChannelEventScriptInvoker \
	(tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
#define TclGetInstructionTable \
	(tclIntStubsPtr->tclGetInstructionTable) /* 163 */
#define TclExpandCodeArray \
	(tclIntStubsPtr->tclExpandCodeArray) /* 164 */
#define TclpSetInitialEncodings \
	(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
#define TclListObjSetElement \
	(tclIntStubsPtr->tclListObjSetElement) /* 166 */
#define TclSetStartupScriptPath \
	(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
#define TclGetStartupScriptPath \
	(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
#define TclpUtfNcmp2 \
	(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
#define TclCheckInterpTraces \
	(tclIntStubsPtr->tclCheckInterpTraces) /* 170 */
#define TclCheckExecutionTraces \
	(tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */
#define TclInThreadExit \
	(tclIntStubsPtr->tclInThreadExit) /* 172 */
#define TclUniCharMatch \
	(tclIntStubsPtr->tclUniCharMatch) /* 173 */
/* Slot 174 is reserved */
#define TclCallVarTraces \
	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
#define TclCleanupVar \
	(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
#define TclSetStartupScript \
	(tclIntStubsPtr->tclSetStartupScript) /* 178 */
#define TclGetStartupScript \
	(tclIntStubsPtr->tclGetStartupScript) /* 179 */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
	(tclIntStubsPtr->tclpLocaltime) /* 182 */
#define TclpGmtime \
	(tclIntStubsPtr->tclpGmtime) /* 183 */
/* 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 */
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234
1235
	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
#define TclGetSrcInfoForPc \
	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */

/* Slot 236 is reserved */
#define TclResetCancellation \
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */
#define TclNRInterpProcCore \
	(tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
#define TclNRRunCallbacks \







>
|







1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
#define TclGetSrcInfoForPc \
	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
#define TclBackgroundException \
	(tclIntStubsPtr->tclBackgroundException) /* 236 */
#define TclResetCancellation \
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */
#define TclNRInterpProcCore \
	(tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
#define TclNRRunCallbacks \
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
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclAppendUnicodeToObj \
	(tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */
#define TclGetBytesFromObj \
	(tclIntStubsPtr->tclGetBytesFromObj) /* 260 */



#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */




#if defined(USE_TCL_STUBS)











#undef Tcl_StaticPackage










#define Tcl_StaticPackage \
	(tclIntStubsPtr->tclStaticPackage)
#endif /* defined(USE_TCL_STUBS) */


#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT


#endif /* _TCLINTDECLS */







<
<

|
>
>





>
>
>

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

>
|
|
>


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
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */


#define TclGetBytesFromObj \
	(tclIntStubsPtr->tclGetBytesFromObj) /* 259 */
#define TclUnusedStubEntry \
	(tclIntStubsPtr->tclUnusedStubEntry) /* 260 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#if defined(USE_TCL_STUBS)
#   undef TclGetStartupScriptFileName
#   undef TclSetStartupScriptFileName
#   undef TclGetStartupScriptPath
#   undef TclSetStartupScriptPath
#   undef TclBackgroundException
#   undef TclSetStartupScript
#   undef TclGetStartupScript
#   undef TclGetIntForIndex
#   undef TclCreateNamespace
#   undef TclDeleteNamespace
#   undef TclAppendExportList
#   undef TclExport
#   undef TclImport
#   undef TclForgetImport
#   undef TclGetCurrentNamespace_
#   undef TclGetGlobalNamespace_
#   undef TclFindNamespace
#   undef TclFindCommand
#   undef TclGetCommandFromObj
#   undef TclGetCommandFullName
#   undef TclCopyChannelOld
#   undef TclSockMinimumBuffersOld
#   undef Tcl_StaticPackage
#   define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage)
#endif

#undef TclGuessPackageName
#ifndef TCL_NO_DEPRECATED
#   define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0)
#endif

#endif /* _TCLINTDECLS */
Changes to generic/tclIntPlatDecls.h.
63
64
65
66
67
68
69
70

71

72

73

74
75
76
77
78
79
80
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */

/* Slot 11 is reserved */

/* Slot 12 is reserved */

/* Slot 13 is reserved */

/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,







|
>
|
>
|
>
|
>







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
110
111
112
113
114
115
116
117
118

119


120


121
122
123
124
125

126


127
128
129

130

131
132
133
134
135
136
137
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void		TclWinConvertError(int errCode);
/* Slot 1 is reserved */

/* Slot 2 is reserved */


/* Slot 3 is reserved */


/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* Slot 6 is reserved */

/* Slot 7 is reserved */


/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */

/* Slot 10 is reserved */

/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,







|
|
>
|
>
>
|
>
>

|


|
>
|
>
>

|
|
>
|
>







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void		TclWinConvertError(DWORD errCode);
/* 1 */
EXTERN void		TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent *	 TclWinGetServByName(const char *nm,
				const char *proto);
/* 3 */
EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
				char *optval, int *optlen);
/* 4 */
EXTERN HINSTANCE	TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN unsigned short	TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
151
152
153
154
155
156
157
158
159

160
161
162
163
164
165
166

167
168
169

170
171
172
173
174
175
176
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, size_t id);
/* Slot 21 is reserved */

/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* Slot 26 is reserved */

/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* Slot 28 is reserved */

/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* WIN */







|
|
>






|
>


|
>







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* 21 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* WIN */
197
198
199
200
201
202
203
204

205

206

207

208
209
210
211
212
213
214
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */

/* Slot 11 is reserved */

/* Slot 12 is reserved */

/* Slot 13 is reserved */

/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,







|
>
|
>
|
>
|
>







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
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 (*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 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    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 */
    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 (*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);
    void (*reserved3)(void);
    void * (*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);
    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 (*tclpIsAtty) (int fd); /* 16 */
    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);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, 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 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    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 */
    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);







|
|
|
|



















|
|
|
|
|

|
|
|
|
|









|
|




|

|














|
|
|
|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
    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 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (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 (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#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 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    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 (*tclpIsAtty) (int fd); /* 16 */
    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) (HANDLE hProcess, DWORD id); /* 20 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (int index, 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 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (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);
381
382
383
384
385
386
387
388
389
390
391




392
393
394
395
396
397
398
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* 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 \







|
|
|
|
>
>
>
>







402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
415
416
417
418
419
420
421
422
423
424



425
426
427
428
429
430


431
432
433
434




435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455

456
457
458
459
460
461
462

463
464
465


466
467
468
469
470
471
472
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */



#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */


#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */




#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */

#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */

#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */


#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \







|
|
|
>
>
>




|
|
>
>


<
<
>
>
>
>




















|
>






|
>


<
>
>







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462


463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498

499
500
501
502
503
504
505
506
507
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \
	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#define TclWinGetSockOpt \
	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclWinNToHS \
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */


#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */

#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
485
486
487
488
489
490
491
492
493
494
495




496
497
498
499
500
501
502
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* 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 \







|
|
|
|
>
>
>
>







520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
523
524
525
526
527
528
529



530


531
532
533
534
535
536
537
538
539
540
541
542

















543
544
545
546
547

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT



#define TclWinConvertWSAError TclWinConvertError



#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#undef TclMacOSXGetFileAttribute /* 15 */
#undef TclMacOSXSetFileAttribute /* 16 */
#undef TclMacOSXCopyFileAttributes /* 17 */
#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */
#endif

#if !defined(_WIN32)

















#   undef TclpGetPid
#   define TclpGetPid(pid) ((size_t)(pid))
#endif

#endif /* _TCLINTPLATDECLS */







>
>
>

>
>











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

|



562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError
#undef TclpInetNtoa
#define TclpInetNtoa inet_ntoa

#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#undef TclMacOSXGetFileAttribute /* 15 */
#undef TclMacOSXSetFileAttribute /* 16 */
#undef TclMacOSXCopyFileAttributes /* 17 */
#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */
#endif

#if defined(_WIN32)
#   undef TclWinNToHS
#   undef TclWinGetServByName
#   undef TclWinGetSockOpt
#   undef TclWinSetSockOpt
#   undef TclWinGetPlatformId
#   undef TclWinResetInterfaces
#   undef TclWinSetInterfaces
#   if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#	define TclWinNToHS ntohs
#	define TclWinGetServByName getservbyname
#	define TclWinGetSockOpt getsockopt
#	define TclWinSetSockOpt setsockopt
#	define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
#	define TclWinResetInterfaces() /* nop */
#	define TclWinSetInterfaces(dummy) /* nop */
#   endif /* TCL_NO_DEPRECATED */
#else
#   undef TclpGetPid
#   define TclpGetPid(pid) ((int)(size_t)(pid))
#endif

#endif /* _TCLINTPLATDECLS */
Changes to generic/tclInterp.c.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

static const char *tclPreInitScript = NULL;

/* Forward declaration */
struct Target;

/*
 * 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
 * the source command is invoked.
 */

typedef struct {
    Tcl_Obj *token;		/* Token for the alias command in the child
				 * interp. This used to be the command name in
				 * the child 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







|






|







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

static const char *tclPreInitScript = NULL;

/* Forward declaration */
struct Target;

/*
 * 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
 * the source command is invoked.
 */

typedef struct Alias {
    Tcl_Obj *token;		/* Token for the alias command in the child
				 * interp. This used to be the command name in
				 * the child 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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
				 * the structure, which will be extended to
				 * accomodate the remaining objects in the
				 * prefix. */
} Alias;

/*
 *
 * Child:
 *
 * 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.
 */

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







|






|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
				 * the structure, which will be extended to
				 * accomodate the remaining objects in the
				 * prefix. */
} Alias;

/*
 *
 * struct Child:
 *
 * 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.
 */

typedef struct Child {
    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
				 * table. */
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    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:
 *
 * 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
 * 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
 * only load safe extensions.
 */

typedef struct {
    Tcl_HashTable childTable;	/* Hash table for child interpreters. Maps
				 * from command names to Child 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
				 * to commands in this interpreter. This list
				 * is used to remove dangling pointers from
				 * the child (or sibling) interpreters when
				 * this interpreter is deleted. */
} Parent;

/*
 * The following structure keeps track of all the Parent and Child 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. */
} 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 {
    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 {
    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;

/*







|














|
















|













|












|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    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;

/*
 * struct Parent:
 *
 * 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
 * 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
 * only load safe extensions.
 */

typedef struct Parent {
    Tcl_HashTable childTable;	/* Hash table for child interpreters. Maps
				 * from command names to Child 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
				 * to commands in this interpreter. This list
				 * is used to remove dangling pointers from
				 * the child (or sibling) interpreters when
				 * this interpreter is deleted. */
} Parent;

/*
 * The following structure keeps track of all the Parent and Child information
 * on a per-interp basis.
 */

typedef struct InterpInfo {
    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. */
} 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 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 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;

/*
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Parent *parentPtr;
    Child *childPtr;

    interpInfoPtr = (InterpInfo *)Tcl_Alloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    parentPtr = &interpInfoPtr->parent;
    Tcl_InitHashTable(&parentPtr->childTable, TCL_STRING_KEYS);
    parentPtr->targetsPtr = NULL;

    childPtr = &interpInfoPtr->child;







|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Parent *parentPtr;
    Child *childPtr;

    interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    parentPtr = &interpInfoPtr->parent;
    Tcl_InitHashTable(&parentPtr->childTable, TCL_STRING_KEYS);
    parentPtr->targetsPtr = NULL;

    childPtr = &interpInfoPtr->child;
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
     */

    if (childPtr->aliasTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&childPtr->aliasTable);

    Tcl_Free(interpInfoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *







|







575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
     */

    if (childPtr->aliasTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&childPtr->aliasTable);

    ckfree(interpInfoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *
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
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    Tcl_Interp *childInterp;
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",









	"eval",		"exists",	"expose",
	"hide",		"hidden",	"issafe",
	"invokehidden",	"limit",	"marktrusted",	"recursionlimit",
#ifndef TCL_NO_DEPRECATED
	"slaves",
#endif
	"share",	"target",	"transfer",
	NULL
    };
    enum option {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
	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,
#ifndef TCL_NO_DEPRECATED
	OPT_SLAVES,
#endif
	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
    };

    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 option) index) {
    case OPT_ALIAS: {
	Tcl_Interp *parentInterp;

	if (objc < 4) {
	aliasArgs:
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "childPath childCmd ?parentPath parentCmd? ?arg ...?");







>
>
>
>
>
>
>
>
>



<
<
<
|
<

|


|
|
|
<
<
<
|






|
|
>
>
>


|







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
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    Tcl_Interp *childInterp;
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",	"hide",
	"hidden",	"issafe",	"invokehidden",
	"limit",	"marktrusted",	"recursionlimit",
	"share",	"slaves",	"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",



	"share",	"target",	"transfer",	NULL

    };
    enum interpOptionEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
	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_SLAVES,	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) {
	/* Don't report the "slaves" option as possibility */
	Tcl_GetIndexFromObj(interp, objv[1], optionsNoSlaves,
		"option", 0, &index);
	return TCL_ERROR;
    }
    switch ((enum interpOptionEnum)index) {
    case OPT_ALIAS: {
	Tcl_Interp *parentInterp;

	if (objc < 4) {
	aliasArgs:
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "childPath childCmd ?parentPath parentCmd? ?arg ...?");
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
	return ChildBgerror(interp, childInterp, objc - 3, objv + 3);
    case OPT_CANCEL: {
	int i, flags;
	Tcl_Obj *resultObjPtr;
	static const char *const cancelOptions[] = {
	    "-unwind",	"--",	NULL
	};
	enum option {
	    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 option) index) {
	    case OPT_UNWIND:
		/*
		 * The evaluation stack in the target interp is to be unwound.
		 */

		flags |= TCL_CANCEL_UNWIND;
		break;







|














|







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
	return ChildBgerror(interp, childInterp, 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;
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
	/*
	 * Weird historical rules: "-safe" is accepted at the end, too.
	 */

	childPtr = 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) {
		    return TCL_ERROR;
		}
		if (index == OPT_SAFE) {
		    safe = 1;
		    continue;







|







790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
	/*
	 * Weird historical rules: "-safe" is accepted at the end, too.
	 */

	childPtr = NULL;
	last = 0;
	for (i = 2; i < objc; i++) {
	    if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
		if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
			"option", 0, &index) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (index == OPT_SAFE) {
		    safe = 1;
		    continue;
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
#ifndef TCL_NO_DEPRECATED
    case OPT_SLAVES:
#endif
    case OPT_CHILDREN: {
	InterpInfo *iiPtr;
	Tcl_Obj *resultPtr;
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch hashSearch;
	char *string;

	childInterp = GetInterp2(interp, objc, objv);







<
|
<
|







1024
1025
1026
1027
1028
1029
1030

1031

1032
1033
1034
1035
1036
1037
1038
1039
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);

    case OPT_CHILDREN:

    case OPT_SLAVES: {
	InterpInfo *iiPtr;
	Tcl_Obj *resultPtr;
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch hashSearch;
	char *string;

	childInterp = GetInterp2(interp, objc, objv);
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
	aliasName = TclGetString(objv[3]);

	iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "alias \"%s\" in path \"%s\" not found",
		    aliasName, TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    NULL);
	    return TCL_ERROR;
	}
	aliasPtr = (Alias *)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_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    }







|








|







1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
	aliasName = TclGetString(objv[3]);

	iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "alias \"%s\" in path \"%s\" not found",
		    aliasName, Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    NULL);
	    return TCL_ERROR;
	}
	aliasPtr = (Alias *)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, Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    }
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
	*targetNamePtr = TclGetString(objv[0]);
    }
    if (argcPtr != NULL) {
	*argcPtr = objc - 1;
    }
    if (argvPtr != NULL) {
	*argvPtr = (const char **)
		Tcl_Alloc(sizeof(const char *) * (objc - 1));
	for (i = 1; i < objc; i++) {
	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
	}
    }
    return TCL_OK;
}








|







1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
	*targetNamePtr = TclGetString(objv[0]);
    }
    if (argcPtr != NULL) {
	*argcPtr = objc - 1;
    }
    if (argvPtr != NULL) {
	*argvPtr = (const char **)
		ckalloc(sizeof(const char *) * (objc - 1));
	for (i = 1; i < objc; i++) {
	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
	}
    }
    return TCL_OK;
}

1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Child *childPtr;
    Parent *parentPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = parentInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;








|







1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Child *childPtr;
    Parent *parentPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = parentInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;

1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

	cmdPtr = (Command *) aliasPtr->childCmd;
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;
	Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);

	Tcl_Free(aliasPtr);

	/*
	 * The result was already set by TclPreventAliasLoop.
	 */

	Tcl_Release(childInterp);
	Tcl_Release(parentInterp);







|







1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586

	cmdPtr = (Command *) aliasPtr->childCmd;
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;
	Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);

	ckfree(aliasPtr);

	/*
	 * The result was already set by TclPreventAliasLoop.
	 */

	Tcl_Release(childInterp);
	Tcl_Release(parentInterp);
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
     * 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;

    parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent;
    targetPtr->nextPtr = parentPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (parentPtr->targetsPtr != NULL) {







|







1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
     * 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 *)ckalloc(sizeof(Target));
    targetPtr->childCmd = aliasPtr->childCmd;
    targetPtr->childInterp = childInterp;

    parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent;
    targetPtr->nextPtr = parentPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (parentPtr->targetsPtr != NULL) {
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
    /*
     * If the alias has been renamed in the child, the parent 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));
    if (hPtr == NULL) {
	return TCL_OK;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
    Tcl_SetObjResult(interp, prefixPtr);
    return TCL_OK;







|







1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
    /*
     * If the alias has been renamed in the child, the parent 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, Tcl_GetString(namePtr));
    if (hPtr == NULL) {
	return TCL_OK;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
    Tcl_SetObjResult(interp, prefixPtr);
    return TCL_OK;
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848

    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:







|
|







1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851

    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:
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076

	parentPtr->targetsPtr = targetPtr->nextPtr;
    }
    if (targetPtr->nextPtr != NULL) {
	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
    }

    Tcl_Free(targetPtr);
    Tcl_Free(aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChild --
 *







|
|







2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079

	parentPtr->targetsPtr = targetPtr->nextPtr;
    }
    if (targetPtr->nextPtr != NULL) {
	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
    }

    ckfree(targetPtr);
    ckfree(aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChild --
 *
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
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
	"eval",		"expose",	"hide",		"hidden",
	"issafe",	"invokehidden",	"limit",	"marktrusted",
	"recursionlimit", NULL
    };
    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
    };

    if (childInterp == NULL) {
	Tcl_Panic("TclChildObjCmd: 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 options) index) {
    case OPT_ALIAS:
	if (objc > 2) {
	    if (objc == 3) {
		return AliasDescribe(interp, childInterp, objv[2]);
	    }
	    if (TclGetString(objv[3])[0] == '\0') {
		if (objc == 4) {







|



















|







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
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
	"eval",		"expose",	"hide",		"hidden",
	"issafe",	"invokehidden",	"limit",	"marktrusted",
	"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,
	OPT_RECLIMIT
    };

    if (childInterp == NULL) {
	Tcl_Panic("TclChildObjCmd: 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) {
    case OPT_ALIAS:
	if (objc > 2) {
	    if (objc == 3) {
		return AliasDescribe(interp, childInterp, objv[2]);
	    }
	    if (TclGetString(objv[3])[0] == '\0') {
		if (objc == 4) {
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
	 * LIMIT_HANDLER_DELETED flag.
	 */

	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *







|







3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
	 * LIMIT_HANDLER_DELETED flag.
	 */

	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
     */

    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
	deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = (LimitHandler *)Tcl_Alloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*







|






|







3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
     */

    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
	return;
    }
}

/*
 *----------------------------------------------------------------------







|







3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
	return;
    }
}

/*
 *----------------------------------------------------------------------
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }

    /*
     * Delete all time-limit handlers.
     */








|







3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }

    /*
     * Delete all time-limit handlers.
     */

3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	}
    }

    /*
     * Delete the timer callback that is used to trap limits that occur in
     * [vwait]s...
     */







|







3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
	    }
	    ckfree(handlerPtr);
	}
    }

    /*
     * Delete the timer callback that is used to trap limits that occur in
     * [vwait]s...
     */
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    Tcl_Free(limitCBPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CallScriptLimitCallback --
 *







|







4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    ckfree(limitCBPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CallScriptLimitCallback --
 *
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
    if (!isNew) {
	limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    limitCBPtr = (ScriptLimitCallback *)Tcl_Alloc(sizeof(ScriptLimitCallback));
    limitCBPtr->interp = interp;
    limitCBPtr->scriptObj = scriptObj;
    limitCBPtr->entryPtr = hashPtr;
    limitCBPtr->type = type;
    Tcl_IncrRefCount(scriptObj);

    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,







|







4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
    if (!isNew) {
	limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    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,
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t 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;







<
|







4571
4572
4573
4574
4575
4576
4577

4578
4579
4580
4581
4582
4583
4584
4585
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {

	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;
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t 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);







<
|







4776
4777
4778
4779
4780
4781
4782

4783
4784
4785
4786
4787
4788
4789
4790
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	return TCL_ERROR;
    } else {

	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);
Changes to generic/tclLink.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

/*
 * 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 {
    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. */
    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;







|







|


|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

/*
 * 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 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. */
    int bytes;			/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    int 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;
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	    TCL_GLOBAL_ONLY, LinkTraceProc, 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->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) \







|







167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    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) \
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
    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;







|













|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
    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. */
    int 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 *)ckalloc(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;
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369

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








|




















|










|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369

	/*
	 * If no address is given create one and use as address the
         * not needed linkPtr->lastValue
	 */

	if (addr == NULL) {
	    linkPtr->lastValue.aryPtr = ckalloc(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 = ckalloc(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 = ckalloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_LAST;
    }

    /*
     * Initialize allocated space.
     */

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

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







|
|

|
|




|


|
|







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

static int
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;

    str = TclGetString(objPtr);
    if ((objPtr->length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->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;
	    }
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
	    }
	}
    }
    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)
{







|
|
|
|







<
|

|
|


|







|
|
|
|







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
	    }
	}
    }
    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"
 * (upperand lowercase). See bug [39f6304c2e].
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{

    const char *str = TclGetString(objPtr);

    if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0')
	    && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((objPtr->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 lowercase) and sequences like "1e-". See bug [39f6304c2e].
 */

static int
GetInvalidDoubleFromObj(
    Tcl_Obj *objPtr,
    double *doublePtr)
{
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
				/* Links can only be made to global variables,
				 * 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;
    size_t valueLength = 0;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;







|







750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
				/* Links can only be made to global variables,
				 * 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;
    int valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    LinkFree(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_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
	return NULL;
    }

    /*







|







774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    LinkFree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
	return NULL;
    }

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

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







|
>


|




|














|







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

    /*
     * Special cases.
     */

    switch (linkPtr->type) {
    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = (char *)ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) Tcl_GetStringFromObj(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 *) Tcl_GetByteArrayFromObj(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 {
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958

    /*
     * 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) {







|







944
945
946
947
948
949
950
951
952
953
954
955
956
957
958

    /*
     * 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
		|| objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
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

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    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);
    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++) {
		objv[i] = Tcl_NewWideIntObj(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);
    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);
    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);
    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);
    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);
    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++) {
		objv[i] = Tcl_NewWideIntObj(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++) {
		objv[i] = Tcl_NewWideIntObj(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++) {
		objv[i] = Tcl_NewWideIntObj(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++) {
		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);







|





|




|







|

|


|







|




|







|




|







|




|







|




|







|




|







|




|







|

|


|








|

|


|







|

|


|








|




|







|

|



|







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

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    int 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 **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewWideIntObj(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 **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewWideIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewWideIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewWideIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewWideIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(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 **)ckalloc(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);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
LinkFree(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    if (linkPtr->nsPtr) {
	TclNsDecrRefCount(linkPtr->nsPtr);
    }
    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	Tcl_Free(linkPtr->addr);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	Tcl_Free(linkPtr->lastValue.aryPtr);
    }
    Tcl_Free(linkPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|


|

|









1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
LinkFree(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    if (linkPtr->nsPtr) {
	TclNsDecrRefCount(linkPtr->nsPtr);
    }
    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	ckfree(linkPtr->addr);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	ckfree(linkPtr->lastValue.aryPtr);
    }
    ckfree((char *) linkPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclListObj.c.
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
#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
 *	how to behave on failure.
 *
 * Value
 *
 *	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.
 *
 * Effect
 *
 *	The refCount of each value in 'objv' is incremented as it is added
 *	to the list.
 *
 *----------------------------------------------------------------------
 */

static List *
NewListIntRep(
    int objc,







|
|
|
|


|
<
|
|
|

|
<
|
|







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

87
88
89
90
91

92
93
94
95
96
97
98
99
100
#endif

/*
 *----------------------------------------------------------------------
 *
 * NewListIntRep --
 *
 *	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.
 *
 * Results:

 *	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.
 *
 * Side effects:

 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
NewListIntRep(
    int objc,
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = (List *)Tcl_AttemptAlloc(LIST_SIZE(objc));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;







|


|







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
152
153
154
155
156
157
158
159
160







161





162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193

194
195


196
197


198

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  AttemptNewList --
 *







 *	Like NewListIntRep, but additionally sets an error message on failure.





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

static List *
AttemptNewList(
    Tcl_Interp *interp,
    int objc,
    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)));
	}
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *

 *	Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
 *	defined, 'Tcl_DbNewListObj' is called instead.


 *
 * Value


 *

 *	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.
 *
 * Effect
 *
 *	The refCount of each elements in 'objv' is incremented as it is added
 *	to the list.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewListObj








|

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



















|












>
|
<
>
>

<
>
>

>
|
|
|
|

|
<
|
|







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205

206
207
208

209
210
211
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * 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
 *	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[])
{
    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 %u bytes",
		    LIST_SIZE(objc)));
	}
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *
 *	This function is normally called when not debugging: i.e., when
 *	TCL_MEM_DEBUG is not defined. It creates a new list object from an

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

 *	When TCL_MEM_DEBUG is defined, this function just returns the result
 *	of calling the debugging version Tcl_DbNewListObj.
 *
 * 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 resulting 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
#undef Tcl_NewListObj

251
252
253
254
255
256
257
258
259



260
261
262
263
264
265











266
267
268
269
270
271
272
    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 *  Tcl_DbNewListObj --
 *



 *	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.
 *
 *	When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.











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

#ifdef TCL_MEM_DEBUG

Tcl_Obj *







|

>
>
>
|
|
|
|

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







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * 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
 *	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, 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 *
317
318
319
320
321
322
323
324



325








326
327
328
329
330
331
332
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of



 *	creating a new one.








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

void
Tcl_SetListObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */







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







344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	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. */
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 * 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
 *	in 'interp' if it is not NULL.
 *
 * Effect
 *
 *	'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. */







|
|
|

|
|
|
|
|
<

|
|
<







399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414

415
416
417

418
419
420
421
422
423
424
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	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.
 *
 * 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.

 *
 * Side effects:
 *	None.

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

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
 *
 *----------------------------------------------------------------------
 */

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;








|
|


|
<




|


|


|







459
460
461
462
463
464
465
466
467
468
469
470

471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Obj *listPtr,		/* List object to take a range from. */
    int fromIdx,		/* Index of first element to include. */
    int toIdx)			/* Index of last element to include. */
{
    Tcl_Obj **elemPtrs;
    int listLen, i, newLen;

    List *listRepPtr;

    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);

    if (fromIdx < 0) {
	fromIdx = 0;
    }
    if (toIdx >= listLen) {
	toIdx = listLen-1;
    }
    if (fromIdx > toIdx) {
	Tcl_Obj *obj;
	TclNewObj(obj);
	return obj;
    }

    newLen = toIdx - fromIdx + 1;

470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502

503
504



505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    /*
     * 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
				 * 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;

    ListGetIntRep(listPtr, listRepPtr);

    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {







|



















|
|
<

<
|
>
|
|
>
>
>

|
|
|
|
|
|

<
<
<
<
<
|
<
>
|



















|
<

|







505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533

534

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549





550

551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
580
581
    /*
     * Delete elements that should not be included.
     */

    for (i = 0; i < fromIdx; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }
    for (i = toIdx + 1; i < 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 --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.

 *

 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    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;

    ListGetIntRep(listPtr, listRepPtr);

    if (listRepPtr == NULL) {
	int result, length;


	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	Appends the elements of elemListPtr to those of listPtr.

 *
 * Value
 *
 *	TCL_OK
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' or 'elemListPtr' are not valid lists.  An error
 *	    message is left in the interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *
 *	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
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */







|
>

|
<
|
<
<
<
|
<
<
|

|
<
|
|
|
|
|
<







589
590
591
592
593
594
595
596
597
598
599

600



601


602
603
604

605
606
607
608
609

610
611
612
613
614
615
616
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	This function appends the elements in the list value referenced by
 *	elemListPtr to the list value referenced by listPtr.
 *
 * Results:

 *	The return value is normally TCL_OK. If listPtr or elemListPtr do not



 *	refer to list values, TCL_ERROR is returned and an error message is


 *	left in the interpreter's result if interp is not NULL.
 *
 * Side effects:

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

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

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	Like 'Tcl_ListObjAppendList', but Appends a single value to a list.



 *
 * Value
 *
 *	TCL_OK
 *
 *	    'objPtr' is appended to the elements of 'listPtr'.
 *
 *	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.
 *
 * Effect
 *
 *	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.
 *
 *----------------------------------------------------------------------
 */

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;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    Tcl_SetListObj(listPtr, 1, &objPtr);
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;







|
>
>
>

|
<
|
<
|
<
<
<
|
|
|

|
<
<
|
>
|
|
|



















|
<

|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	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.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case objPtr is added to

 *	the end of listPtr's list. 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.
 *
 * Side effects:


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

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result, length;


	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    Tcl_SetListObj(listPtr, 1, &objPtr);
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
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
    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */

	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;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }







|






|



|







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
    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */

	attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
	    Tcl_Free(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    ListResetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);







|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
	    ckfree(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    ListResetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);
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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 * 	Retrieve a pointer to the element of 'listPtr' at 'index'.  The index
 * 	of the first element is 0.
 *
 * Value

 *
 * 	TCL_OK
 *
 *	    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.
 *
 * 	TCL_ERROR
 *
 * 	    'listPtr' is not a valid list. An an error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *
 *  Effect
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *
 *----------------------------------------------------------------------
 */

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. */
    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
{
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;







|
|
|
|
>

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

|
<
|















|
<

|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 *	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.
 *
 * Results:

 *	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

 *	converted to one, TCL_ERROR is returned and an error message is left


 *	in the interpreter's result if interp is not NULL.
 *
 * Side effects:

 *	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. */
    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
{
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result, length;


	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 * 	Retrieve the number of elements in a list.


 *
 * Value
 *
 *	TCL_OK
 *
 *	    A count of list elements is stored at the address provided by


 *	    'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
 *	    converted.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.  An error message will be left in
 *	    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. */
{
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *intPtr = 0;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	Replace values in a list.



 *
 *	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 'count' is zero or negative no elements are deleted, and any new
 *	elements are inserted at the beginning of the list.
 *
 * 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.

 *


 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.   An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *
 *	If 'listPtr' is not of type 'tclListType', it is converted if possible.
 *
 *	The 'refCount' of each element appended to the list is incremented.
 *	Similarly, the 'refCount' for each replaced element is decremented.
 *

 *	If 'listPtr' is modified, any previous string representation is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */







|
>
>

|
<
|
<
|
>
>
|
<

<
|
|
<














|
<

|




















|
>
>
>

|
|
|
<
>
|
|

<
<
<
|
|
|
>

>
>
|
<
|
|

|
<
<
|
<
|
<
>
|
|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 *	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.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case *intPtr will be set

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

 *

 * Side effects:
 *	The possible conversion of the argument object to a list object.

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

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. */
{
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result, length;


	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *intPtr = 0;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	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 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

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



 *	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
 *	list object and 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.
 *
 * Side effects:


 *	The ref counts of the objc elements in objv are incremented since the

 *	resulting list now refers to them. Similarly, the ref counts for

 *	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. */
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (objc == 0) {
		return TCL_OK;
	    }
	    Tcl_SetListObj(listPtr, objc, NULL);
	} else {
	    int result = SetListFromAny(interp, listPtr);







|

|







979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (objc == 0) {
		return TCL_OK;
	    }
	    Tcl_SetListObj(listPtr, objc, NULL);
	} else {
	    int result = SetListFromAny(interp, listPtr);
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
    }

    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;
	    needGrow = numRequired > listRepPtr->maxElemCount;







|






|



|







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
    }

    if (needGrow && !isShared) {
	/* Try to use realloc */
	List *newPtr = NULL;
	int attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    ListResetIntRep(listPtr, listRepPtr);
	    elemPtrs = &listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = numRequired > listRepPtr->maxElemCount;
1108
1109
1110
1111
1112
1113
1114

1115



1116
1117
1118
1119
1120
1121
1122

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

	ListResetIntRep(listPtr, listRepPtr);







>

>
>
>







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138

	    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 */
#if TCL_MAJOR_VERSION > 8
			Tcl_DecrRefCount(objv[i]);
#else
			objv[i]->refCount--;
#endif
		    }
		    return TCL_ERROR;
		}
	    }
	}

	ListResetIntRep(listPtr, listRepPtr);
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
	    start = first + count;
	    numAfterLast = numElems - start;
	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,
			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }

	    Tcl_Free(oldListRepPtr);
	}
    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */








|







1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
	    start = first + count;
	    numAfterLast = numElems - start;
	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,
			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }

	    ckfree(oldListRepPtr);
	}
    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */

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
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	Implements 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.
 *
 * Value
 *
 *	A pointer to the specified element, with its 'refCount' incremented, or
 *	NULL if an error occurred.
 *
 * Notes





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

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. */
    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 ((listRepPtr == NULL)
	    && TclGetIntForIndexM(NULL , argPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }








|

|
|
|
|

|
|
<
<

|
>
>
>
>
>











|











|







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
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	This procedure handles the 'lindex' command when objc==3.
 *
 * 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.
 *
 * Side effects:
 *	None.


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

    int index;			/* Index into the list. */
    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 ((listRepPtr == NULL)
	    && TclGetIntForIndexM(NULL , argPtr, INT_MAX - 1, &index) == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

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
    Tcl_DecrRefCount(indexListCopy);
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  TclLindexFlat --
 *
 * 	The core of the 'lindex' command, with all index
 * 	arguments presented as a flat list.
 *
 *  Value



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




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







|

|
|

|
>
>
>

<
<
>
|

>
>
>
>
|
|
<

















<
|







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
    Tcl_DecrRefCount(indexListCopy);
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexFlat --
 *
 *	This procedure is the core of the 'lindex' command, with all index
 *	arguments presented as a flat list.
 *
 * 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.
 *


 * 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_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++) {

	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

	    break;
	}
	TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index >= (size_t)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)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		TclNewObj(listPtr);
	    } else {







|






|







1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

	    break;
	}
	TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    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], INT_MAX - 1, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		TclNewObj(listPtr);
	    } else {
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
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	The core of [lset] 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.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat', as described


 *	for 'TclLindexList'.
 *
 * Value

 *
 *	The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if

 *	there was an error.




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

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'. */
{
    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. */
    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 (listRepPtr == NULL
	    && TclGetIntForIndexM(NULL, indexArgPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {
	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

    }







|



|
>
>
|

|
>

<
>
|
>
>
>
>














|











|







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
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	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:
 *	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.
 *
 * Side effects:
 *	None.
 *

 * 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'. */
{
    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. */
    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 (listRepPtr == NULL
	    && TclGetIntForIndexM(NULL, indexArgPtr, INT_MAX - 1, &index) == TCL_OK) {
	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

    }
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
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Value
 *

 *	The resulting list
 *
 *	    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
 *	    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
 *	    exactly this.)
 *
 *	NULL
 *
 *	    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.
 *
 *
 * Effect
 *
 *	On entry, the reference count of 'listPtr' does not reflect any
 *	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.


 *
 *	The unshared list is altered directly to produce the result.
 *	'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
 *	representations must be spoilt by threading via 'ptr2' of 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'. */
{
    size_t index;
    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].
     * [lpop] does not use this but protect for NULL valuePtr just in case.







|
|
>
|

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

|
|
|

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

|
|

|















<
|







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
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *
 * 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.
 *

 * 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


 *	point, the reference count will be 1 for either case, so that the


 *	object will appear to be unshared.
 *
 *	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.
 *



 *	If no error occurs, the reference count of the original object is

 *	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.)
 *
 *	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
 *	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'. */
{

    int index, 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].
     * [lpop] does not use this but protect for NULL valuePtr just in case.
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
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++;
	    break;
	}
	indexArray++;

	if (index > (size_t)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_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.
	 */

	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == (size_t)elemCount) {
		TclNewObj(subListPtr);
	    } else {
		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.
	     */

	    if (index == (size_t)elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);







|
|




















|

















|







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
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++;
	    break;
	}
	indexArray++;

	if (index < 0 || index > elemCount
		|| (valuePtr == NULL && index >= 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_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.
	 */

	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == elemCount) {
		TclNewObj(subListPtr);
	    } else {
		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.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);
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
     * 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);
    }
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	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
 *
 * 	TCL_OK
 *
 *	    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
 *	    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.
 *
 * Effect
 *
 *	If 'listPtr' designates a shared object, 'Tcl_Panic' is called.  If
 *	'listPtr' is not already of type 'tclListType', it is converted and 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.
 *


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

int
TclListObjSetElement(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting







|














|

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

|
<
|
|
<
>
|
|

>
>







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
     * 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 == len) {
	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
    } else {
	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
	TclInvalidateStringRep(subListPtr);
    }
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value
 *



 * Results:

 *	The return value is normally TCL_OK. If listPtr does not refer to a





 *	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




 *	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.
 *
 * Side effects:

 *	Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
 *	to convert it to a list with a non-shared internal rep. Decrements the

 *	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
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%d\" out of range", index));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
			"OUTOFRANGE", NULL);
	    }







|
<

|







1791
1792
1793
1794
1795
1796
1797
1798

1799
1800
1801
1802
1803
1804
1805
1806
1807

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result, length;


	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%d\" out of range", index));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
			"OUTOFRANGE", NULL);
	    }
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892

1893

1894
1895
1896
1897
1898
1899
1900
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with the internal representation of a
 *	a list object.
 *
 * Effect

 *

 *	Frees listPtr's List* internal representation, if no longer shared.
 *	May decrement the ref counts of element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void







|
|

|
>

>







1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with a list object's internal
 *	representation.
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

static void
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
    if (listRepPtr->refCount-- <= 1) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	Tcl_Free(listRepPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list 'Tcl_Obj' to share the
 *	internal representation of an existing list object.
 *
 * Effect

 *

 *	The 'refCount' of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */







|








|


|
>

>
|







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
    if (listRepPtr->refCount-- <= 1) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	ckfree(listRepPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list Tcl_Obj to share the
 *	internal representation of an existing list object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
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
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Convert any object to a list.
 *
 * Value
 *
 *    TCL_OK
 *
 *	Success.  The internal representation of 'objPtr' is set, and the type
 *	of 'objPtr' is 'tclListType'.

 *
 *    TCL_ERROR
 *
 *	An error occured during conversion. An error message is left in the
 *	interpreter's result if 'interp' is not NULL.
 *
 *
 *----------------------------------------------------------------------
 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */







|

|
<
|
<
|
<
>

|
<
|
<
|







1962
1963
1964
1965
1966
1967
1968
1969
1970
1971

1972

1973

1974
1975
1976

1977

1978
1979
1980
1981
1982
1983
1984
1985
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Attempt to generate a list internal form for the Tcl object "objPtr".
 *
 * Results:

 *	The return value is TCL_OK or TCL_ERROR. 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, a list is stored as "objPtr"s internal

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

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	int estCount;
	size_t length;
	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */








|
<







2027
2028
2029
2030
2031
2032
2033
2034

2035
2036
2037
2038
2039
2040
2041
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	int estCount, length;

	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
	/*
	 * Each iteration, parse and store a list element.
	 */

	while (nextElem < limit) {
	    const char *elemStart;
	    char *check;
	    size_t elemSize;
	    int literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
	    fail:
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		Tcl_Free(listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    TclNewObj(*elemPtrs);







|
<







|







2051
2052
2053
2054
2055
2056
2057
2058

2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
	/*
	 * Each iteration, parse and store a list element.
	 */

	while (nextElem < limit) {
	    const char *elemStart;
	    char *check;
	    int elemSize, literal;


	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
	    fail:
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		ckfree(listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    TclNewObj(*elemPtrs);
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
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *
 *	Any previously-exising string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *
 * Effect

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

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

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;
    const char *elem, *start;
    char *dst;
    Tcl_Obj **elemPtrs;
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);








|
<
|
|

|
>

|
>
|
|
>










|
<







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
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object. Note: This

 *	function 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
 *	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, length, bytesNeeded = 0;

    const char *elem, *start;
    char *dst;
    Tcl_Obj **elemPtrs;
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);

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
    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);






    }
    bytesNeeded += numElems - 1;

    /*
     * Pass 2: copy into string rep buffer.
     */

    start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|






>
>
>
>
>
>




















|










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
    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = (char *)ckalloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	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);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems - 1;

    /*
     * Pass 2: copy into string rep buffer.
     */

    start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start);

    if (flagPtr != localFlags) {
	ckfree(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
/*
 * 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);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*







|







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 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);

/*
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

    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);
	    entryPtr = nextPtr;
	}
    }

    /*
     * Free up the table's bucket array if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	Tcl_Free(tablePtr->buckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLiteral --







|









|







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

    for (i=0 ; i<tablePtr->numBuckets ; i++) {
	entryPtr = tablePtr->buckets[i];
	while (entryPtr != NULL) {
	    objPtr = entryPtr->objPtr;
	    TclDecrRefCount(objPtr);
	    nextPtr = entryPtr->nextPtr;
	    ckfree(entryPtr);
	    entryPtr = nextPtr;
	}
    }

    /*
     * Free up the table's bucket array if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	ckfree(tablePtr->buckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLiteral --
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const 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
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == TCL_INDEX_NONE) {
	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);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, 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);
		}
		if (globalPtr->refCount != TCL_INDEX_NONE) {
		    globalPtr->refCount++;
		}
		return objPtr;
	    }
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    Tcl_Free((void *)bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.
     */







|
|








|






|














|
















|

|








|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    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;
    unsigned int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

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

	    int objLength;
	    const char *objBytes = TclGetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it
		 */

		if (newPtr) {
		    *newPtr = 0;
		}
		if (globalPtrPtr) {
		    *globalPtrPtr = globalPtr;
		}
		if (flags & LITERAL_ON_HEAP) {
		    ckfree(bytes);
		}
		if (globalPtr->refCount != (unsigned) -1) {
		    globalPtr->refCount++;
		}
		return objPtr;
	    }
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    ckfree(bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.
     */
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288

    /*
     * 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);
    }
#endif

    globalPtr = (LiteralEntry *)Tcl_Alloc(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++;







|



|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288

    /*
     * 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 : length), bytes);
    }
#endif

    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++;
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
		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);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);







|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
 *----------------------------------------------------------------------
 */

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;
}

/*
 *----------------------------------------------------------------------







|


|







347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (unsigned int) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
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
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, 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
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;

    size_t hash, localHash, objIndex;
    int isNew;
    Namespace *nsPtr;

    if (length == TCL_INDEX_NONE) {
	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)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		Tcl_Free((void *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;







|













>
|
|


|

















|







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
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
				 * create an object in CompileEnv's object
				 * array. */
    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
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    unsigned int localHash;
    int objIndex, isNew;
    Namespace *nsPtr;

    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)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, 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",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}








|
|
|







465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, 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 %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
				 * 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;

    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;







|







505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *entryPtr;
    const char *bytes;
    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
    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;

    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from







|
>







550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
    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;
    unsigned int localHash;
    int 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
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;

    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = TCL_INDEX_NONE;	/* i.e., unused */
    lPtr->nextPtr = NULL;

    if (litPtrPtr) {
	*litPtrPtr = lPtr;
    }

    return objIndex;







|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;

    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = (unsigned) -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
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;
	int found;
	size_t length, 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);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}








|
|














|







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
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;
	int length, found;
	size_t 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);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}

754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = (LiteralEntry *)Tcl_Realloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	 * code a Tcl_Realloc equivalent for ourselves.
	 */

	newArrayPtr = (LiteralEntry *)Tcl_Alloc(newSize);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;
    }

    /*
     * Update the local literal table's bucket array.
     */







|


|
|


|







756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	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
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t length, index;


    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);
    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) {
	    /*
	     * 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 (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		Tcl_Free(entryPtr);
		globalTablePtr->numEntries--;

		TclDecrRefCount(objPtr);

#ifdef TCL_COMPILE_STATS
		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/







|
>







|
















|





|







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
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    int length;
    unsigned int index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);
    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) {
	    /*
	     * 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 != (unsigned)-1) && (entryPtr->refCount-- <= 1)) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		ckfree(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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
HashString(
    const char *string,	/* String for which to compute hash value. */
    size_t length)			/* Number of bytes in the string. */
{
    size_t result = 0;

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







|


|

|







894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned
HashString(
    const char *string,	/* String for which to compute hash value. */
    int length)			/* Number of bytes in the string. */
{
    unsigned int result = 0;

    /*
     * 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:
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
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    size_t oldSize, 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*));
    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
	    count>0 ; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->mask = (tablePtr->mask << 2) + 3;







|
>




















|







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
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    unsigned int oldSize, index;
    int count, 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 **)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
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	Tcl_Free(oldBuckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateCmdLiteral --







|







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	ckfree(oldBuckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateCmdLiteral --
1089
1090
1091
1092
1093
1094
1095
1096


1097
1098
1099
1100
1101
1102
1103
 */

char *
TclLiteralStats(
    LiteralTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t 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.







|
>
>







1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
 */

char *
TclLiteralStats(
    LiteralTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS];
    int overflow;
    size_t 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
	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",
	    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",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/








|
|







|







1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    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",
		i, count[i]);
	p += strlen(p);
    }
    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
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *localPtr;
    char *bytes;
    size_t i, length, 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",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : (int) length), bytes, localPtr->refCount);
	    }
	    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",
		"TclVerifyLocalLiteralTable", count,
		localTablePtr->numEntries);
    }
}

/*
 *----------------------------------------------------------------------







|
>

>




|

|

|








|







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
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *localPtr;
    char *bytes;
    size_t i, count;
    int length;

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != (unsigned)-1) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    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 %u",
		"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
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    char *bytes;
    size_t i, length, 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",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)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",
		"TclVerifyGlobalLiteralTable", count,
		globalTablePtr->numEntries);
    }
}
#endif /*TCL_COMPILE_DEBUG*/

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
>

>






|

|








|













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
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    char *bytes;
    size_t i, count;
    int length;

    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 %d",
			"TclVerifyGlobalLiteralTable",
			(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 %u",
		"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.
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch = 0;
    size_t len;
    int index, flags = 0;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const options[] = {
	"-global",		"-lazy",		"--",	NULL
    };
    enum options {
	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 options) index) {
	    flags |= TCL_LOAD_GLOBAL;
	} else if (LOAD_LAZY == (enum options) index) {
	    flags |= TCL_LOAD_LAZY;
	} else {
		break;
	}
    }
    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    fullFileName = TclGetString(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]);
	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_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
		NULL);
	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]);

	target = Tcl_GetChild(interp, childIntName);
	if (target == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
    }







|





|












|

|












|










|



















|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch = 0;
    unsigned 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?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    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 = 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_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
		NULL);
	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 = Tcl_GetString(objv[3]);

	target = Tcl_GetChild(interp, childIntName);
	if (target == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
    }
298
299
300
301
302
303
304

305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
	/*
	 * 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;
		int pElements;
		const 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);
		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);
		    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_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			    "WHATPACKAGE", NULL);
		    code = TCL_ERROR;
		    goto done;
		}
		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.
	 */







>
|
>





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

|
|
|
|
|
|
|

|
|
|
|

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







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312






313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353

354
355
356
357
358
359
360
	/*
	 * Figure out the module name if it wasn't provided explicitly.
	 */

	if (packageName != NULL) {
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	} else {
	    Tcl_Obj *splitPtr, *pkgGuessPtr;
	    int pElements;
	    const char *pkgGuess;

	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */







	    /*
	     * 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 = Tcl_GetString(pkgGuessPtr);
	    if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
		    && (pkgGuess[2] == 'b')) {
		pkgGuess += 3;
	    }
#ifdef __CYGWIN__
	    else 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);
		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_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			"WHATPACKAGE", NULL);
		code = TCL_ERROR;
		goto done;
	    }
	    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.
	 */
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)







|

|


|







392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = (char *)ckalloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = (char *)ckalloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
466
467
468
469
470
471
472

473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490

    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */

    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.







>

|





|
|
|

>







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487

    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */

    if (code != TCL_OK) {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
	Interp *iPtr = (Interp *) target;
	if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
	    /*
	     * 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->result, -1));
	    iPtr->result =  &tclEmptyString;
	    iPtr->freeProc = NULL;
	}
#endif /* defined(TCL_NO_DEPRECATED) */
	Tcl_TransferResult(target, code, interp);
	goto done;
    }

    /*
     * Record the fact that the package has been loaded in the target
     * interpreter.
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

    /*
     * 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);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);







|







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513

    /*
     * 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 *)ckalloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
    int i, index, code, complain = 1, keepLibrary = 0;
    int trustedRefCount = -1, safeRefCount = -1;
    const char *fullFileName = "";
    const char *packageName;
    static const char *const options[] = {
	"-nocomplain", "-keeplibrary", "--", NULL
    };
    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]);
	    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 (index) {
	case UNLOAD_NOCOMPLAIN:		/* -nocomplain */
	    complain = 0;
	    break;
	case UNLOAD_KEEPLIB:		/* -keeplibrary */
	    keepLibrary = 1;
	    break;
	case UNLOAD_LAST:		/* -- */







|






|

















|







550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    int i, index, code, complain = 1, keepLibrary = 0;
    int trustedRefCount = -1, safeRefCount = -1;
    const char *fullFileName = "";
    const char *packageName;
    static const char *const options[] = {
	"-nocomplain", "-keeplibrary", "--", NULL
    };
    enum unloadOptionsEnum {
	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 = 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) {
	case UNLOAD_NOCOMPLAIN:		/* -nocomplain */
	    complain = 0;
	    break;
	case UNLOAD_KEEPLIB:		/* -keeplibrary */
	    keepLibrary = 1;
	    break;
	case UNLOAD_LAST:		/* -- */
600
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
		"?-switch ...? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	return TCL_ERROR;
    }

    fullFileName = TclGetString(objv[i]);
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc - i >= 2) {
	packageName = TclGetString(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_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
		NULL);
	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);
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }








|





|



















|







597
598
599
600
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
		"?-switch ...? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	return TCL_ERROR;
    }

    fullFileName = Tcl_GetString(objv[i]);
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc - i >= 2) {
	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_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
		NULL);
	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 = Tcl_GetString(objv[i + 2]);

	target = Tcl_GetChild(interp, childIntName);
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }

886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
			    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);
		Tcl_MutexUnlock(&packageMutex);
	    } else {
		code = TCL_ERROR;
	    }
	}
#else
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|
|
|
|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		ckfree(defaultPtr->fileName);
		ckfree(defaultPtr->packageName);
		ckfree(defaultPtr);
		ckfree(ipPtr);
		Tcl_MutexUnlock(&packageMutex);
	    } else {
		code = TCL_ERROR;
	    }
	}
#else
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993

    /*
     * 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);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= (char *)Tcl_Alloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;







|
|

|







973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *)ckalloc(1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= (char *)ckalloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
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
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackages, TclGetLoadedPackagesEx --
 *
 *	This function returns information about all of the files that are
 *	loaded (either in a particular interpreter, 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
				 * 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







|









|

















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







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
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackagesEx --
 *
 *	This function returns information about all of the files that are
 *	loaded (either in a particular interpreter, 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
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
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
    TCL_UNUSED(Tcl_Interp *))
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = (InterpPackage *)clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	Tcl_Free(ipPtr);
	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
    TCL_UNUSED(Tcl_Interp *))
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = (InterpPackage *)clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	ckfree(ipPtr);
	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	}
#endif

	Tcl_Free(pkgPtr->fileName);
	Tcl_Free(pkgPtr->packageName);
	Tcl_Free(pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|
|
|










1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
	}
#endif

	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree(pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclLoadNone.c.
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"dynamic loading is not currently available on this system",
		-1));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    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;
}

/*
 * 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.
 */








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







48
49
50
51
52
53
54






























55
56
57
58
59
60
61
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"dynamic loading is not currently available on this system",
		-1));
    }
    return TCL_ERROR;
}






























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

Changes to generic/tclMain.c.
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

#ifndef _WIN32
#   define TCHAR char
#   define TEXT(arg) arg
#   define _tcscmp strcmp
#endif

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







|









|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

#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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (encodingPtr != NULL) {
	if (tsdPtr->encoding == NULL) {
	    *encodingPtr = NULL;
	} else {
	    *encodingPtr = TclGetString(tsdPtr->encoding);
	}
    }
    return tsdPtr->path;
}

/*----------------------------------------------------------------------
 *







|







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (encodingPtr != NULL) {
	if (tsdPtr->encoding == NULL) {
	    *encodingPtr = NULL;
	} else {
	    *encodingPtr = Tcl_GetString(tsdPtr->encoding);
	}
    }
    return tsdPtr->path;
}

/*----------------------------------------------------------------------
 *
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	} 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 (Tcl_EvalFile(interp, fullName) != TCL_OK) {
		    chan = Tcl_GetStdChannel(TCL_STDERR);
		    if (chan) {
			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
			Tcl_WriteChars(chan, "\n", 1);
		    }
		}







|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	} 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_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);
		    }
		}
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
 *	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(
    int argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */







|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
 *	This function initializes the Tcl world and then starts interpreting
 *	commands; almost anything could happen, depending on the script being
 *	interpreted.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MainEx(
    int argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	 *  FILENAME
	 */

	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
		    TclGetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    argv += 3;
	} else if ((argc > 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    argc--;
	    argv++;







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	 *  FILENAME
	 */

	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
		    Tcl_GetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    argv += 3;
	} else if ((argc > 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    argc--;
	    argv++;
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
     */

    Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
    is.input = Tcl_GetStdChannel(TCL_STDIN);
    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
	mainLoopProc = TclGetMainLoop();
	if (mainLoopProc == NULL) {
	    size_t length;

	    if (is.tty) {
		Prompt(interp, &is);
		if (Tcl_InterpDeleted(interp)) {
		    break;
		}
		if (Tcl_LimitExceeded(interp)) {
		    break;
		}
		is.input = Tcl_GetStdChannel(TCL_STDIN);
		if (is.input == NULL) {
		    break;
		}
	    }
	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    }
	    length = Tcl_GetsObj(is.input, is.commandPtr);
	    if (length == TCL_INDEX_NONE) {
		if (Tcl_InputBlocked(is.input)) {
		    /*
		     * This can only happen if stdin has been set to
		     * 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.







|




















|







447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
     */

    Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
    is.input = Tcl_GetStdChannel(TCL_STDIN);
    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
	mainLoopProc = TclGetMainLoop();
	if (mainLoopProc == NULL) {
	    int length;

	    if (is.tty) {
		Prompt(interp, &is);
		if (Tcl_InterpDeleted(interp)) {
		    break;
		}
		if (Tcl_LimitExceeded(interp)) {
		    break;
		}
		is.input = Tcl_GetStdChannel(TCL_STDIN);
		if (is.input == NULL) {
		    break;
		}
	    }
	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    }
	    length = Tcl_GetsObj(is.input, is.commandPtr);
	    if (length < 0) {
		if (Tcl_InputBlocked(is.input)) {
		    /*
		     * This can only happen if stdin has been set to
		     * 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.
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
	    is.prompt = PROMPT_START;

	    /*
	     * 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);
	    if (code != TCL_OK) {
		chan = Tcl_GetStdChannel(TCL_STDERR);
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		(void)TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }







|
















|







512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    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);
	    if (code != TCL_OK) {
		chan = Tcl_GetStdChannel(TCL_STDERR);
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
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
 */

static void
StdinProc(
    ClientData clientData,	/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
{
    int code;
    size_t length;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;

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







|
<











|







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

static void
StdinProc(
    ClientData clientData,	/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
{
    int code, length;

    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    length = Tcl_GetsObj(chan, commandPtr);
    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
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    (void)TclGetStringFromObj(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.







|







772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    TclGetStringFromObj(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.
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = 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_DecrRefCount(resultPtr);
    }








|







804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }

Changes to generic/tclNamesp.c.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

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







|



















|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct {
    unsigned 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 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. */
    size_t refCount;		/* Reference count: 1 for each nsName object
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413

414
415
416
417
418
419
420
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    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)) {

	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }







|

















|
|
>







387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	ckfree(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	    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;
    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);
    }
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
    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;
    size_t nameLen;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    const char *nameStr;
    Tcl_DString tmpBuffer;

    Tcl_DStringInit(&tmpBuffer);

    /*







|
<







661
662
663
664
665
666
667
668

669
670
671
672
673
674
675
    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, nameLen;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    const char *nameStr;
    Tcl_DString tmpBuffer;

    Tcl_DStringInit(&tmpBuffer);

    /*
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = (Namespace *)Tcl_Alloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = (char *)Tcl_Alloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    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);







|

|







760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = (Namespace *)ckalloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = (char *)ckalloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    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);
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
	    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);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*







|







850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
	    namePtr = buffPtr;
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = (char *)ckalloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
     * 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)) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);







|







998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
     * 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 - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		Tcl_Free(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    nsPtr ->flags |= NS_DEAD;
	} else {
	    /*







|







1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
		ckfree(nsPtr->childTablePtr);
	    }
#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);

	    nsPtr ->flags |= NS_DEAD;
	} else {
	    /*
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
TclTeardownNamespace(
    Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    size_t 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.
     */

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







|




















|







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
TclTeardownNamespace(
    Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    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.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	int 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)) {
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
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#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;
		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 != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {







|




















|







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
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int 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;
		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) {
	    int length = nsPtr->childTablePtr->numEntries;
	    Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    Tcl_Free(nsPtr->exportArrayPtr[i]);
	}
	Tcl_Free(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.







|

|







1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    ckfree(nsPtr->exportArrayPtr[i]);
	}
	ckfree(nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
{
    /*
     * 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);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNsDecrRefCount --
 *







|
|
|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
{
    /*
     * 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.
     */

    ckfree(nsPtr->name);
    ckfree(nsPtr->fullName);
    ckfree(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNsDecrRefCount --
 *
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
				 * 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;

    /*
     * 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]);
	    }
	    Tcl_Free(nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    TclInvalidateNsCmdLookup(nsPtr);
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }








|



















|

|







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
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    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++) {
		ckfree(nsPtr->exportArrayPtr[i]);
	    }
	    ckfree(nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    TclInvalidateNsCmdLookup(nsPtr);
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }

1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
     * 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,
		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);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have







|








|







1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
     * pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (neededElems > nsPtr->maxExportPatterns) {
	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
	nsPtr->exportArrayPtr = (char **)ckrealloc(nsPtr->exportArrayPtr,
		sizeof(char *) * nsPtr->maxExportPatterns);
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = (char *)ckalloc(len + 1);
    memcpy(patternCpy, pattern, len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
    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;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);







<
|







1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506
    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;

    int i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    size_t 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.
     */








|







1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    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.
     */

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
		    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),
		TclInvokeImportedCmd, InvokeImportedNRCmd, 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->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = (Command *)Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {







|















|







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
		    Tcl_DStringFree(&ds);
		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
		TclInvokeImportedCmd, InvokeImportedNRCmd, 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 *)ckalloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = (Command *)Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
	     */

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    Tcl_Free(refPtr);
	    TclCleanupCommandMacro(realCmdPtr);
	    Tcl_Free(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
}







|

|







2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
	     */

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    ckfree(refPtr);
	    TclCleanupCommandMacro(realCmdPtr);
	    ckfree(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
}
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	size_t 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)







|







2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	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)
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
    /*
     * 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);

	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
	    goto searchDone;
	}
	if (
#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL







|







3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
    /*
     * 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)) {
	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
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
    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;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg");
	return TCL_ERROR;
    }

    /*







|







3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
    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;
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg");
	return TCL_ERROR;
    }

    /*
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
    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 overflow = (length > limit);
	char *cmd = (char *)data[1];

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (in namespace %s \"%.*s%s\" script line %d)",
		cmd,
		(overflow ? limit : (unsigned)length), namespacePtr->fullName,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the previous "current" namespace.
     */








|
|






|







3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	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)",
		cmd,
		(overflow ? limit : length), namespacePtr->fullName,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the previous "current" namespace.
     */

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
    }

    /*
     * Process the optional "-clear" argument.
     */

    firstArg = 1;
    if (strcmp("-clear", TclGetString(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);
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}








|










|







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
    }

    /*
     * Process the optional "-clear" argument.
     */

    firstArg = 1;
    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, Tcl_GetString(objv[i]), 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}

4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
NamespacePathCmd(
    TCL_UNUSED(ClientData),
    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;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

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







<
|







4007
4008
4009
4010
4011
4012
4013

4014
4015
4016
4017
4018
4019
4020
4021
NamespacePathCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    int i, nsObjc, result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;
    }
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = (Tcl_Namespace **)TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<(size_t)nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
	}
    }








|







4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = (Tcl_Namespace **)TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);

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

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    size_t 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;

	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;







|




|
|







4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    int pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	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
 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    size_t 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);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateNsPath --
 *







|















|







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

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    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;
	    }
	}
    }
    ckfree(nsPtr->commandPathArray);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateNsPath --
 *
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
NamespaceQualifiersCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    size_t length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    /*







|







4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
NamespaceQualifiersCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    /*
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
	/*
	 * 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);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupNsNameInternalRep --







|







4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
	/*
	 * 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);
	ckfree(resNamePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupNsNameInternalRep --
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    nsPtr->refCount++;
    resNamePtr = (ResolvedNsName *)Tcl_Alloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 0;







|







4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    nsPtr->refCount++;
    resNamePtr = (ResolvedNsName *)ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 0;
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*







|







4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
void
TclLogCommandInfo(
    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). */
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    const char *p;
    Interp *iPtr = (Interp *) interp;
    int overflow, limit = 150;







|
|







4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
void
TclLogCommandInfo(
    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. */
    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;
    Interp *iPtr = (Interp *) interp;
    int overflow, limit = 150;
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
	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"),
		(overflow ? limit : (int)length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
		NULL, 0, 0, &arrayPtr);
	if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	    /*
	     * Should not happen.







|


|



|







4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}

	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 : length), command,
		(overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
		NULL, 0, 0, &arrayPtr);
	if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	    /*
	     * Should not happen.
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
 *----------------------------------------------------------------------
 */

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







|







5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
 *----------------------------------------------------------------------
 */

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    int length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
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);
}


/*







|







5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
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. */
    int length)			/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*
Changes to generic/tclNotify.c.
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	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);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);








|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	return;		/* Notifier not initialized for the current thread */
    }

    Tcl_MutexLock(&(tsdPtr->queueMutex));
    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
	hold = evPtr;
	evPtr = evPtr->nextPtr;
	ckfree(hold);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);

272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    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));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}







|







272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    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 *)ckalloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = sourcePtr->nextPtr;
	}
	Tcl_Free(sourcePtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = sourcePtr->nextPtr;
	}
	ckfree(sourcePtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
 *----------------------------------------------------------------------
 */

void
Tcl_QueueEvent(
    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
				 * 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);








|







351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
 *----------------------------------------------------------------------
 */

void
Tcl_QueueEvent(
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * 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);

383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
 */

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








|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
 */

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 (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
    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	QueueEvent(tsdPtr, evPtr, position);
    } else {
	Tcl_Free(evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *







|







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	QueueEvent(tsdPtr, evPtr, position);
    } else {
	ckfree(evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

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







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454

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 (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) {
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    Tcl_Free(hold);
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;







|







559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    ckfree(hold);
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
			tsdPtr->markerEventPtr = prevPtr;
		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		Tcl_Free(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.







|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
			tsdPtr->markerEventPtr = prevPtr;
		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		ckfree(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.
Changes to generic/tclOO.c.
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
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







|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
static int
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = (Foundation *)ckalloc(sizeof(Foundation));
    Tcl_Obj *namePtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    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);







|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    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 = 0;
    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);
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    /*
     * 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;







|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    /*
     * 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;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;

    /*
     * Special initialization for the primordial objects.
     */

    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    Tcl_Free(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *







|







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
				 * 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).







|

|







614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
				 * 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;
    int creationEpoch;

    oPtr = (Object *)ckalloc(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).
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
	}
	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;
	}

	/*







|







643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
    /*
     * 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,







|







727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
    /*
     * 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 *)ckalloc(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,
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
		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).
     */







|



















|







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
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	ckfree(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) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
		    !(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;
    }
}

/*
 * ----------------------------------------------------------------------







|







926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    }
    if (clsPtr->instances.size > 0) {
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}

/*
 * ----------------------------------------------------------------------
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
    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);
    }
}








|













|
















|








|









|















|







|







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
    if (clsPtr->classChainCache) {
	CallChain *callPtr;

	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	ckfree(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	ckfree(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);
	ckfree(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	ckfree(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);
	}
	ckfree(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) {
	ckfree(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }
}

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

    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.







|







|







|






|







|
















|







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

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	if (oPtr->mixins.list != NULL) {
	    ckfree(oPtr->mixins.list);
	}
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
	ckfree(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	ckfree(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	ckfree(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	ckfree(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);
	ckfree(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.
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    Tcl_Free(oPtr->classPtr);
	}
	Tcl_Free(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------







|

|







1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    ckfree(oPtr->classPtr);
	}
	ckfree(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
    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);
}








|

|







1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
    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 **)ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = (Object **)ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}

1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
	    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;
}

/*
 * ----------------------------------------------------------------------







|







1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);
	    res++;
	    break;
	}
    }
    if (oPtr->mixins.num == 0) {
	ckfree(oPtr->mixins.list);
	oPtr->mixins.list = NULL;
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
{
    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);
}








|

|







1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
{
    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 **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = (Class **)ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
{
    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);
}








|

|







1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
{
    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 **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = (Class **)ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

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
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.
     */








|
















|







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
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 *)ckalloc(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 **)ckalloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */

1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
    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);
	}








|







1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
    if (o2Ptr->mixins.num != 0) {
	FOREACH(mixinPtr, o2Ptr->mixins) {
	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
		TclOORemoveFromInstances(o2Ptr, mixinPtr);
	    }
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}

2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
	 */

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








|



|







2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    (Class **)ckalloc(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);

2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
	 */

	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.







|







2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
	 */

	if (cls2Ptr->mixins.num != 0) {
	    FOREACH(mixinPtr, cls2Ptr->mixins) {
		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);

	    /*
	     * For the copy just created in DUPLICATE.
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
     * 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.
     */








|







2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
     * Attach the metadata store if not done already.
     */

    if (clsPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	clsPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
     * 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.
     */








|







2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
     * Attach the metadata store if not done already.
     */

    if (oPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	oPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

Changes to generic/tclOO.decls.
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    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 {







|







|




|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
    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,
	    ClientData *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,
	    ClientData clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    ClientData 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 {
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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 {







|




|


|




|







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
}
declare 21 {
    ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    int skip)
}
declare 24 {
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

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 {







|






|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161

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, ClientData 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,
	    ClientData 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 {
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    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)







|





|







178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    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,
	    ClientData 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, ClientData 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)
Changes to generic/tclOO.h.
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

/*
 * 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).







|

|
|
|
|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

/*
 * 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)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
	ClientData *newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData 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).
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
				 * 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.







|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
				 * 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 compatability.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 1

/*
 * Visibility constants for the flags parameter to Tcl_NewMethod and
 * Tcl_NewInstanceMethod.
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
				 * 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.
 */







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
				 * 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 compatability.
 */

#define TCL_OO_METADATA_VERSION_CURRENT 1

/*
 * Include all the public API, generated from tclOO.decls.
 */
Changes to generic/tclOOBasic.c.
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
	    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.







|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
	    TclGetString(nameObj), NULL, -1, NULL, -1);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = (Tcl_Obj **)ckalloc(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.
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
    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);
}








|







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
    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]);
    ckfree(invoke);
    if (code != TCL_OK) {
	Tcl_DiscardInterpState(saved);
	return code;
    }
    return Tcl_RestoreInterpState(interp, saved);
}

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
				 * 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) {







|







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
				 * 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;
    int len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
     */

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







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    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;
    }
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
				 * 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) {







|







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
				 * 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;
    int len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
     */

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







|







|







269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = Tcl_GetStringFromObj(
	    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 = Tcl_GetStringFromObj(
	    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;
    }
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
	}
	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;
}

/*







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", -1);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    ckfree(methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), NULL);
    return TCL_ERROR;
}

/*
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754

    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







|







740
741
742
743
744
745
746
747
748
749
750
751
752
753
754

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }
    argPtr = objv[objc-1];
    arg = Tcl_GetString(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
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
	    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;
			}
		    }
		}
	    }
	}







|
|




















|
|







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
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    int i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(Tcl_GetString(pvPtr->variableObj),
			    Tcl_GetString(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(Tcl_GetString(pvPtr->variableObj),
				Tcl_GetString(argPtr))) {
			    argPtr = pvPtr->fullNameObj;
			    break;
			}
		    }
		}
	    }
	}
Changes to generic/tclOOCall.c.
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

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







|




















|

|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

    FOREACH_HASH_VALUE(callPtr, tablePtr) {
	if (callPtr) {
	    TclOODeleteChain(callPtr);
	}
    }
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChain --
 *
 *	Destroys a method call-chain.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteChain(
    CallChain *callPtr)
{
    if (callPtr == NULL || callPtr->refCount-- > 1) {
	return;
    }
    if (callPtr->chain != callPtr->staticChain) {
	ckfree(callPtr->chain);
    }
    ckfree(callPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOStashContext --
 *
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
    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);
	}







|





|

















|







585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
    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. ckalloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    int 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 **)ckalloc(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);
	}
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

    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







|







631
632
633
634
635
636
637
638
639
640
641
642
643
644
645

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    return i;
}

/*
 * Comparator for SortMethodNames
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
			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);
		}
	    }







|







909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
			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);
		}
	    }
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
     * 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++;
}







|



|







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
     * 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 *)ckalloc(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 *)ckrealloc(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++;
}
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
	    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;
    }








|

















|







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
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}

	doFilters = 1;
    }

    callPtr = (CallChain *)ckalloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, 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 = -1;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;
    }

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
	}
	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);
	    }
	}







|









|







|







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
	}
	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 = -1;
	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 *)ckalloc(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 *)ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->chainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
			(char *) methodNameObj, &i);
	    }
	}
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
	    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;







|







1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = (CallChain *)ckalloc(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;
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515

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







|







|







1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515

    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 = -1;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
	if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
		&nsPtr) == TCL_OK) {
	    break;
	}
	Tcl_ResetResult(interp);
    }
    if (define.list != staticSpace) {
	Tcl_Free(define.list);
    }
    return nsPtr;
}

/*
 * ----------------------------------------------------------------------
 *







|







1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
	if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
		&nsPtr) == TCL_OK) {
	    break;
	}
	Tcl_ResetResult(interp);
    }
    if (define.list != staticSpace) {
	ckfree(define.list);
    }
    return nsPtr;
}

/*
 * ----------------------------------------------------------------------
 *
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103

    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++;
}







|



|







2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103

    if (definePtr->num == definePtr->size) {
	definePtr->size *= 2;
	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
	    DefineEntry *staticList = definePtr->list;

	    definePtr->list =
		    (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size);
	    memcpy(definePtr->list, staticList,
		    sizeof(DefineEntry) * definePtr->num);
	} else {
	    definePtr->list = (DefineEntry *)ckrealloc(definePtr->list,
		    sizeof(DefineEntry) * definePtr->size);
	}
    }
    definePtr->list[i].definerCls = definerCls;
    definePtr->list[i].namespaceName = namespaceName;
    definePtr->num++;
}
Changes to generic/tclOODecls.h.
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
/* 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);







|






|




|


















|




|

|




|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
/* 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,
				ClientData *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,
				ClientData clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				ClientData 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 ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				ClientData metadata);
/* 21 */
TCLAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				ClientData 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);
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
    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 */







|

|
|






|
|
|
|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
    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, ClientData *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, ClientData clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData 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 */
    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData 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 */
Changes to generic/tclOODefineCmds.c.
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    }

    if (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;







|












|

|







263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	ckfree(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 **)ckalloc(size);
	} else {
	    filtersList = (Tcl_Obj **)ckrealloc(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;
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
    }

    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;







|











|

|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	ckfree(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 **)ckalloc(size);
	} else {
	    filtersList = (Tcl_Obj **)ckrealloc(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;
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408

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







|











|


|







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(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 **)ckrealloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = (Class **)ckalloc(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);
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

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

	    /*







|








|


|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(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 **)ckrealloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);

	    /*
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	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(







|

|

|




















|







496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = (Tcl_Obj **)ckalloc(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 **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
    }
    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);
    }
}

/*







|

|


|













|












|







547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = (PrivateVariableMapping *)ckalloc(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, Tcl_GetString(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 *)ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
    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;







|







699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    int 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;
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

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.







|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    int 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.
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
				 * 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 --







|



|




|







992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
				 * 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. */
{
    int length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = TclGetStringFromObj(realNameObj, &length);
    int 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 : length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * MagicDefinitionInvoke --
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

	    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 {







|
|







1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
	    oPtr->fPtr->epoch++;
	    oPtr->flags |= DONT_DELETE;
	    TclOODeleteDescendants(interp, oPtr);
	    oPtr->flags &= ~DONT_DELETE;
	    TclOOReleaseClassContents(interp, oPtr);
		ckfree(oPtr->classPtr);
		oPtr->classPtr = NULL;
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
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
    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);







|

















|







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
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    int 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;

    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);
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
	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);







|







1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
	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 (!Tcl_GetString(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);
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
    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);







|












|







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
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    int 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;

    TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
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
	 * 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);







|



|


|




|







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
	 * 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 *)ckalloc(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 *)ckalloc(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);
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
	 * 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);







|



|


|




|







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
	 * 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 *)ckalloc(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 *)ckalloc(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);
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
	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);







|









|







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
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

    superclasses = (Class **) ckalloc(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 **)ckrealloc(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);
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
		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.
	     */







|







2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
		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);
		}
		ckfree(superclasses);
		return TCL_ERROR;
	    }

	    /*
	     * Corresponding TclOODecrRefCount() is near the end of this
	     * function.
	     */
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
     */

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







|







2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	ckfree(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);
Changes to generic/tclOOInfo.c.
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
		&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);
	    }
	}







|







608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    ckfree(names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
    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;







|







812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
    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", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
	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);







|







1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
	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) {
	    ckfree(names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
    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;







|







1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
    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", Tcl_GetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
Changes to generic/tclOOInt.h.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 */

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







|


















|

|

|
|












|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 */

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. */
    int 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)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
typedef ClientData (TclOO_PmCDCloneProc)(ClientData 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. */
    int 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. */
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
    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;







|




|

|



|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
    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. */
    int 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;
    int creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    int 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 ClientData 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;
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
				 * 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







|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
				 * 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 ClientData 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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 * 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;








|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 * 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 {
    int 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;

349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    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







|







349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
    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. */
    int 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
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
				 * 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;








|


|

|


|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
				 * 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 {
    int objectCreationEpoch;	/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    int objectEpoch;		/* Local (object structure) epoch counter
				 * snapshot. */
    int epoch;			/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    int 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;

443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524







































525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
/*
 *----------------------------------------------------------------
 * 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.
 */







|


|


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





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


|


|







|


|


|


|


|


|


|


|


|







443
444
445
446
447
448
449
450
451
452
453
454
455
456































































457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
/*
 *----------------------------------------------------------------
 * Commands relating to OO support.
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclOODefineObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOObjDefObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineConstructorObjCmd(ClientData 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	TclOODefineDeleteMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

/*
 * Method implementations (in tclOOBasic.c).
 */

MODULE_SCOPE int	TclOO_Class_Constructor(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_CreateNs(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_New(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Destroy(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Eval(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_LinkVar(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Unknown(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_VarName(ClientData 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.
 */
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
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);







|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
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(ClientData 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);
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
 */

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







|







667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
 */

#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*)ckalloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

#endif /* TCL_OO_INTERNAL_H */

Changes to generic/tclOOIntDecls.h.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/* 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,







|






|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/* 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,
				ClientData 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,
				ClientData 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,
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
				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,







|
|
|
|





|
|
|
|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
				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,
				ClientData 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,
				ClientData 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,
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
				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;








|
|






|
|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
				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, ClientData 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, ClientData 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, ClientData 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, ClientData 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;

Changes to generic/tclOOMethod.c.
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
{
    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) {







|





|





|







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
{
    Object *oPtr = (Object *) object;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    if (!oPtr->methodsPtr) {
	oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitObjHashTable(oPtr->methodsPtr);
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
    if (isNew) {
	mPtr = (Method *)ckalloc(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) {
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
{
    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) {







|






|







215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
{
    Class *clsPtr = (Class *) cls;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
    if (isNew) {
	mPtr = (Method *)ckalloc(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) {
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
	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 --







|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
	if (mPtr->namePtr != NULL) {
	    Tcl_DecrRefCount(mPtr->namePtr);
	}

	ckfree(mPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewBasicMethod --
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
    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;
}

/*







|








|







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
    int argsLen;
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = (ProcedureMethod *)ckalloc(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) {
	ckfree(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }
    return (Method *) method;
}

/*
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
	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;
}








|












|







399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
	procName = "<destructor>";
    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    } else {
	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
    }

    pmPtr = (ProcedureMethod *)ckalloc(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) {
	ckfree(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }

    return (Method *) method;
}

493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
	     * 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);







|




|







493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
	     * 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 *)ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = (int *)ckalloc(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);
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
	     * 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);







|




|







606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
	     * 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 *)ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = (int *)ckalloc(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);
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
    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.
     */







|
<







983
984
985
986
987
988
989
990

991
992
993
994
995
996
997
    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, 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.
     */
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
     */

    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;







|


















|
|




|







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

    if (infoPtr->cachedObjectVar) {
	VarHashRefCount(infoPtr->cachedObjectVar)--;
	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
    }
    Tcl_DecrRefCount(infoPtr->variableObj);
    ckfree(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(Tcl_GetString(variableObj), "::") != NULL ||
	    Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
	Tcl_DecrRefCount(variableObj);
	return TCL_CONTINUE;
    }

    infoPtr = (OOResVarInfo *)ckalloc(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;
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
 * ----------------------------------------------------------------------
 */

/* 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)));
}

/*







|







|

















|

















|












|
















|












|







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

/* TODO: Check whether Tcl_AppendLimitedToObj() can work here. */

#define LIMIT 60
#define ELLIPSIFY(str,len) \
	((len) > LIMIT ? LIMIT : (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 */
{
    int 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 = Tcl_GetStringFromObj(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;
    int 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 = Tcl_GetStringFromObj(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;
    int 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 = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

/*
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
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;







|







1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
DeleteProcedureMethodRecord(
    ProcedureMethod *pmPtr)
{
    TclProcDeleteProc(pmPtr->procPtr);
    if (pmPtr->deleteClientdataProc) {
	pmPtr->deleteClientdataProc(pmPtr->clientData);
    }
    ckfree(pmPtr);
}

static void
DeleteProcedureMethod(
    void *clientData)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
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

    /*
     * 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);







|







|








|







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

    /*
     * 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);
    Tcl_GetString(bodyObj);
    Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = (ProcedureMethod *)ckalloc(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);
	ckfree(pm2Ptr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(argsObj);
    Tcl_DecrRefCount(bodyObj);

    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
    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);
}

/*







|







1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
    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 *)ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
	    nameObj, flags, &fwdMethodType, fmPtr);
}

/*
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
    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);
}

/*







|







1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
    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 *)ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*
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
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;
}








|









|







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
static void
DeleteForwardMethod(
    void *clientData)
{
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    ckfree(fmPtr);
}

static int
CloneForwardMethod(
    TCL_UNUSED(Tcl_Interp *),
    void *clientData,
    void **newClientData)
{
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    ForwardMethod *fm2Ptr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
    return TCL_OK;
}

Changes to generic/tclObj.c.
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 */

typedef struct {
    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
    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 */







|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 */

typedef struct ObjData {
    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
    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 */
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199



200
201
202
203
204
205
206
/*
 * Macro to set up the local reference to the deletion context.
 */
#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif HAVE_FAST_TSD
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
    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));            \
    }

/*
 * Prototypes for functions defined later in this file:
 */

static int		ParseBoolean(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);



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

/*







|
















|




|
|
|











>
>
>







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
/*
 * Macro to set up the local reference to the deletion context.
 */
#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif 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))
#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 *)ckalloc(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 = (void *)(bignum).dp;   \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used));                \
    }

/*
 * Prototypes for functions defined later in this file:
 */

static int		ParseBoolean(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);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void		UpdateStringOfOldInt(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
/*
 * 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.
 */










const Tcl_ObjType tclBooleanType = {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
};
const 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 */
};









const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL			/* setFromAnyProc */
};







>
>
>
>
>
>
>
>
>

|













>

>
>
>





>
>
>
>
>
>
>
>
>







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

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static const Tcl_ObjType oldBooleanType = {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBooleanType = {
    "booleanString",		/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny		/* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
    "int",			/* name */
#else
    "wideInt",		/* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
#endif
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */
};
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static const Tcl_ObjType oldIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfOldInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL			/* setFromAnyProc */
};
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

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
				 * 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
				 * 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
				 * 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
				 * that has a pointer to this ResolvedCmdName







|




|




|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

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.*/
    unsigned 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). */
    unsigned 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. */
    unsigned 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
				 * that has a pointer to this ResolvedCmdName
365
366
367
368
369
370
371









372
373
374
375
376
377
378
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);










#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;







>
>
>
>
>
>
>
>
>







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

    /* For backward compatibility only ... */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_RegisterObjType(&tclIntType);
#if !defined(TCL_WIDE_INT_IS_LONG)
    Tcl_RegisterObjType(&oldIntType);
#endif
    Tcl_RegisterObjType(&oldBooleanType);
#endif

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(objData);
	    }
	}

	Tcl_DeleteHashTable(tablePtr);
	Tcl_Free(tablePtr);
	tsdPtr->objThreadMap = NULL;
    }
#endif
}

/*
 *----------------------------------------------------------------------







|




|







447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		ckfree(objData);
	    }
	}

	Tcl_DeleteHashTable(tablePtr);
	ckfree(tablePtr);
	tsdPtr->objThreadMap = NULL;
    }
#endif
}

/*
 *----------------------------------------------------------------------
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
     * 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));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*







|







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
     * 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 *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
    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));

    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







|







563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
    int num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *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
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
	 * 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.
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);








|







587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	 * 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.
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);

589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604

void
TclContinuationsEnterDerived(
    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,







|
<







623
624
625
626
627
628
629
630

631
632
633
634
635
636
637

void
TclContinuationsEnterDerived(
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{
    int length, 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,
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    (void)TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {







|







650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	Tcl_Free(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    Tcl_Free(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --







|



|







791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	ckfree(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    ckfree(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
    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);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",







|







1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	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);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
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
	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));
	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
	}
	tablePtr = tsdPtr->objThreadMap;
	hPtr = Tcl_CreateHashEntry(tablePtr, 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->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}







|












|







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
	Tcl_HashEntry *hPtr;
	Tcl_HashTable *tablePtr;
	int isNew;
	ObjData *objData;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->objThreadMap == NULL) {
	    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);
	if (!isNew) {
	    Tcl_Panic("expected to create new entry for object map");
	}

	/*
	 * Record the debugging information.
	 */

	objData = (ObjData *)ckalloc(sizeof(ObjData));
	objData->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *	Assumes mutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:







|







1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --
 *
 *	Function to allocate a number of free Tcl_Objs. This is done using a
 *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
 *
 *	Assumes mutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
    Tcl_Obj *prevPtr, *objPtr;
    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,
     * 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);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	prevPtr = objPtr;
	objPtr++;







|




|







1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
    Tcl_Obj *prevPtr, *objPtr;
    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 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 *)ckalloc(bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	prevPtr = objPtr;
	objPtr++;
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
	    /*
	     * As the Tcl_Obj is going to be deleted we remove the entry.
	     */

	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(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);
    }
    /*
     * 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;

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

    TclInvalidateStringRep(objPtr);
    objPtr->length = TCL_INDEX_NONE;

    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);
	Tcl_MutexUnlock(&tclObjMutex);
	TclIncrObjsFreed();
	ObjDeletionLock(context);
	while (ObjOnStack(context)) {
	    Tcl_Obj *objToFree;

	    PopObjToDelete(context, objToFree);
	    TCL_DTRACE_OBJ_FREE(objToFree);
	    TclFreeIntRep(objToFree);

	    Tcl_MutexLock(&tclObjMutex);
	    Tcl_Free(objToFree);
	    Tcl_MutexUnlock(&tclObjMutex);
	    TclIncrObjsFreed();
	}
	ObjDeletionUnlock(context);
    }

    /*







|













|







|




|



|












|











|







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
	    /*
	     * As the Tcl_Obj is going to be deleted we remove the entry.
	     */

	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		ckfree(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 < -1) {
	Tcl_Panic("Reference count for %p 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 = -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 = -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);
	ckfree(objPtr);
	Tcl_MutexUnlock(&tclObjMutex);
	TclIncrObjsFreed();
	ObjDeletionLock(context);
	while (ObjOnStack(context)) {
	    Tcl_Obj *objToFree;

	    PopObjToDelete(context, objToFree);
	    TCL_DTRACE_OBJ_FREE(objToFree);
	    TclFreeIntRep(objToFree);

	    Tcl_MutexLock(&tclObjMutex);
	    ckfree(objToFree);
	    Tcl_MutexUnlock(&tclObjMutex);
	    TclIncrObjsFreed();
	}
	ObjDeletionUnlock(context);
    }

    /*
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
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#else /* TCL_MEM_DEBUG */

void
TclFreeObj(
    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'.
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = TCL_INDEX_NONE;

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








|


















|







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
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		ckfree(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#else /* TCL_MEM_DEBUG */

void
TclFreeObj(
    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'.
     */

    TclInvalidateStringRep(objPtr);
    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.
	 */

1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */








|







1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    if (hPtr) {
		ckfree(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */

1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == TCL_INDEX_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *







|







1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
	     * 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);
	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;







|







1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
	     * 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);
	if (objPtr->bytes == NULL || objPtr->length < 0
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    return objPtr->bytes;
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
	     * 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);
	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.







|







|













|


|




|








|







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
	     * 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);
	if (objPtr->bytes == NULL || objPtr->length < 0
		|| 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;
    }
    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 < 0)
 *	    Invalid call -- panic!
 *
 *	objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
 *	    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 >= 0
 *	    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 >= 0
 *	    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.
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
 *----------------------------------------------------------------------
 */

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







|


>
>
>
>






|






|






|
|







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

char *
Tcl_InitStringRep(
    Tcl_Obj *objPtr,	/* Object whose string rep is to be set */
    const char *bytes,
    unsigned int numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    if (numBytes > INT_MAX) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    /* Allocate */
    if (objPtr->bytes == NULL) {
	/* Allocate only as empty - extend later if bytes copied */
	objPtr->length = 0;
	if (numBytes) {
	    objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
	    if (objPtr->bytes == NULL) {
		return NULL;
	    }
	    if (bytes) {
		/* Copy */
		memcpy(objPtr->bytes, bytes, numBytes);
		objPtr->length = (int) numBytes;
	    }
	} else {
	    TclInitStringRep(objPtr, NULL, 0);
	}
    } else {
	/* objPtr->bytes != NULL bytes == NULL - Truncate */
	objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes + 1);
	objPtr->length = (int)numBytes;
    }

    /* Terminate */
    objPtr->bytes[objPtr->length] = '\0';

    return objPtr->bytes;
}
1896
1897
1898
1899
1900
1901
1902











































































































































1903
1904
1905
1906
1907
1908
1909
{
    TclFreeIntRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *











































































































































 * Tcl_GetBooleanFromObj --
 *
 *	Attempt to return a boolean from the Tcl object "objPtr". This
 *	includes conversion from any of Tcl's numeric types.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs







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







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
{
    TclFreeIntRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewBooleanObj --
 *
 *	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_DbNewLongObj.
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_NewBooleanObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_NewBooleanObj(
    int boolValue)	/* Boolean used to initialize new object. */
{
    return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewBooleanObj(
    int boolValue)	/* Boolean used to initialize new object. */
{
    Tcl_Obj *objPtr;

    TclNewIntObj(objPtr, boolValue!=0);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * 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
 *	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, 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewBooleanObj(
    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. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    /* Optimized TclInvalidateStringRep() */
    objPtr->bytes = NULL;

    objPtr->internalRep.wideValue = (boolValue != 0);
    objPtr->typePtr = &tclIntType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewBooleanObj(
    int boolValue,	/* Boolean used to initialize new object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetBooleanObj --
 *
 *	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:
 *	The object's old string rep, if any, is freed. Also, any old internal
 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetBooleanObj
void
Tcl_SetBooleanObj(
    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    int boolValue)	/* Boolean used to set object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
    }

    TclSetIntObj(objPtr, boolValue!=0);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBooleanFromObj --
 *
 *	Attempt to return a boolean from the Tcl object "objPtr". This
 *	includes conversion from any of Tcl's numeric types.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928




1929
1930
1931
1932
1933
1934
1935
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. */
{
    do {
	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    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







|


>
>
>
>







2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
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. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBooleanType) {
	    *boolPtr = objPtr->internalRep.longValue != 0;
	    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
1964
1965
1966
1967
1968
1969
1970
1971





1972
1973
1974
1975
1976
1977
1978
 * 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.





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

int
TclSetBooleanFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */







|
>
>
>
>
>







2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
 * 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/wideInt.
 *
 *  Warning: If the returned type is "wideInt" (32-bit platforms) and your
 *  platform is bigendian, you cannot use internalRep.longValue to distinguish
 *  between false and true. On Windows and most other platforms this still will
 *  work fine, but basically it is non-portable.
 *
 *----------------------------------------------------------------------
 */

int
TclSetBooleanFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
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

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	size_t length;
	const char *str = TclGetStringFromObj(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. */
{
    int newBool;
    char lowerCase[6];
    size_t i, length;
    const char *str = TclGetStringFromObj(objPtr, &length);


    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;







|


















<
|
>







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

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	int length;
	const char *str = TclGetStringFromObj(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. */
{
    int newBool;
    char lowerCase[6];

    const char *str = TclGetString(objPtr);
    size_t i, length = objPtr->length;

    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
         */

	return TCL_ERROR;
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
     * 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->typePtr = &tclBooleanType;
    return TCL_OK;

  numericBoolean:
    TclFreeIntRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclIntType;







|







2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
     * 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.longValue = newBool;
    objPtr->typePtr = &tclBooleanType;
    return TCL_OK;

  numericBoolean:
    TclFreeIntRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->typePtr = &tclIntType;
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

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDouble --
 *
 *	Update the string representation for a double-precision floating point

 *	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
 *	double-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfDouble(
    Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
{
    char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);

    TclOOM(dst, (size_t)TCL_DOUBLE_SPACE + 1);

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
    (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
}

/*
 *----------------------------------------------------------------------
 *























































































 * Tcl_GetIntFromObj --
 *
 *	Retrieve the integer value of 'objPtr'.

 *


 * Value
 *
 *	TCL_OK
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    An error occurred during conversion or the integral value can not
 *	    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.
 *
 * Effect
 *
 *	'objPtr' is converted to an integer if necessary if it is not one
 *	already.  The conversion frees any previously-existing internal
 *	representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */







>
|



















|








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


|
>

>
>
|
|
<

<
|
<
|
|
<
|
|

|
<
<
|
|







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

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDouble --
 *
 *	Update the string representation for a double-precision floating point
 *	object. This must obey the current tcl_precision value for
 *	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. */
{
    char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);

    TclOOM(dst, TCL_DOUBLE_SPACE + 1);

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
    (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewIntObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_NewIntObj(
    int intValue)	/* Int used to initialize the new object. */
{
    return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewIntObj(
    int intValue)	/* Int used to initialize the new object. */
{
    Tcl_Obj *objPtr;

    TclNewIntObj(objPtr, intValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_DEPRECATED
#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *
 *	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
 *	checks whether the current value of the long can be represented by an
 *	int.

 *

 * Results:

 *	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

 *	represented by an int, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:


 *	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. */
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500














































































































































































2501
2502
2503
2504
2505
2506
2507

static void
UpdateStringOfInt(
    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);

    TclOOM(dst, (size_t)TCL_INTEGER_SPACE + 1);
    (void) Tcl_InitStringRep(objPtr, NULL,
	    TclFormatInt(dst, objPtr->internalRep.wideValue));
}















































































































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *
 *	Attempt to return an long integer from the Tcl object "objPtr". If the







|



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







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

static void
UpdateStringOfInt(
    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);

    TclOOM(dst, TCL_INTEGER_SPACE + 1);
    (void) Tcl_InitStringRep(objPtr, NULL,
	    TclFormatInt(dst, objPtr->internalRep.wideValue));
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
static void
UpdateStringOfOldInt(
    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);

    TclOOM(dst, TCL_INTEGER_SPACE + 1);
    (void) Tcl_InitStringRep(objPtr, NULL,
	    TclFormatInt(dst, objPtr->internalRep.longValue));
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewLongObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_NewLongObj(
    long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    return Tcl_DbNewWideIntObj(longValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewLongObj(
    long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    Tcl_Obj *objPtr;

    TclNewIntObj(objPtr, longValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewLongObj
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewLongObj(
    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. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    /* Optimized TclInvalidateStringRep */
    objPtr->bytes = NULL;

    objPtr->internalRep.wideValue = longValue;
    objPtr->typePtr = &tclIntType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewLongObj(
    long longValue,	/* Long integer used to initialize the new
				 * object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewWideIntObj(longValue);
}
#endif /* TCL_MEM_DEBUG */
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    long longValue)	/* Long integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
    }

    TclSetIntObj(objPtr, longValue);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *
 *	Attempt to return an long integer from the Tcl object "objPtr". If the
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    TclUnpackBignum(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *







|







3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    TclUnpackBignum(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount + 1 > 2);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *







|







3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount > 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757

static Tcl_HashEntry *
AllocObjEntry(
    TCL_UNUSED(Tcl_HashTable *),
    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));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}







|







4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201

static Tcl_HashEntry *
AllocObjEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789

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;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller








|







4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233

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;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller

3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
void
TclFreeObjEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;

    Tcl_DecrRefCount(objPtr);
    Tcl_Free(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHashObjKey --
 *







|







4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
void
TclFreeObjEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;

    Tcl_DecrRefCount(objPtr);
    ckfree(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHashObjKey --
 *
3864
3865
3866
3867
3868
3869
3870

3871
3872
3873
3874
3875
3876
3877
3878
3879

TCL_HASH_TYPE
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    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;

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







>
|
<







4308
4309
4310
4311
4312
4313
4314
4315
4316

4317
4318
4319
4320
4321
4322
4323

TCL_HASH_TYPE
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    int length;
    const char *string = TclGetStringFromObj(objPtr, &length);

    TCL_HASH_TYPE result = 0;

    /*
     * 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
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}







|







4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
    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;








|







4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;

4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    Tcl_Free(resPtr);
	}
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *







|







4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    ckfree(resPtr);
	}
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293

    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    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]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",







|







4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737

    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);

    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
Changes to generic/tclOptimize.c.
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
	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;







|














|







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
	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));
		int 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));
		int numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
283
284
285
286
287
288
289


290
291
292
293
294
295
296
	    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:







>
>







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
	    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_LOR:
	    case INST_LAND:
	    case INST_EQ:
	    case INST_NEQ:
	    case INST_LT:
	    case INST_LE:
	    case INST_GT:
	    case INST_GE:
	    case INST_MOD:
Changes to generic/tclPanic.c.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25



26

27
28
29
30
31
32
33
 *
 * 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;


/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.







|







>
>
>

>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 *
 * 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 TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
#endif

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

#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.
41
42
43
44
45
46
47








48
49
50

































































51
52
53
54
55
56
57
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{








    panicProc = proc;
    Tcl_InitSubsystems();
}


































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_Panic --
 *
 *	Print an error message and kill the process.







>
>
>
>
>
>
>
>



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







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL))
#elif defined(__CYGWIN__)
    if (proc == NULL)
	panicProc = tclWinDebugPanic;
    else
#endif
    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;	/* Additional arguments (variable in number)
				 * to pass to fprintf. */
    char *arg4, *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) {
	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
#ifdef _WIN32
    } else if (IsDebuggerPresent()) {
	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
#endif
    } else {
	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
		arg8);
	fprintf(stderr, "\n");
	fflush(stderr);
#if defined(_WIN32) || defined(__CYGWIN__)
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER) && defined (_M_IX86)
	_asm {int 3}
#   else
	DebugBreak();
#   endif
#endif
#if defined(_WIN32)
	ExitProcess(1);
#else
	abort();
#endif
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Panic --
 *
 *	Print an error message and kill the process.
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
/* coverity[+kill] */
void
Tcl_Panic(
    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 *);
    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:
 */







<
<
<

<

|
<
<
<
<
<
<
<

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









150
151
152
153
154
155
156



157

158
159







160



























161
162
163
164
165
166
167
168
169
/* coverity[+kill] */
void
Tcl_Panic(
    const char *format,
    ...)
{
    va_list argList;





    va_start(argList, format);
    Tcl_PanicVA(format, argList);







    va_end (argList);



























}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclParse.c.
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static inline int	CommandComplete(const char *script, size_t numBytes);
static size_t		ParseComment(const char *src, size_t numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, size_t numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static size_t		ParseWhiteSpace(const char *src, size_t 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,
			    int *resultPtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *







|
|

|

|

|

|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static int	CommandComplete(const char *script, int numBytes);
static int		ParseComment(const char *src, int numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, int numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static int		ParseWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr, char *typePtr);
static int		ParseAllWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr);
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
 *----------------------------------------------------------------------
 */

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







|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    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

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,
				 * 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)
				/* 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
				 * 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;

    if (numBytes == TCL_INDEX_NONE && 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));







|











|








|

|







193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

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. */
    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)
				/* 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
				 * 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. */
    int scanned;

    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));
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (1 == parsePtr->numTokens - expIdx)
		    /* Only one token */
		    && (((1 == 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 */) {







|







342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (1 == parsePtr->numTokens - expIdx)
		    /* Only one token */
		    && (((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
	 * 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;

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







<
|







377
378
379
380
381
382
383

384
385
386
387
388
389
390
391
	 * 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) {

	    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

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    size_t size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {







|







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437

		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    int size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t 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;







|


|







615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    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;
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
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &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);
}

/*
 *----------------------------------------------------------------------







|


|






|







|


|







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
 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static int
ParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    int numBytes,		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    char type;
    const char *p = src;

    do {
	int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

int
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    int numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
 *
 *----------------------------------------------------------------------
 */

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
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    const char *p = src;

    while (numBytes--) {







|
|







721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
 *
 *----------------------------------------------------------------------
 */

int
ParseHex(
    const char *src,		/* First character to parse. */
    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;

    while (numBytes--) {
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
 *----------------------------------------------------------------------
 */

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
				 * 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 4 bytes will be written there. */
{
    const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    size_t count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;







|
|








|







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

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    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 4 bytes will be written there. */
{
    const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    int count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseComment(
    const char *src,		/* First character to parse. */
    size_t 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;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == 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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseComment(
    const char *src,		/* First character to parse. */
    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;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    const char *src,	/* First character to parse. */
    size_t 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







|







1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    const char *src,	/* First character to parse. */
    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
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305

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);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304

void
Tcl_FreeParse(
    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
				 * call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree(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

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,
				 * 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;
    int varIndex;
    unsigned array;

    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|














|







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

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 "$". */
    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;
    int varIndex;
    unsigned array;

    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
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

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,
				 * the string consists of all bytes up to the
				 * first null character. */
    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;
    size_t length;

    if (numBytes == TCL_INDEX_NONE && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|
















|
<

|







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

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 {'. */
    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 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, length;


    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
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

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,
				 * the string consists of all bytes up to the
				 * first null character. */
    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) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;







|














|







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

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 '"'. */
    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 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 < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    size_t length = numBytes;
    const char *p = bytes;

    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







|




|







1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
    const char *bytes,
    int numBytes,
    int flags,
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    int length = numBytes;
    const char *p = bytes;

    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
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;







|







2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	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;
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
	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    size_t clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)Tcl_Realloc(clPosition,
				maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }







|




|




|







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
	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)ckrealloc(clPosition,
				maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373

	    /*
	     * Release the temp table we used to collect the locations of
	     * continuation lines, if any.
	     */

	    if (maxNumCL) {
		Tcl_Free(clPosition);
	    }
	} else {
	    Tcl_ResetResult(interp);
	}
    }
    if (tokensLeftPtr != NULL) {
	*tokensLeftPtr = count;







|







2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371

	    /*
	     * Release the temp table we used to collect the locations of
	     * continuation lines, if any.
	     */

	    if (maxNumCL) {
		ckfree(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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static inline int
CommandComplete(
    const char *script,		/* Script to check. */
    size_t numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;







|


|







2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CommandComplete(
    const char *script,		/* Script to check. */
    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
 */

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    size_t length;
    const char *script = TclGetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|












2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
 */

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    int length;
    const char *script = TclGetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclPathObj.c.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

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		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);

/*
 * Define the 'path' object type, which Tcl uses to represent file paths







|







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

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

/*
 * Define the 'path' object type, which Tcl uses to represent file paths
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 */

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 ==
				 *  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. */
    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
				 * 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 */
} FsPath;

/*







|















|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 */

typedef struct FsPath {
    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 ==
				 *  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. */
    int flags;			/* Flags to describe interpretation - see
				 * below. */
    ClientData nativePathPtr;	/* Native representation of this path, which
				 * is filesystem dependent. */
    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 */
} FsPath;

/*
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		size_t curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(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;
		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);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */







|






|












|












|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		int curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		TclGetStringFromObj(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;
		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);
		}
		TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.







|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);

			    while (--curLen >= 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
			    linkStr = TclGetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				size_t i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

		    while (curLen-- > 0) {
			if (IsSeparatorOrNull(linkStr[curLen])) {
			    if (curLen) {
				Tcl_SetObjLength(retVal, curLen);
			    } else {
				Tcl_SetObjLength(retVal, 1);
			    }
			    break;







|

















|







300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
			    linkStr = TclGetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				int i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

		    while (--curLen >= 0) {
			if (IsSeparatorOrNull(linkStr[curLen])) {
			    if (curLen) {
				Tcl_SetObjLength(retVal, curLen);
			    } else {
				Tcl_SetObjLength(retVal, 1);
			    }
			    break;
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	size_t len;
	const char *path = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);







|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	int len;
	const char *path = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
554
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569
		 * 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);

		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







|
>
|







554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
		 * 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.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(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
		/*
		 * 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);

		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







|
>
|







592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
		/*
		 * 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.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(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
		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;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the







|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		int length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
		     * 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));

		    Tcl_IncrRefCount(resultPtr);
		    return resultPtr;
		}
	    }
	    default:
		/* We should never get here */







|







644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
		     * 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,
			    (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
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    size_t length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			length - strlen(extension));

		Tcl_IncrRefCount(root);
		return root;
	    }
	}

	/*







|









|







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
	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    int length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			(int) (length - strlen(extension)));

		Tcl_IncrRefCount(root);
		return root;
	    }
	}

	/*
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
	    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;

		str = TclGetStringFromObj(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!







|







864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
	    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;
		int len;

		str = TclGetStringFromObj(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!
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
		    /*
		     * 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)) {

			if (PATHFLAGS(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			}
			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			}







|







895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
		    /*
		     * 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(Tcl_GetString(elt), '\\') == NULL)) {

			if (PATHFLAGS(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			}
			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			}
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
	    }
	}
    }

    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);
	driveNameLength = 0;







|
<







931
932
933
934
935
936
937
938

939
940
941
942
943
944
945
	    }
	}
    }

    assert ( res == NULL );

    for (i = 0; i < elements; i++) {
	int driveNameLength, strEltLen, length;

	Tcl_PathType type;
	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;
	Tcl_Obj *elt = objv[i];

	strElt = TclGetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		(void)TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
			strElt++;
		    }







|

|







1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
			strElt++;
		    }
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196

/*
 * 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
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:







|







1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

/*
 * 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 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
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    size_t 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.







|







1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    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.
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    TclNewObj(pathPtr);
    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);







|







1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283

	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    TclNewObj(pathPtr);
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312

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







|




|







1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313

    /*
     * 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.
     */
    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;
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
}

static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{

    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.
     */
    bytes = TclGetStringFromObj(tail, &length);
    if (length == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}








>


<









|
|







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
}

static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    int numBytes;
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);


    /*
     * 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.
     */
    bytes = TclGetStringFromObj(tail, &numBytes);
    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}

1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

Tcl_Obj *
TclFSMakePathRelative(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    size_t cwdLen, len;
    const char *tempStr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {







|







1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399

Tcl_Obj *
TclFSMakePathRelative(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    int cwdLen, len;
    const char *tempStr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
{
    FsPath *fsPathPtr;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;








|







1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
{
    FsPath *fsPathPtr;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;

1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
 *	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.
 *
 * Results:
 *	NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *	New memory may be allocated.
 *







|







1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
 *	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
 *	'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.
 *
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542

    /*
     * Free old representation; shouldn't normally be any, but best to be
     * safe.
     */

    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;







|







1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543

    /*
     * Free old representation; shouldn't normally be any, but best to be
     * safe.
     */

    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
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);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;







|

|







1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
Tcl_FSGetTranslatedStringPath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = (char *)ckalloc(len+1);

	memcpy(result, orig, 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
    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 pathType;

	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	TclGetString(pathPtr);

	(void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);







|
<









|







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
    if (PATHFLAGS(pathPtr) != 0) {
	/*
	 * This is a special path object which is the result of something like
	 * 'file join'
	 */

	Tcl_Obj *dir, *copy;
	int tailLen, cwdLen, pathType;


	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	TclGetString(pathPtr);

	TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
	    TclGetString(pathPtr);
	    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    size_t cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (TclGetString(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);







|





|







1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
	    TclGetString(pathPtr);
	    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(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);
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    size_t firstLen, secondLen;
    int tempErrno;

    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;







|
<







2137
2138
2139
2140
2141
2142
2143
2144

2145
2146
2147
2148
2149
2150
2151

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    int firstLen, secondLen, tempErrno;


    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
 */

static int
SetFsPathFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    size_t len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    const char *name;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }







|







2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
 */

static int
SetFsPathFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    const char *name;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243

    /*
     * Handle tilde substitutions, if needed.
     */

    if (len && name[0] == '~') {
	Tcl_DString temp;
	size_t 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);







|







2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242

    /*
     * Handle tilde substitutions, if needed.
     */

    if (len && name[0] == '~') {
	Tcl_DString temp;
	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);
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332

		/*
		 * Skip '~'. It's replaced by its expansion.
		 */

		objc--; objv++;
		while (objc--) {
		    TclpNativeJoinPath(transPtr, TclGetString(*objv));
		    objv++;
		}
		TclDecrRefCount(parts);
	    } else {
		Tcl_Obj *pair[2];

		pair[0] = transPtr;
		pair[1] = Tcl_NewStringObj(name+split+1, -1);







|
<







2316
2317
2318
2319
2320
2321
2322
2323

2324
2325
2326
2327
2328
2329
2330

		/*
		 * Skip '~'. It's replaced by its expansion.
		 */

		objc--; objv++;
		while (objc--) {
		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));

		}
		TclDecrRefCount(parts);
	    } else {
		Tcl_Obj *pair[2];

		pair[0] = transPtr;
		pair[1] = Tcl_NewStringObj(name+split+1, -1);
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
    }

    /*
     * 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));

    if (transPtr == pathPtr) {
        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
    }







|







2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    if (transPtr == pathPtr) {
        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
    }
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418

	if (freeProc != NULL) {
	    freeProc(fsPathPtr->nativePathPtr);
	    fsPathPtr->nativePathPtr = NULL;
	}
    }

    Tcl_Free(fsPathPtr);
}

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));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
    if (copyFsPathPtr->translatedPathPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
    }







|








|







2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416

	if (freeProc != NULL) {
	    freeProc(fsPathPtr->nativePathPtr);
	    fsPathPtr->nativePathPtr = NULL;
	}
    }

    ckfree(fsPathPtr);
}

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 *)ckalloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
    if (copyFsPathPtr->translatedPathPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
    }
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
 */

static void
UpdateStringOfFsPath(
    Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    size_t cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);







|







2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
 */

static void
UpdateStringOfFsPath(
    Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    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);
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
    } 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
	 * situation.
	 */

	size_t len;

	(void) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */








|







2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
    } 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
	 * situation.
	 */

	int len;

	(void) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

Changes to generic/tclPipe.c.
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *)Tcl_Alloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}







|







184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *)ckalloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = detPtr->nextPtr;
	}
	Tcl_Free(detPtr);
	detPtr = nextPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------







|







234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = detPtr->nextPtr;
	}
	ckfree(detPtr);
	detPtr = nextPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    TclNewObj(objPtr);
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));
	    } else if (count > 0) {
		anyErrorInfo = 1;
		Tcl_SetObjResult(interp, objPtr);
		result = TCL_ERROR;
	    } else {
		Tcl_DecrRefCount(objPtr);
	    }
	}
	Tcl_CloseEx(NULL, errorChan, 0);
    }

    /*
     * If a child exited abnormally but didn't output any error information at
     * all, generate an error message here.
     */








|














|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    TclNewObj(objPtr);
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    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)));
	    } else if (count > 0) {
		anyErrorInfo = 1;
		Tcl_SetObjResult(interp, objPtr);
		result = TCL_ERROR;
	    } else {
		Tcl_DecrRefCount(objPtr);
	    }
	}
	Tcl_Close(NULL, errorChan);
    }

    /*
     * If a child exited abnormally but didn't output any error information at
     * all, generate an error message here.
     */

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834

    /*
     * 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));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;







|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834

    /*
     * Scan through the argc array, creating a process for each group of
     * arguments between the "|" characters.
     */

    Tcl_ReapDetachedProcs();
    pidPtr = (Tcl_Pid *)ckalloc(cmdCount * sizeof(Tcl_Pid));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
    }
    if (pidPtr != NULL) {
	for (i = 0; i < numPids; i++) {
	    if (pidPtr[i] != (Tcl_Pid) -1) {
		Tcl_DetachPids(1, &pidPtr[i]);
	    }
	}
	Tcl_Free(pidPtr);
    }
    numPids = -1;
    goto cleanup;
}

/*
 *----------------------------------------------------------------------







|







974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
    }
    if (pidPtr != NULL) {
	for (i = 0; i < numPids; i++) {
	    if (pidPtr[i] != (Tcl_Pid) -1) {
		Tcl_DetachPids(1, &pidPtr[i]);
	    }
	}
	ckfree(pidPtr);
    }
    numPids = -1;
    goto cleanup;
}

/*
 *----------------------------------------------------------------------
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
	goto error;
    }
    return channel;

  error:
    if (numPids > 0) {
	Tcl_DetachPids(numPids, pidPtr);
	Tcl_Free(pidPtr);
    }
    if (inPipe != NULL) {
	TclpCloseFile(inPipe);
    }
    if (outPipe != NULL) {
	TclpCloseFile(outPipe);
    }







|







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
	goto error;
    }
    return channel;

  error:
    if (numPids > 0) {
	Tcl_DetachPids(numPids, pidPtr);
	ckfree(pidPtr);
    }
    if (inPipe != NULL) {
	TclpCloseFile(inPipe);
    }
    if (outPipe != NULL) {
	TclpCloseFile(outPipe);
    }
Changes to generic/tclPkg.c.
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
/*
 * 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;
    PkgAvail *availPtr;		/* First in list of all available versions of
				 * this package. */
    const void *clientData;	/* Client data. */
} Package;

typedef struct Require {







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
/*
 * 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 Package {
    Tcl_Obj *version;
    PkgAvail *availPtr;		/* First in list of all available versions of
				 * this package. */
    const void *clientData;	/* Client data. */
} Package;

typedef struct Require {
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
    } while (0)

/*







|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = (char *)ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
    } while (0)

/*
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	Tcl_Free(pvi);
	return TCL_ERROR;
    }

    res = CompareVersions(pvi, vi, NULL);
    Tcl_Free(pvi);
    Tcl_Free(vi);

    if (res == 0) {
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }







|




|
|







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	ckfree(pvi);
	return TCL_ERROR;
    }

    res = CompareVersions(pvi, vi, NULL);
    ckfree(pvi);
    ckfree(vi);

    if (res == 0) {
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
    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;
}








|









|














|







232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;

	pkgFiles->names = name->nextPtr;
	ckfree(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);
    ckfree(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 *)ckalloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}

466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    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,







|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    Tcl_Obj **reqv = (Tcl_Obj **)data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;

    if (code != TCL_OK) {
	return code;
    }
    reqPtr = (Require *)ckalloc(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,
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version),
		&pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	Tcl_Free(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, Tcl_GetString(reqPtr->pkgPtr->version)));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);







|







606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version),
		&pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	ckfree(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, Tcl_GetString(reqPtr->pkgPtr->version)));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

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,







|







634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

static int
PkgRequireCoreCleanup(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    ckfree(data[0]);
    return result;
}

static int
SelectPackage(
    ClientData data[],
    Tcl_Interp *interp,
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
	 * Check satisfaction of requirements before considering the current
	 * version further.
	 */

	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		Tcl_Free(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.
		 */

		Tcl_Free(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) {
	    Tcl_Free(availVersion);
	    availVersion = NULL;
	    continue;
	}

	if (bestStablePtr != NULL) {
	    int res = CompareVersions(availVersion, bestStableVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * This stable version of the package sought is better than
		 * the currently selected stable version.
		 */

		Tcl_Free(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);
	}

	Tcl_Free(availVersion);
	availVersion = NULL;
    } /* end for */

    /*
     * Clean up memorized internal reps, if any.
     */

    if (bestVersion != NULL) {
	Tcl_Free(bestVersion);
	bestVersion = NULL;
    }

    if (bestStableVersion != NULL) {
	Tcl_Free(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.







|


















|














|

















|















|








|




|







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
	 * 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 (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.
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838

	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	 */

	pkgName = (PkgName *)Tcl_Alloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;







|







824
825
826
827
828
829
830
831
832
833
834
835
836
837
838

	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	 */

	pkgName = (PkgName *)ckalloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
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
    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */

    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    Tcl_Free(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (TCL_OK != CheckVersionAndConvert(interp,
		    Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		Tcl_Free(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

		Tcl_Free(pvi);
		Tcl_Free(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
			    name, Tcl_GetString(reqPtr->pkgPtr->version)));







|




















|




|
|







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
    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */

    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    ckfree(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (TCL_OK != CheckVersionAndConvert(interp,
		    Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		ckfree(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

		ckfree(pvi);
		ckfree(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
			    name, Tcl_GetString(reqPtr->pkgPtr->version)));
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const pkgOptions[] = {
	"files",  "forget",  "ifneeded", "names",   "prefer",
	"present", "provide", "require",  "unknown", "vcompare",
	"versions", "vsatisfies", NULL
    };
    enum pkgOptions {
	PKG_FILES,  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;
    PkgAvail *availPtr, *prevPtr;







|







1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const pkgOptions[] = {
	"files",  "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
    };
    Interp *iPtr = (Interp *) interp;
    int optionIndex, exact, i, newobjc, satisfies;
    PkgAvail *availPtr, *prevPtr;
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
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    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: {







|









|
|
<







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
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum pkgOptionsEnum) 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, Tcl_GetString(objv[2]));

	    if (entry) {
		Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
	    }
	}
	break;
    }
    case PKG_FORGET: {
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
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		Tcl_Free(availPtr);
	    }
	    Tcl_Free(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	size_t length;
	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);
		return TCL_OK;
	    }
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(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);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    Tcl_Free(avi);

	    if (res == 0) {
		if (objc == 4) {
		    Tcl_Free(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	Tcl_Free(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = (PkgAvail *)Tcl_Alloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {







|

|




|
<














|












|




|



|












|





|







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
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		ckfree(availPtr);
	    }
	    ckfree(pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	int length, 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) {
		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(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) {
		ckfree(argv3i);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    ckfree(avi);

	    if (res == 0) {
		if (objc == 4) {
		    ckfree(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = (PkgAvail *)ckalloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv3, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	} else {
	    int i, newobjc = objc-3;
	    Tcl_Obj *const *newobjv = objv + 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++) {







<


>







1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv3, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	} 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++) {
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	size_t length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_Free(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, length+1);
	    }







|








|







1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	}
	break;
    case PKG_UNKNOWN: {
	int length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		ckfree(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, length+1);
	    }
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
	    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);
	    }

	    /*
	     * 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);
	break;
    case PKG_VERSIONS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj;







|















|
|







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 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) {
		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)));
	ckfree(iva);
	ckfree(ivb);
	break;
    case PKG_VERSIONS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj;
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
	    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);
	    return TCL_ERROR;
	}

	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
	Tcl_Free(argv2i);

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }







|




|







1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
	    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) {
	    ckfree(argv2i);
	    return TCL_ERROR;
	}

	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
	ckfree(argv2i);

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
    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->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
    }







|







1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
    Package *pkgPtr;

    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
    if (isNew) {
	pkgPtr = (Package *)ckalloc(sizeof(Package));
	pkgPtr->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
    }
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    Tcl_Free(availPtr);
	}
	Tcl_Free(pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	Tcl_Free(iPtr->packageUnknown);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CheckVersionAndConvert --







|

|



|







1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    ckfree(availPtr);
	}
	ckfree(pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	ckfree(iPtr->packageUnknown);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CheckVersionAndConvert --
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
    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 *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.







|







1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
    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 *)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
	prevChar = *p;
    }
    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
	*ip = '\0';
	if (internal != NULL) {
	    *internal = ibuf;
	} else {
	    Tcl_Free(ibuf);
	}
	if (stable != NULL) {
	    *stable = !hasunstable;
	}
	return TCL_OK;
    }

  error:
    Tcl_Free(ibuf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected version number but got \"%s\"", string));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", 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
	prevChar = *p;
    }
    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
	*ip = '\0';
	if (internal != NULL) {
	    *internal = ibuf;
	} else {
	    ckfree(ibuf);
	}
	if (stable != NULL) {
	    *stable = !hasunstable;
	}
	return TCL_OK;
    }

  error:
    ckfree(ibuf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected version number but got \"%s\"", string));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
    return TCL_ERROR;
}

/*
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
	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().
     */

    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);
	return TCL_ERROR;
    }

    Tcl_Free(buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddRequirementsToResult --







|










|



|







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

    /*
     * 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 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))) {
	ckfree(buf);
	return TCL_ERROR;
    }

    ckfree(buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddRequirementsToResult --
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
    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;
    size_t length;

    for (i = 0; i < reqc; i++) {
	const char *v = TclGetStringFromObj(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));







|
<







2064
2065
2066
2067
2068
2069
2070
2071

2072
2073
2074
2075
2076
2077
2078
    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, length;


    for (i = 0; i < reqc; i++) {
	const char *v = TclGetStringFromObj(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));
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
	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);
	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.







|







2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
	char *reqi = NULL;
	int thisIsMajor;

	CheckVersionAndConvert(NULL, req, &reqi, NULL);
	strcat(reqi, " -2");
	res = CompareVersions(havei, reqi, &thisIsMajor);
	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
	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
	 * 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);
	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.







|
|







2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
	 * 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);
	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
    } 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);
    return satisfied;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgInitStubsCheck --







|
|
|







2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
    } else {
	strcat(min, " -2");
	strcat(max, " -2");
	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
		(CompareVersions(havei, max, NULL) < 0));
    }

    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

const char *
Tcl_PkgInitStubsCheck(
    Tcl_Interp *interp,
    const char * version,
    int exact)
{
    const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);

    if ((exact&1) && 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);
		return NULL;
	    }
	} else {
	    return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
	}
    }
    return actualVersion;
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|











|



|











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

const char *
Tcl_PkgInitStubsCheck(
    Tcl_Interp *interp,
    const char * version,
    int exact)
{
    const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);

    if ((exact&1) && 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_PkgPresent(interp, "Tcl", version, 1);
		return NULL;
	    }
	} else {
	    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
 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
 *				configuration values.
 */

#include "tclInt.h"





/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if TCL_THREADS
#  define  CFG_THREADED		"1"







>
>
>
>







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 *
 * - 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
#  define  CFG_THREADED		"1"
Changes to generic/tclPlatDecls.h.
46
47
48
49
50
51
52








53
54



55
56
57
58
59
60
61
62
63
64
65
66




67
68

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






85
86


87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103




104
105
106
107

108
109
110
extern "C" {
#endif

/*
 * Exported function declarations:
 */









#ifdef MAC_OSX_TCL /* MACOSX */
/* Slot 0 is reserved */



/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, size_t maxPathLen,
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *hooks;





#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 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */







#ifdef MAC_OSX_TCL /* MACOSX */
/* Slot 0 is reserved */


#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

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







>
>
>
>
>
>
>
>

|
>
>
>




|







>
>
>
>

<
>
|















>
>
>
>
>
>

<
>
>
















|
>
>
>
>




>



46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
extern "C" {
#endif

/*
 * Exported function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *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 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */

    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */

#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !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(__CYGWIN__))\
	&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
#undef Tcl_WinUtfToTChar
#undef Tcl_WinTCharToUtf
#ifdef _WIN32
#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

#endif /* _TCLPLATDECLS */
Changes to generic/tclPreserve.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

/*
 * 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
				 * *firstRefPtr. */
static size_t 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 {
    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







|

|













|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

/*
 * 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 int spaceAvl = 0;	/* Total number of structures available at
				 * *firstRefPtr. */
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 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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 */

void
TclFinalizePreserve(void)
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
	Tcl_Free(refArray);
	refArray = NULL;
	inUse = 0;
	spaceAvl = 0;
    }
    Tcl_MutexUnlock(&preserveMutex);
}








|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 */

void
TclFinalizePreserve(void)
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
	ckfree(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
 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.
     */

    Tcl_MutexLock(&preserveMutex);







|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    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
    /*
     * 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 *)Tcl_Realloc(refArray, spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];







|







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
    /*
     * 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(refArray, spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {







|







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    int i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
	 * Only then should we dabble around with potentially-slow memory
	 * managers...
	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		Tcl_Free(clientData);
	    } else {
		freeProc((char *)clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
	 * Only then should we dabble around with potentially-slow memory
	 * managers...
	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		ckfree(clientData);
	    } else {
		freeProc((char *)clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

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;

    /*
     * 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);







|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

void
Tcl_EventuallyFree(
    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    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);
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	Tcl_Free(clientData);
    } else {
	freeProc((char *)clientData);
    }
}

/*
 *---------------------------------------------------------------------------







|







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	ckfree(clientData);
    } else {
	freeProc((char *)clientData);
    }
}

/*
 *---------------------------------------------------------------------------
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336

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

    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;







|







322
323
324
325
326
327
328
329
330
331
332
333
334
335
336

TclHandle
TclHandleCreate(
    void *ptr)			/* Pointer to an arbitrary block of memory to
				 * be tracked for deletion. Must not be
				 * NULL. */
{
    HandleStruct *handlePtr = (HandleStruct *)ckalloc(sizeof(HandleStruct));

    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
	Tcl_Free(handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --







|







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
	ckfree(handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	Tcl_Free(handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	ckfree(handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclProc.c.
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	     * 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));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = (int *)Tcl_Alloc(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);







|



|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	     * 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 *)ckalloc(sizeof(CmdFrame));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		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);
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

		    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);
		    cfOldPtr->line = NULL;
		    Tcl_Free(cfOldPtr);
		}
		Tcl_SetHashValue(hePtr, cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope; account for the reference
	     * that it's holding to the path name.







|

|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

		    CmdFrame *cfOldPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);

		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
			cfOldPtr->data.eval.path = NULL;
		    }
		    ckfree(cfOldPtr->line);
		    cfOldPtr->line = NULL;
		    ckfree(cfOldPtr);
		}
		Tcl_SetHashValue(hePtr, cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope; account for the reference
	     * that it's holding to the path name.
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
     *	   seem to make a lot of sense to verify the number of arguments we
     *	   are about to ignore ...
     *	 - could be enhanced to handle also non-empty bodies that contain only
     *	   comments; however, parsing the body will slow down the compilation
     *	   of all procs whose argument list is just _args_
     */

    if (objv[3]->typePtr == &tclProcBodyType) {
	goto done;
    }

    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
    }

    if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
	size_t numBytes;

	procArgs +=4;
	while (*procArgs != '\0') {
	    if (*procArgs != ' ') {
		goto done;
	    }
	    procArgs++;







|










|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
     *	   seem to make a lot of sense to verify the number of arguments we
     *	   are about to ignore ...
     *	 - could be enhanced to handle also non-empty bodies that contain only
     *	   comments; however, parsing the body will slow down the compilation
     *	   of all procs whose argument list is just _args_
     */

    if (TclHasIntRep(objv[3], &tclProcBodyType)) {
	goto done;
    }

    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
    }

    if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
	int numBytes;

	procArgs +=4;
	while (*procArgs != '\0') {
	    if (*procArgs != ' ') {
		goto done;
	    }
	    procArgs++;
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	 * 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;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	 * 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;
	    int length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
	 * 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->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;







|







463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
	 * 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 *)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;
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
    } else {
	procPtr->numArgs = numArgs;
	procPtr->numCompiledLocals = numArgs;
    }

    for (i = 0; i < numArgs; i++) {
	const char *argname, *argnamei, *argnamelast;
	int fieldCount;
	size_t nameLength;
	Tcl_Obj **fieldValues;

	/*
	 * Now divide the specifier up into name and default.
	 */

	result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,







|
<







503
504
505
506
507
508
509
510

511
512
513
514
515
516
517
    } else {
	procPtr->numArgs = numArgs;
	procPtr->numCompiledLocals = numArgs;
    }

    for (i = 0; i < numArgs; i++) {
	const char *argname, *argnamei, *argnamelast;
	int fieldCount, nameLength;

	Tcl_Obj **fieldValues;

	/*
	 * Now divide the specifier up into name and default.
	 */

	result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = TclGetStringFromObj(fieldValues[0], &nameLength);

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argnamei = argname;
	argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;
	while (argnamei < argnamelast) {
	    if (*argnamei == '(') {
		if (*argnamelast == ')') { /* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
			    TclGetString(fieldValues[0])));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
		    goto procError;
		}
	    } else if (*argnamei == ':' && *(argnamei+1) == ':') {
		Tcl_Obj *errorObj = Tcl_NewStringObj(
		    "formal parameter \"", -1);







|












|







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argnamei = argname;
	argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;
	while (argnamei < argnamelast) {
	    if (*argnamei == '(') {
		if (*argnamelast == ')') { /* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
			    Tcl_GetString(fieldValues[0])));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
		    goto procError;
		}
	    } else if (*argnamei == ':' && *(argnamei+1) == ':') {
		Tcl_Obj *errorObj = Tcl_NewStringObj(
		    "formal parameter \"", -1);
596
597
598
599
600
601
602
603
604

605

606
607
608
609
610
611
612
	    }

	    /*
	     * 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);


		if ((valueLength != tmpLength)
		     || memcmp(value, tmpPtr, tmpLength) != 0
		) {
		    Tcl_Obj *errorObj = Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"", procName);
		    Tcl_AppendObjToObj(errorObj, fieldValues[0]);







<
|
>
|
>







595
596
597
598
599
600
601

602
603
604
605
606
607
608
609
610
611
612
	    }

	    /*
	     * Compare the default value if any.
	     */

	    if (localPtr->defValuePtr != NULL) {

		const char *tmpPtr = TclGetString(localPtr->defValuePtr);
		size_t tmpLength = localPtr->defValuePtr->length;
		const char *value = TclGetString(fieldValues[1]);
		size_t valueLength = fieldValues[1]->length;

		if ((valueLength != tmpLength)
		     || memcmp(value, tmpPtr, tmpLength) != 0
		) {
		    Tcl_Obj *errorObj = Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"", procName);
		    Tcl_AppendObjToObj(errorObj, fieldValues[0]);
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
	    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);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }







|







628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = (CompiledLocal *)ckalloc(
		    offsetof(CompiledLocal, name) + fieldValues[0]->length + 1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
	    localPtr = procPtr->firstLocalPtr;
	    procPtr->firstLocalPtr = localPtr->nextPtr;

	    if (localPtr->defValuePtr != NULL) {
		Tcl_DecrRefCount(localPtr->defValuePtr);
	    }

	    Tcl_Free(localPtr);
	}
	Tcl_Free(procPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|

|







674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
	    localPtr = procPtr->firstLocalPtr;
	    procPtr->firstLocalPtr = localPtr->nextPtr;

	    if (localPtr->defValuePtr != NULL) {
		Tcl_DecrRefCount(localPtr->defValuePtr);
	    }

	    ckfree(localPtr);
	}
	ckfree(procPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
    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;







|







906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
    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;
1075
1076
1077
1078
1079
1080
1081

1082



1083
1084
1085
1086
1087
1088
1089
    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
	    sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {

	desiredObjs[0] = framePtr->objv[skip-1];



    }
    Tcl_IncrRefCount(desiredObjs[0]);

    if (localCt > 0) {
	Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

	for (i=1 ; i<=numArgs ; i++, defPtr++) {







>

>
>
>







1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
	    sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = framePtr->objv[skip-1];
#else
	desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
    }
    Tcl_IncrRefCount(desiredObjs[0]);

    if (localCt > 0) {
	Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
1110
1111
1112
1113
1114
1115
1116
















































1117
1118
1119
1120
1121
1122
1123

    for (i=0 ; i<=numArgs ; i++) {
	Tcl_DecrRefCount(desiredObjs[i]);
    }
    TclStackFree(interp, desiredObjs);
    return TCL_ERROR;
}

















































/*
 *----------------------------------------------------------------------
 *
 * InitResolvedLocals --
 *
 *	This routine is invoked in order to initialize the compiled locals







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







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

    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;
    ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
    if (codePtr == NULL) {
	Tcl_Panic("body object for proc attached to frame is not a byte code type");
    }

    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
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181

    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);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;

	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {







|







1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233

    firstLocalPtr = localPtr;
    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	if (localPtr->resolveInfo) {
	    if (localPtr->resolveInfo->deleteProc) {
		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
	    } else {
		ckfree(localPtr->resolveInfo);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;

	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
	Tcl_Obj *objPtr = *namePtrPtr;

	if (objPtr) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
	    TclReleaseLiteral(interp, objPtr);
	}
    }
    Tcl_Free(localCachePtr);
}

static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;







|







1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
	Tcl_Obj *objPtr = *namePtrPtr;

	if (objPtr) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
	    TclReleaseLiteral(interp, objPtr);
	}
    }
    ckfree(localCachePtr);
}

static void
InitLocalCache(
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
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

    /*
     * 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));

    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);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;







|











|







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

    /*
     * 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 *)ckalloc(offsetof(LocalCache, varName0)
	    + localCt * 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 */ (unsigned int) -1,
		    &isNew, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
		CompiledLocal *toFree = clPtr;

		clPtr = clPtr->nextPtr;
		if (toFree->resolveInfo) {
		    if (toFree->resolveInfo->deleteProc) {
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			Tcl_Free(toFree->resolveInfo);
		    }
		}
		Tcl_Free(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);








|


|







2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
		CompiledLocal *toFree = clPtr;

		clPtr = clPtr->nextPtr;
		if (toFree->resolveInfo) {
		    if (toFree->resolveInfo->deleteProc) {
			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			ckfree(toFree->resolveInfo);
		    }
		}
		ckfree(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	}

	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);

2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
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;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(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)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --







|
<





|







2080
2081
2082
2083
2084
2085
2086
2087

2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
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. */
{
    int overflow, limit = 60, nameLen;

    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --
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
	CompiledLocal *nextPtr = localPtr->nextPtr;

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo) {
	    if (resVarInfo->deleteProc) {
		resVarInfo->deleteProc(resVarInfo);
	    } else {
		Tcl_Free(resVarInfo);
	    }
	}

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	Tcl_Free(localPtr);
	localPtr = nextPtr;
    }
    Tcl_Free(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.
     */








|







|


|







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
	CompiledLocal *nextPtr = localPtr->nextPtr;

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo) {
	    if (resVarInfo->deleteProc) {
		resVarInfo->deleteProc(resVarInfo);
	    } else {
		ckfree(resVarInfo);
	    }
	}

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	ckfree(localPtr);
	localPtr = nextPtr;
    }
    ckfree(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.
     */

2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
    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);
	cfPtr->line = NULL;
	Tcl_Free(cfPtr);
    }
    Tcl_DeleteHashEntry(hePtr);
}

/*
 *----------------------------------------------------------------------
 *







|

|







2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
    cfPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);

    if (cfPtr) {
	if (cfPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(cfPtr->data.eval.path);
	    cfPtr->data.eval.path = NULL;
	}
	ckfree(cfPtr->line);
	cfPtr->line = NULL;
	ckfree(cfPtr);
    }
    Tcl_DeleteHashEntry(hePtr);
}

/*
 *----------------------------------------------------------------------
 *
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
     * 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))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"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];








|







2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
     * 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))) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't interpret \"%s\" as a lambda expression",
		Tcl_GetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
	return TCL_ERROR;
    }

    argsPtr = objv[0];
    bodyPtr = objv[1];

2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
		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));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = (int *)Tcl_Alloc(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);







|




|







2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
		int buf[2];

		/*
		 * Move from approximation (line of list cmd word) to actual
		 * location (line of 2nd list element).
		 */

		cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		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);
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
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;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(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)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetCmdFrameForProcedure --







|
<





|







2750
2751
2752
2753
2754
2755
2756
2757

2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
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. */
{
    int overflow, limit = 60, nameLen;

    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetCmdFrameForProcedure --
Changes to generic/tclProcess.c.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 * 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,







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 * 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, int 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,
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    Tcl_Free(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *







|







126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    ckfree(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

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.







|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
WaitProcessStatus(
    Tcl_Pid pid,		/* Process id. */
    int 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.
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
    int result;
    int i;
    int pid;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };
    enum switches {
	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 switches) index) {
	    options = 0;
	} else {
	    break;
	}
    }

    if (objc != 1 && objc != 2) {







|












|







468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
    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) {
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    size_t resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */







|







796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    int resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
	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);







|







830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
	FreeProcessInfo(info);
    }

    /*
     * Allocate and initialize info structure.
     */

    info = (ProcessInfo *)ckalloc(sizeof(ProcessInfo));
    InitProcessInfo(info, pid, resolvedPid);

    /*
     * Add entry to tables.
     */

    Tcl_SetHashValue(entry, info);
Changes to generic/tclRegexp.c.
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#define NUM_REGEXPS 30

typedef struct {
    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
				 * 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);
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);
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.
 */








|














|






|
|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#define NUM_REGEXPS 30

typedef struct {
    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. */
    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,
			    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, 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.
 */

186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
				 * 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;
    size_t numChars;
    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 "^".







|
<







186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
				 * 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, numChars;

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

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,
				 * > 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) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {







|










|







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
 *---------------------------------------------------------------------------
 */

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    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 ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322
323
324
325
326
327

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


    if (nm >= last) {
	nm = last;
    }

    status = TclReExec(&regexpPtr->re, wString, numChars,
	    &regexpPtr->details, nm, regexpPtr->matches, flags);

    /*
     * Check for errors.
     */

    if (status != REG_OKAY) {







|
>
|







>

|
|


|







298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328

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. */
    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 (nmatches >= 0 && (size_t) nmatches < nm) {
	nm = (size_t) nmatches;
    }

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

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,
				 * > 0 means give the range of a matching
				 * subrange, TCL_INDEX_NONE means the range of the
				 * rm_extend field. */
    size_t *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    size_t *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)) {
	*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 {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}







|



|

|







|







358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
 *---------------------------------------------------------------------------
 */

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    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
				 * rm_extend field. */
    int *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    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)) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = TCL_INDEX_NONE;
	*endPtr = TCL_INDEX_NONE;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
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
				 * should begin. */
    size_t 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 reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(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)







|

|






|







438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
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. */
    int offset,			/* Character index that marks where matching
				 * should begin. */
    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;
    int length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
	(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)
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = TclGetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;








|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = Tcl_GetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;

589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
				 * 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;
    TclRegexp *regexpPtr;
    const char *pattern;

    RegexpGetIntRep(objPtr, regexpPtr);

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
	pattern = TclGetStringFromObj(objPtr, &length);







|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
				 * 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. */
{
    int length;
    TclRegexp *regexpPtr;
    const char *pattern;

    RegexpGetIntRep(objPtr, regexpPtr);

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
	pattern = TclGetStringFromObj(objPtr, &length);
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
    /*
     * 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);

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);







|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
    /*
     * 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);
    TclNewIntObj(infoObj, regexpPtr->re.re_nsub);
    Tcl_ListObjAppendElement(NULL, resultObj, infoObj);

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
 *----------------------------------------------------------------------
 */

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 flags)			/* Compilation flags. */
{
    TclRegexp *regexpPtr;
    const Tcl_UniChar *uniString;
    int numChars, status, i, exact;
    Tcl_DString stringBuf;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);







|







854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
 *----------------------------------------------------------------------
 */

static TclRegexp *
CompileRegexp(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    const char *string,		/* The regexp to compile (UTF-8). */
    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
	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    regexpPtr = (TclRegexp*)Tcl_Alloc(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.







|







912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    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
    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	Tcl_Free(regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ", status);
	}
	return NULL;
    }








|







939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	ckfree(regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ", status);
	}
	return NULL;
    }

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

    /*
     * 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));

    /*
     * 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) {
	    FreeRegexp(oldRegexpPtr);
	}
	Tcl_Free(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->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}








|


















|






|







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

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.
     */

    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) {
	    FreeRegexp(oldRegexpPtr);
	}
	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 *)ckalloc(length + 1);
    memcpy(tsdPtr->patterns[0], string, length + 1);
    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
    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->globObjPtr) {
	TclDecrRefCount(regexpPtr->globObjPtr);
    }
    if (regexpPtr->matches) {
	Tcl_Free(regexpPtr->matches);
    }
    Tcl_Free(regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *







|

|







1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->globObjPtr) {
	TclDecrRefCount(regexpPtr->globObjPtr);
    }
    if (regexpPtr->matches) {
	ckfree(regexpPtr->matches);
    }
    ckfree(regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
    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) {
	    FreeRegexp(regexpPtr);
	}
	Tcl_Free(tsdPtr->patterns[i]);
	tsdPtr->patterns[i] = NULL;
    }

    /*
     * We may find ourselves reinitialized if another finalization routine
     * invokes regexps.
     */







|







1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
    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) {
	    FreeRegexp(regexpPtr);
	}
	ckfree(tsdPtr->patterns[i]);
	tsdPtr->patterns[i] = NULL;
    }

    /*
     * We may find ourselves reinitialized if another finalization routine
     * invokes regexps.
     */
Changes to generic/tclResolve.c.
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    }

    /*
     * 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));
    len = strlen(name) + 1;
    resPtr->name = (char *)Tcl_Alloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}







|

|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
    }

    /*
     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
     * list, so that it overrides existing schemes.
     */

    resPtr = (ResolverScheme *)ckalloc(sizeof(ResolverScheme));
    len = strlen(name) + 1;
    resPtr->name = (char *)ckalloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	    iPtr->compileEpoch++;
	}
	if (resPtr->cmdResProc) {
	    BumpCmdRefEpochs(iPtr->globalNsPtr);
	}

	*prevPtrPtr = resPtr->nextPtr;
	Tcl_Free(resPtr->name);
	Tcl_Free(resPtr);

	return 1;
    }
    return 0;
}

/*







|
|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
	    iPtr->compileEpoch++;
	}
	if (resPtr->cmdResProc) {
	    BumpCmdRefEpochs(iPtr->globalNsPtr);
	}

	*prevPtrPtr = resPtr->nextPtr;
	ckfree(resPtr->name);
	ckfree(resPtr);

	return 1;
    }
    return 0;
}

/*
Changes to generic/tclResult.c.
23
24
25
26
27
28
29



30
31
32
33
34
35
36
/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);




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








>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);
#ifndef TCL_NO_DEPRECATED
static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
#endif /* !TCL_NO_DEPRECATED */

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

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

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

    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;







|







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

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 *)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;
200
201
202
203
204
205
206
207
208


































































































































































































































































































209
210
211
212
213
214
215
    if (statePtr->returnOpts) {
	Tcl_DecrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_DecrRefCount(statePtr->errorStack);
    }
    Tcl_DecrRefCount(statePtr->objResult);
    Tcl_Free(statePtr);
}



































































































































































































































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
 *	Arrange for objPtr to be an interpreter's result value.







|

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







203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
    if (statePtr->returnOpts) {
	Tcl_DecrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_DecrRefCount(statePtr->errorStack);
    }
    Tcl_DecrRefCount(statePtr->objResult);
    ckfree(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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_SaveResult
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;
    TclNewObj(iPtr->objResultPtr);
    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.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_RestoreResult
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(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.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DiscardResult
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 == TCL_DYNAMIC) {
        ckfree(statePtr->result);
    } else if (statePtr->freeProc) {
        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. */
    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;
    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) {
	int length = strlen(result);

	if (length > TCL_RESULT_SIZE) {
	    iPtr->result = (char *)ckalloc(length + 1);
	    iPtr->freeProc = TCL_DYNAMIC;
	} else {
	    iPtr->result = iPtr->resultSpace;
	    iPtr->freeProc = 0;
	}
	memcpy(iPtr->result, result, length+1);
    } else {
	iPtr->result = (char *) 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(
    Tcl_Interp *interp)/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    if (*(iPtr->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return iPtr->result;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
 *	Arrange for objPtr to be an interpreter's result value.
241
242
243
244
245
246
247

















248
249
250
251
252
253
254

    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);

















}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *







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







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);

#ifndef TCL_NO_DEPRECATED
    /*
     * 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;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
269
270
271
272
273
274
275



276
























277
278



































279
280
281
282
283
284
285
 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;




























    return iPtr->objResultPtr;
}




































/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResult --
 *
 *	Append a variable number of strings onto the interpreter's result.







>
>
>

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


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







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;
#ifndef TCL_NO_DEPRECATED
    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] != 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->result[0] = 0;
    }
#endif /* !TCL_NO_DEPRECATED */
    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);
}

/*
 *----------------------------------------------------------------------
 *
 * 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
 */

void
Tcl_AppendResult(
    Tcl_Interp *interp, ...)
{
    va_list argList;
    Tcl_Obj *objPtr;

    va_start(argList, interp);
    objPtr = Tcl_GetObjResult(interp);

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







<


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







671
672
673
674
675
676
677

678
679

680












681
682
683
684
685
686
687
 */

void
Tcl_AppendResult(
    Tcl_Interp *interp, ...)
{
    va_list argList;


    va_start(argList, interp);

    Tcl_AppendResultVA(interp, argList);












    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendElement --
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364
365
366
367
368
369
370







































































































































371
372









































373
374
375
376
377
378
379
Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;

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







































































































































}










































/*
 *----------------------------------------------------------------------
 *
 * Tcl_ResetResult --
 *
 *	This function resets both the interpreter's string and object results.
 *







>



<




|
|




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


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







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
Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
#ifdef TCL_NO_DEPRECATED
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;


    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = TclGetString(iPtr->objResultPtr);
    if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
#else
    char *dst;
    int size;
    int flags;
    int quoteHash = 1;

    /*
     * 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);
#endif /* !TCL_NO_DEPRECATED */
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
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 *newSpacePtr;

	if (totalSpace < 100) {
	    totalSpace = 200;
	} else {
	    totalSpace *= 2;
	}
	newSpacePtr = (char *)ckalloc(totalSpace);
	strcpy(newSpacePtr, iPtr->result);
	if (iPtr->appendResult != NULL) {
	    ckfree(iPtr->appendResult);
	}
	iPtr->appendResult = newSpacePtr;
	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(
    Tcl_Interp *interp)/* Interpreter for which to free result. */
{
    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);
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ResetResult --
 *
 *	This function resets both the interpreter's string and object results.
 *
392
393
394
395
396
397
398












399
400
401
402
403
404
405
void
Tcl_ResetResult(
    Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);












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







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







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
void
Tcl_ResetResult(
    Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);
#ifndef TCL_NO_DEPRECATED
    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;
#endif /* !TCL_NO_DEPRECATED */
    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);
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467











































468
469
470
471
472
473
474
	TclDecrRefCount(objResultPtr);
	TclNewObj(objResultPtr);
	Tcl_IncrRefCount(objResultPtr);
	iPtr->objResultPtr = objResultPtr;
    } else {
	if (objResultPtr->bytes != &tclEmptyString) {
	    if (objResultPtr->bytes) {
		Tcl_Free(objResultPtr->bytes);
	    }
	    objResultPtr->bytes = &tclEmptyString;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);
    }
}












































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorCode --
 *
 *	This function is called to record machine-readable information about







|







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







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
	TclDecrRefCount(objResultPtr);
	TclNewObj(objResultPtr);
	Tcl_IncrRefCount(objResultPtr);
	iPtr->objResultPtr = objResultPtr;
    } else {
	if (objResultPtr->bytes != &tclEmptyString) {
	    if (objResultPtr->bytes) {
		ckfree(objResultPtr->bytes);
	    }
	    objResultPtr->bytes = &tclEmptyString;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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;

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    TclNewObj(errorObj);
    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 --
 *
 *	This function is called to record machine-readable information about
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
 */

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();

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







<







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







1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088

1089














1090
1091
1092
1093
1094
1095
1096
 */

void
Tcl_SetErrorCode(
    Tcl_Interp *interp, ...)
{
    va_list argList;


    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    va_start(argList, interp);

    Tcl_SetErrorCodeVA(interp, argList);














    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjErrorCode --
555
556
557
558
559
560
561

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
 * 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;
}







>

















>







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
 * Tcl_GetErrorLine --
 *
 *      Returns the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetErrorLine
int
Tcl_GetErrorLine(
    Tcl_Interp *interp)
{
    return ((Interp *) interp)->errorLine;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorLine --
 *
 *      Sets the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetErrorLine
void
Tcl_SetErrorLine(
    Tcl_Interp *interp,
    int value)
{
    ((Interp *) interp)->errorLine = value;
}
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
                &valuePtr);
	if (valuePtr != NULL) {
	    size_t length;

	    (void) TclGetStringFromObj(valuePtr, &length);
	    if (length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
                &valuePtr);







<
<
|
|







1292
1293
1294
1295
1296
1297
1298


1299
1300
1301
1302
1303
1304
1305
1306
1307
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
                &valuePtr);
	if (valuePtr != NULL) {


	    (void) TclGetString(valuePtr);
	    if (valuePtr->length) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
                &valuePtr);
Changes to generic/tclScan.c.
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 */

typedef struct {
    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;
    Range *ranges;
} CharSet;








|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 */

typedef struct {
    Tcl_UniChar start;
    Tcl_UniChar end;
} Range;

typedef struct CharSet {
    int exclude;		/* 1 if this is an exclusion set. */
    int nchars;
    Tcl_UniChar *chars;
    int nranges;
    Range *ranges;
} CharSet;

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
    }

    cset->chars = (Tcl_UniChar *)Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = (Range *)Tcl_Alloc(sizeof(Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */







|

|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
    }

    cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
 *----------------------------------------------------------------------
 */

static void
ReleaseCharSet(
    CharSet *cset)
{
    Tcl_Free(cset->chars);
    if (cset->ranges) {
	Tcl_Free(cset->ranges);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateFormat --







|

|







222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
 *----------------------------------------------------------------------
 */

static void
ReleaseCharSet(
    CharSet *cset)
{
    ckfree(cset->chars);
    if (cset->ranges) {
	ckfree(cset->ranges);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateFormat --
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string format ?varName ...?");
	return TCL_ERROR;
    }

    format = TclGetString(objv[2]);
    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);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = TclGetString(objv[1]);
    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.
     */







|















|





|







583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string format ?varName ...?");
	return TCL_ERROR;
    }

    format = Tcl_GetString(objv[2]);
    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 **)ckalloc(sizeof(Tcl_Obj *) * totalVars);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = Tcl_GetString(objv[1]);
    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.
     */
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
	/*
	 * Handle the various field types.
	 */

	switch (ch) {
	case 'n':
	    if (!(flags & SCAN_SUPPRESS)) {
		objPtr = Tcl_NewWideIntObj(string - baseString);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    nconversions++;
	    continue;








|







712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
	/*
	 * Handle the various field types.
	 */

	switch (ch) {
	case 'n':
	    if (!(flags & SCAN_SUPPRESS)) {
		TclNewIntObj(objPtr, string - baseString);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    nconversions++;
	    continue;

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
	    /*
	     * Scan a single Unicode character.
	     */

	    offset = TclUtfToUCS4(string, &i);
	    string += offset;
	    if (!(flags & SCAN_SUPPRESS)) {
		objPtr = Tcl_NewWideIntObj(i);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    break;

	case 'i':
	    /*
	     * Scan an unsigned or signed integer.
	     */
	    objPtr = Tcl_NewWideIntObj(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)) {
		Tcl_DecrRefCount(objPtr);







|










|







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
	    /*
	     * Scan a single Unicode character.
	     */

	    offset = TclUtfToUCS4(string, &i);
	    string += offset;
	    if (!(flags & SCAN_SUPPRESS)) {
		TclNewIntObj(objPtr, i);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    break;

	case 'i':
	    /*
	     * Scan an unsigned or signed integer.
	     */
	    TclNewIntObj(objPtr, 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)) {
		Tcl_DecrRefCount(objPtr);
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
		    }
		} else {
		    TclSetIntObj(objPtr, wideValue);
		}
	    } else if (flags & SCAN_BIG) {
		if (flags & SCAN_UNSIGNED) {
		    mp_int big;
		    int code = Tcl_GetBignumFromObj(interp, objPtr, &big);

		    if (code == TCL_OK) {
			if (mp_isneg(&big)) {
			    code = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (code == 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;







|

|

|




|

|







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
		    }
		} else {
		    TclSetIntObj(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) {
			    ckfree(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;
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
		 */

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }
	}
    }
    if (objs != NULL) {
	Tcl_Free(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		TclNewIndexObj(objPtr, -1);
	    } else {
		if (objPtr) {
		    Tcl_SetListObj(objPtr, 0, NULL);
		} else {
		    TclNewObj(objPtr);
		}
	    }
	} else if (numVars) {
	    objPtr = Tcl_NewWideIntObj(result);
	}
	Tcl_SetObjResult(interp, objPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|




|








|













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

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }
	}
    }
    if (objs != NULL) {
	ckfree(objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		TclNewIntObj(objPtr, TCL_INDEX_NONE);
	    } else {
		if (objPtr) {
		    Tcl_SetListObj(objPtr, 0, NULL);
		} else {
		    TclNewObj(objPtr);
		}
	    }
	} else if (numVars) {
	    TclNewIntObj(objPtr, result);
	}
	Tcl_SetObjResult(interp, objPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclStrToD.c.
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
				 * 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,
	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;







|








|







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. */
    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, 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
				 * 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 under = 0;              /* Flag trailing '_' as error if true once
				 * number is accepted. */

#define ALL_BITS	((Tcl_WideUInt)-1)
#define MOST_BITS	(ALL_BITS >> 1)








>







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
				 * 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 */
    int explicitOctal = 0;
    mp_err err = MP_OKAY;
    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)

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
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {
		if (under) {
		    goto endgame;
		}

		state = ZERO_O;
		break;
	    }
	    if (c == 'd' || c == 'D') {
		if (under) {
		    goto endgame;
		}
		state = ZERO_D;
		break;
	    }

	    goto decimal;



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







>










>

>
>







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
	    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) {
		    goto endgame;
		}
		state = ZERO_D;
		break;
	    }
#ifdef TCL_NO_DEPRECATED
	    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.
	     */
752
753
754
755
756
757
758
























































759
760
761
762
763
764
765
		state = OCTAL;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
























































	    goto endgame;

	    /*
	     * Scanned 0x. If state is HEXADECIMAL, scanned at least one
	     * character following the 0x. The only acceptable inputs are
	     * hexadecimal digits.
	     */







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







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
		state = OCTAL;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    /* FALLTHROUGH */

	case BAD_OCTAL:
	    if (explicitOctal) {
		/*
		 * No forgiveness for bad digits in explicitly octal numbers.
		 */

		goto endgame;
	    }
	    if (flags & TCL_PARSE_INTEGER_ONLY) {
		/*
		 * No seeking floating point when parsing only integer.
		 */

		goto endgame;
	    }
#ifndef TCL_NO_DEPRECATED

	    /*
	     * 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++;
		under = 0;
		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;
		under = 0;
		state = BAD_OCTAL;
		break;
	    } else if (c == '.') {
		under = 0;
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		under = 0;
		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.
	     */
897
898
899
900
901
902
903

904

905
906
907
908
909
910
911

	case DECIMAL:
	    /*
	     * Scanned an optional + or - followed by a string of decimal
	     * digits.
	     */


	decimal:

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = DECIMAL;







>

>







958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974

	case DECIMAL:
	    /*
	     * Scanned an optional + or - followed by a string of decimal
	     * digits.
	     */

#ifdef TCL_NO_DEPRECATED
	decimal:
#endif
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = DECIMAL;
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

	    while (len != 0 && TclIsSpaceProcM(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    if ((len != 0) && ((numBytes + 1 > 1) || (*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 ZERO_X:
	case ZERO_O:
	case ZERO_B:
	case ZERO_D:
	case LEADING_RADIX_POINT:
	case EXPONENT_START:
	case EXPONENT_SIGNUM:







|















>







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

	    while (len != 0 && TclIsSpaceProcM(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    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:
1462
1463
1464
1465
1466
1467
1468



1469
1470
1471
1472
1473
1474
1475
    if (status != TCL_OK) {
	if (interp != NULL) {
	    Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
		    expected);

	    Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
	    Tcl_AppendToObj(msg, "\"", -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
    if (status != TCL_OK) {
	if (interp != NULL) {
	    Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
		    expected);

	    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.
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
 *
 * 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'.
 *
 * 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);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = (char *)Tcl_Alloc(4);
	strcpy(retval, "NaN");
	if (endPtr) {
	    *endPtr = retval + 3;
	}
    }
    return retval;
}







|


















|





|







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
 *
 * 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 '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 *)ckalloc(9);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = (char *)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
 */

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

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;







|







2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
 */

static inline char *
FormatZero(
    int *decpt,			/* Location of the decimal point. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval = (char *)ckalloc(2);

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;
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
    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);
    if (ilim == 0) {
	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);
	    return NULL;
	}
    }

    /*
     * Format the digit string.
     */

    if (flags & TCL_DD_SHORTEST) {
	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);
	return NULL;
    }
    *end = '\0';
    if (endPtr != NULL) {
	*endPtr = end;
    }
    return retval;







|










|














|







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
    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 *)ckalloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;
	} else {
	    ckfree(retval);
	    return NULL;
	}
    }

    /*
     * Format the digit string.
     */

    if (flags & TCL_DD_SHORTEST) {
	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
    } else {
	end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
    }
    if (end == NULL) {
	ckfree(retval);
	return NULL;
    }
    *end = '\0';
    if (endPtr != NULL) {
	*endPtr = end;
    }
    return retval;
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
    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);
				/* 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. */







|







3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
    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 *)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. */
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
    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);
				/* 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. */







|







3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
    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 *)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. */
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
    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);
				/* 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. */







|







3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
    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 *)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. */
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
    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);
				/* 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;







|







3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
    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 *)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;
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
    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);
				/* 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. */







|







3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
    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 *)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. */
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
    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);
				/* 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. */
    int g;			/* Size of the current digit ground. */







|







4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
    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 *)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. */
    int g;			/* Size of the current digit ground. */
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223

4224
4225
4226
4227
4228
4229
4230
4231
 *	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
 *		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_E_FORMAT - This value is used to prepare numbers for %e format

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







|
|





>
|







4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
 *	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 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_E_FORMAT - This value is used to prepare numbers for %e format
 *		conversion (or for default floating->string if tcl_precision
 *		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
 *		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.
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
    /*
     * 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));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;








|







4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
    /*
     * 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 *)
	    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;

4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
 */

void
TclFinalizeDoubleConversion(void)
{
    int i;

    Tcl_Free(pow10_wide);
    for (i=0; i<9; ++i) {
	mp_clear(pow5 + i);
    }
    for (i=0; i < 5; ++i) {
	mp_clear(pow5_13 + i);
    }
}







|







4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
 */

void
TclFinalizeDoubleConversion(void)
{
    int i;

    ckfree(pow10_wide);
    for (i=0; i<9; ++i) {
	mp_clear(pow5 + i);
    }
    for (i=0; i < 5; ++i) {
	mp_clear(pow5_13 + i);
    }
}
Changes to generic/tclStringObj.c.
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
/*
 * 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);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t 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 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);
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.
 */








|

|

|

|


|
|

|
|


|
|


|
|







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
/*
 * 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, int appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static int		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, int numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, int numBytes,
			    int numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static void		GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
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, 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.
 */

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145

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

181
182
183
184
185
186
187
188
189
190

191
192

193
194
195
196
197
198

199
200

201
202
203
204
205
206
207
208
209
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    size_t needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;
    size_t attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {

	attempt = 2 * needed;
	ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1);

	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    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;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */







|











|





>
|
|
>






|
|
|


|








|








|





>



|






>
|
|
>






>
|

>

|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    int needed,
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;
    int attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	if (needed <= INT_MAX / 2) {
	    attempt = 2 * needed;
	    ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    int needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     *	needed < STRING_MAXCHARS
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    int attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	if (needed <= STRING_MAXCHARS / 2) {
	    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.
	     */

	    unsigned int limit = STRING_MAXCHARS - needed;
	    unsigned int extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;
	    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.
	 */
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272
273
274
275

#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"
				 * 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. */

{
    Tcl_Obj *objPtr;

    if (length == TCL_INDEX_NONE) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */








|











|
|
|
>



|







250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

#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. */
    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. */
    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;

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

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

    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;

    if (length == TCL_INDEX_NONE) {
	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*/)
{
    return Tcl_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */








|
|
|
>







|











|
|
|
>







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
 */

#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. */
    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;

    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. */
    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_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */

358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
 *---------------------------------------------------------------------------
 */

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
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;







|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    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
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

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







|





|







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    int numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
414
415
416
417
418
419
420


421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
     * 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 == TCL_INDEX_NONE) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

/*







>
>
|
|














|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
     * 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)) {
	int length;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	return length;
    }

    /*
     * 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 == -1) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

/*
501
502
503
504
505
506
507
508
509
510
511




512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
 *----------------------------------------------------------------------
 */

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch;





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

    if (TclIsPureByteArray(objPtr)) {
	size_t length = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return bytes[index];
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, 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 (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);







|


|
>
>
>
>







<
|




|














|







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
 *----------------------------------------------------------------------
 */

int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    String *stringPtr;
    int ch, length;

    if (index < 0) {
	return -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.
     */

    if (TclIsPureByteArray(objPtr)) {

	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return (int) bytes[index];
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
566
567
568
569
570
571
572






























573
574
575
576
577
578
579
			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
	}
    }
#endif
    return ch;
}































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	Get the Unicode form of the String object with length. If the object
 *	is not already a String object, it will be converted to one. If the







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







581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
	}
    }
#endif
    return ch;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 created 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetUnicode
Tcl_UniChar *
Tcl_GetUnicode(
    Tcl_Obj *objPtr)		/* The object to find the unicode string
				 * for. */
{
    return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
 *	Get the Unicode form of the String object with length. If the object
 *	is not already a String object, it will be converted to one. If the
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
 *
 *----------------------------------------------------------------------
 */

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. */
{
    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;
    }
    if (last + 2 <= first + 1) {
	return Tcl_NewObj();
    }

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

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}







|
|



|

|
|
<
<
<








|







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

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    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;
    int length;

    if (first < 0) {
	first = 0;



    }

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

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    return Tcl_NewObj();
	}
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
    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 (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {







|







716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
	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;
    }
    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);
}







|



|







748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
	last = stringPtr->numChars;
    }
    if (last < first) {
	return Tcl_NewObj();
    }
#if TCL_UTF_MAX <= 3
    /* See: bug [11ae2be95dac9417] */
    if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 1 < stringPtr->numChars)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
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
 */

void
Tcl_SetStringObj(
    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,
				 * 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);

    /*
     * 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) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------







|
|


















|







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

void
Tcl_SetStringObj(
    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. */
    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);

    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    TclInvalidateStringRep(objPtr);
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------
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
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;










    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

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

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {





	if (length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*







|





>
>
>
>
>
>
>
>
>




















|

|











|


>
>
>
>
>







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

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    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");
    }

    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 *)ckalloc(length + 1);
	    } else {
		objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1);
	    }
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);
	if (length > stringPtr->maxChars) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
889
890
891
892
893
894
895
896
897
898
899
900
901








902
903
904
905
906
907
908
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;









    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }








|





>
>
>
>
>
>
>
>







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

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    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) {
	return 1;
    }

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
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)Tcl_AttemptAlloc(length + 1);
	    } else {
		newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */




	if (length > stringPtr->maxChars) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;







|

|















|






>
>
>







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
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)attemptckalloc(length + 1);
	    } else {
		newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {
	    return 0;
	}
	if (length > stringPtr->maxChars) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
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
 */

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
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeIntRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static size_t
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    size_t numChars = 0;

    if (unicode) {
	while ((numChars != TCL_INDEX_NONE) && (unicode[numChars] != 0)) {
	    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
				 * string. */
{
    String *stringPtr;

    if (numChars == TCL_INDEX_NONE) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */


    stringPtr = stringAlloc(numChars);
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;







|









|



|


|



>








|




|







>







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

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. */
    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 int
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    int numChars = 0;

    if (unicode) {
	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. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

    stringCheckLimits(numChars);
    stringPtr = stringAlloc(numChars);
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
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
 */

void
Tcl_AppendLimitedToObj(
    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
				 * 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;

    if (length == TCL_INDEX_NONE) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }
    if (limit <= 0) {
	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
 */

void
Tcl_AppendLimitedToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    int length,			/* The number of bytes available to be
				 * appended from "bytes". If < 0, then all
				 * bytes up to a NUL byte are available. */
    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;
    int toCopy = 0;
    int eLen = 0;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }
    if (limit <= 0) {
	return;
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
    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) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*







|










|







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
    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 > 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*
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
 */

void
Tcl_AppendToObj(
    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
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclAppendUnicodeToObj --
 *
 *	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. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    size_t length)		/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj");
    }

    if (length == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);







|
|


|





|














|



|




|







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

void
Tcl_AppendToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    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, INT_MAX, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * 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
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    int length)			/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }

    if (length == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255

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;
    size_t appendNumChars = TCL_INDEX_NONE;
    const char *bytes;

    /*
     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */








<
|







1309
1310
1311
1312
1313
1314
1315

1316
1317
1318
1319
1320
1321
1322
1323

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;

    int length, numChars, appendNumChars = -1;
    const char *bytes;

    /*
     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */

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

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








|















|

|
|







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

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {
	/*
	 * You might expect the code here to be
	 *
	 *  bytes = Tcl_GetByteArrayFromObj(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.
	 */

	int lengthSrc;

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */

	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);

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
    if (stringPtr->hasUnicode) {
	/*
	 * 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);
	} 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);

    numChars = stringPtr->numChars;
    if ((numChars != TCL_INDEX_NONE) && TclHasIntRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *







|


















|







|







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
    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (TclHasIntRep(appendObjPtr, &tclStringType)) {
	    Tcl_UniChar *unicode =
		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, 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);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && TclHasIntRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
 *----------------------------------------------------------------------
 */

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. */
{
    String *stringPtr;
    size_t numChars;

    if (appendNumChars == TCL_INDEX_NONE) {
	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;


    if (numChars > stringPtr->maxChars) {
	size_t index = 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.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    index = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */







|


|

|


















>


<
>









|









|
|







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

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    int appendNumChars)		/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    int numChars;

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

	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset >= 0) {
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
 *----------------------------------------------------------------------
 */

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. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != TCL_INDEX_NONE) {
	stringPtr->numChars += numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *







|





|







1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    int numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
 *----------------------------------------------------------------------
 */

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. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }








|







1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    int numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;

    if (numBytes == 0) {
	return;
    }

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

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. */
{
    String *stringPtr;
    size_t newLength, oldLength;

    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;




    stringPtr = GET_STRING(objPtr);
    if (newLength > 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.
	 */








|


|















>
>
>



|







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

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    int numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    int newLength, oldLength;

    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) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

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

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset != TCL_INDEX_NONE) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = TCL_INDEX_NONE;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}






































/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendStringsToObj --
 *
 *	This function appends one or more null-terminated strings to an







|








|








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







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

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	 * Relocate bytes if needed; see above.
	 */

	if (offset >= 0) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, 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. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
    }

    while (1) {
	const char *bytes = va_arg(argList, char *);

	if (bytes == NULL) {
	    break;
	}
	Tcl_AppendToObj(objPtr, bytes, -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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
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");
    }

    while (1) {
	const char *bytes = va_arg(argList, char *);

	if (bytes == NULL) {
	    break;
	}
	Tcl_AppendToObj(objPtr, bytes, -1);
    }
    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendFormatToObj --







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







1737
1738
1739
1740
1741
1742
1743

1744










1745
1746
1747
1748
1749
1750
1751
Tcl_AppendStringsToObj(
    Tcl_Obj *objPtr,
    ...)
{
    va_list argList;

    va_start(argList, objPtr);

    Tcl_AppendStringsToObjVA(objPtr, argList);










    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendFormatToObj --
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
    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;
    Tcl_UniChar ch = 0;
    static const char *mixedXPG =
	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *const 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;

    /*
     * 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;
#ifndef TCL_WIDE_INT_IS_LONG
	int useWide = 0;
#endif
	int newXpg, numChars, allocSegment = 0, segmentLimit;
	size_t segmentNumBytes;
	Tcl_Obj *segment;
	int step = TclUtfToUniChar(format, &ch);

	format += step;
	if (ch != '%') {
	    numBytes += step;
	    continue;







|
|












|
|












|
<







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
    Tcl_Interp *interp,
    Tcl_Obj *appendObj,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *span = format, *msg, *errCode;
    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] = {
	"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");
    }
    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;
#ifndef TCL_WIDE_INT_IS_LONG
	int useWide = 0;
#endif
	int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;

	Tcl_Obj *segment;
	int step = TclUtfToUniChar(format, &ch);

	format += step;
	if (ch != '%') {
	    numBytes += step;
	    continue;
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (width > (int) limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.







|







1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	}
	if (width > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.
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
		    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;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    pure = Tcl_NewWideIntObj(s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    pure = Tcl_NewWideIntObj(w);
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
		    pure = Tcl_NewWideIntObj(l);
		}
		Tcl_IncrRefCount(pure);
		bytes = TclGetStringFromObj(pure, &length);

		/*
		 * Already did the sign above.
		 */







>
>
>
>
>
>
>
>





|




|


|




|







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
		    Tcl_AppendToObj(segment, "0x", 2);
		    segmentLimit -= 2;
		    break;
		case 'b':
		    Tcl_AppendToObj(segment, "0b", 2);
		    segmentLimit -= 2;
		    break;
#if TCL_MAJOR_VERSION < 9
		case 'd':
		    if (gotZero) {
			Tcl_AppendToObj(segment, "0d", 2);
			segmentLimit -= 2;
		    }
		    break;
#endif
		}
	    }

	    switch (ch) {
	    case 'd': {
		int length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    TclNewIntObj(pure, s);
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    TclNewIntObj(pure, w);
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
		    TclNewIntObj(pure, 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
		/*
		 * 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;
		    }
		    while (length < (size_t)precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    }
		    while (length < (size_t)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 'b': {
		Tcl_WideUInt bits = 0;
		Tcl_WideInt numDigits = 0;
		int numBits = 4, base = 16, index = 0, shift = 0;
		size_t length;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {
		    base = 8;







|


|







|


|




















|
|
|
<







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
		/*
		 * 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 < precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    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 'b': {
		Tcl_WideUInt bits = (Tcl_WideUInt) 0;
		Tcl_WideInt numDigits = (Tcl_WideInt) 0;
		int length, numBits = 4, base = 16, index = 0, shift = 0;

		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		} else if (ch == 'o') {
		    base = 8;
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
		 * Need to be sure zero becomes "0", not "".
		 */

		if (numDigits == 0) {
		    numDigits = 1;
		}
		TclNewObj(pure);
		Tcl_SetObjLength(pure, numDigits);
		bytes = TclGetString(pure);
		toAppend = length = numDigits;
		while (numDigits--) {
		    int digitOffset;

		    if (useBig && !mp_iszero(&big)) {
			if (index < big.used && (size_t) shift <
				CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
			    shift += MP_DIGIT_BIT;
			}
			shift -= numBits;
		    }
		    digitOffset = bits % base;
		    if (digitOffset > 9) {
			if (ch == 'X') {
			    bytes[numDigits] = 'A' + digitOffset - 10;
			} else {
			    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;
		    }
		    while (length < (size_t)precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    }
		    while (length < (size_t)width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";







|

|











|















|


|







|


|







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
		 * Need to be sure zero becomes "0", not "".
		 */

		if (numDigits == 0) {
		    numDigits = 1;
		}
		TclNewObj(pure);
		Tcl_SetObjLength(pure, (int) numDigits);
		bytes = TclGetString(pure);
		toAppend = length = (int) numDigits;
		while (numDigits--) {
		    int digitOffset;

		    if (useBig && !mp_iszero(&big)) {
			if (index < big.used && (size_t) shift <
				CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
			    shift += MP_DIGIT_BIT;
			}
			shift -= numBits;
		    }
		    digitOffset = (int) (bits % base);
		    if (digitOffset > 9) {
			if (ch == 'X') {
			    bytes[numDigits] = 'A' + digitOffset - 10;
			} else {
			    bytes[numDigits] = 'a' + digitOffset - 10;
			}
		    } else {
			bytes[numDigits] = '0' + digitOffset;
		    }
		    bits /= base;
		}
		if (useBig) {
		    mp_clear(&big);
		}
		if (gotPrecision) {
		    if (length < precision) {
			segmentLimit -= precision - length;
		    }
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *p = TclGetString(segment) + 1;
		*p = 'x';
		p = strchr(p, 'P');
		if (p) *p = 'p';
	    }
	    break;
	}
	default:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));







|
|
|
|







2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
	    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));
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	(void)TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;







|







2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
2435
2436
2437
2438
2439
2440
2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
Tcl_Format(
    Tcl_Interp *interp,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr = Tcl_NewObj();


    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
    if (result != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }
    return objPtr;
}







|

>







2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
Tcl_Format(
    Tcl_Interp *interp,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
    if (result != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }
    return objPtr;
}
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473

2474
2475
2476
2477
2478
2479
2480
static void
AppendPrintfToObjVA(
    Tcl_Obj *objPtr,
    const char *format,
    va_list argList)
{
    int code, objc;
    Tcl_Obj **objv, *list = Tcl_NewObj();
    const char *p;


    p = format;
    Tcl_IncrRefCount(list);
    while (*p != '\0') {
	int size = 0, seekingConversion = 1, gotPrecision = 0;
	int lastNum = -1;

	if (*p++ != '%') {







|


>







2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
static void
AppendPrintfToObjVA(
    Tcl_Obj *objPtr,
    const char *format,
    va_list argList)
{
    int code, objc;
    Tcl_Obj **objv, *list;
    const char *p;

    TclNewObj(list);
    p = format;
    Tcl_IncrRefCount(list);
    while (*p != '\0') {
	int size = 0, seekingConversion = 1, gotPrecision = 0;
	int lastNum = -1;

	if (*p++ != '%') {
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
		/*
		 * 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))) {
		    end = q;
		}

		q = bytes + 4;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));

		break;
	    }
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':







|










|







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
		/*
		 * 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, (int)(end - q))) {
		    end = q;
		}

		q = bytes + 4;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (int)(end - bytes)));

		break;
	    }
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
		char *end;

		lastNum = strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;







|







|







2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = (int) va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
		char *end;

		lastNum = (int) strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
	} 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));
    }
    Tcl_DecrRefCount(list);
}

/*
 *---------------------------------------------------------------------------
 *







|







2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
	} 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, Tcl_GetString(list));
    }
    Tcl_DecrRefCount(list);
}

/*
 *---------------------------------------------------------------------------
 *
2680
2681
2682
2683
2684
2685
2686
2687
2688

2689
2690
2691
2692
2693
2694
2695

Tcl_Obj *
Tcl_ObjPrintf(
    const char *format,
    ...)
{
    va_list argList;
    Tcl_Obj *objPtr = Tcl_NewObj();


    va_start(argList, format);
    AppendPrintfToObjVA(objPtr, format, argList);
    va_end(argList);
    return objPtr;
}

/*







|

>







2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802

Tcl_Obj *
Tcl_ObjPrintf(
    const char *format,
    ...)
{
    va_list argList;
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    va_start(argList, format);
    AppendPrintfToObjVA(objPtr, format, argList);
    va_end(argList);
    return objPtr;
}

/*
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
 *
 *---------------------------------------------------------------------------
 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    size_t *sizePtr)
{
    String *stringPtr;

    if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}








|




|







2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
 *
 *---------------------------------------------------------------------------
 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    unsigned int *sizePtr)
{
    String *stringPtr;

    if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}

2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
 *---------------------------------------------------------------------------
 */

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.







|




|







2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    int 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.
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
		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;
    }








|


|


|







2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	Tcl_GetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	Tcl_GetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	Tcl_GetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }

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
	    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;
}

/*
 *---------------------------------------------------------------------------







|







|







|










|







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
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
		(count - done) * length);
    } else {
	/*
	 * Efficiently concatenate string reps.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(Tcl_GetString(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 %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, Tcl_GetString(objResultPtr),
		(count - done) * length);
    }
    return objResultPtr;
}

/*
 *---------------------------------------------------------------------------
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
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 ) */








|
<







2999
3000
3001
3002
3003
3004
3005
3006

3007
3008
3009
3010
3011
3012
3013
TclStringCat(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, length = 0, binary = 1;

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

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







|












|





>
>
















|

|




>
>







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
    } while (--oc && (binary || allowUniChar));

    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

	int numBytes;
	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)) {
		Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numBytes > INT_MAX - length) {
			goto overflow;
		    }
		    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)) {
		int numChars;

		Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numChars > INT_MAX - length) {
			goto overflow;
		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
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

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







|













|











|






|





|







|




|
<


|







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

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    Tcl_GetStringFromObj(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)) {
		int 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++;
		    Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    Tcl_GetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes > INT_MAX - length) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    int numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */

	    if (numBytes) {
		last = objc - oc;
		if (numBytes > INT_MAX - length) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }
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

	/*
	 * 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)));







|


|















|
|









|




|







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

	/*
	 * 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)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(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)) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(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)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(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)));
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
	    }
	    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';







|
|









|



|



|





|









|





|





|
|







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
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(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 %u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
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

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







|


|
<

















|
|











|
|
|







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

int
TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    int reqlength)		/* requested length */
{
    char *s1, *s2;
    int empty, length, match, s1len, s2len;

    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 *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(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 *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
			    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)) {







|







3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
			    checkEq
#endif
			    ) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t)(void *)Tcl_UniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {
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
		 * 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







|
|



|






>
>
|






<
<







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
		 * 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 < 0) && !nocase) {
		    memCmpFn = (memCmpFn_t)(void *)TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)(void *)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	length = (s1len < s2len) ? s1len : s2len;
	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;


	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
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
 *---------------------------------------------------------------------------
 */

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 *check, *end, *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;







|

|
>
|
|
<

|











|


|







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

Tcl_Obj *
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = Tcl_GetCharLength(needle);
    Tcl_Obj *result;
    int value = -1;
    Tcl_UniChar *checkStr, *endStr, *uh, *un;


    if (start < 0) {
	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 = Tcl_GetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = Tcl_GetByteArrayFromObj(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;
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
     * 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;
    }
    end = uh + lh;

    for (check = uh + start; check + ln <= end; check++) {
	if ((*check == *un) && (0 ==
		memcmp(check + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
	    value =  (check - uh);
	    goto firstEnd;
	}
    }
  firstEnd:
    TclNewIndexObj(obj, value);
    return obj;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *







|
|




|

|
|
|
|




|
|







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
     * 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 = Tcl_GetUnicodeFromObj(needle, &ln);
    uh = Tcl_GetUnicodeFromObj(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:
    TclNewIntObj(result, value);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *
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
 *---------------------------------------------------------------------------
 */

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 *check, *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;
    }
    check = uh + last + 1 - ln;
    while (check >= uh) {
	if ((*check == un[0])
		&& (0 == memcmp(check+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
	    value = (check - uh);
	    goto lastEnd;
	}
	check--;
    }
  lastEnd:
    TclNewIndexObj(obj, value);
    return obj;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReverse --
 *







|

|
>
|
|
<












|
|

|



















|
|

|






|
|
|
|
|


|


|
|







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

Tcl_Obj *
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int last)
{
    int lh, ln = Tcl_GetCharLength(needle);
    Tcl_Obj *result;
    int value = -1;
    Tcl_UniChar *checkStr, *uh, *un;


    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 = Tcl_GetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	if (last >= lh) {
	    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 = Tcl_GetUnicodeFromObj(haystack, &lh);
    un = Tcl_GetUnicodeFromObj(needle, &ln);

    if (last >= lh) {
	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:
    TclNewIntObj(result, value);
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReverse --
 *
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
 *---------------------------------------------------------------------------
 */

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







|







3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    int count)			/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
	unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }







|
|







3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }
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
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    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;

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







|
|








|









|
|








|







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
		*src = *from;
		*from++ = ch;
	    }
	}
    }

    if (objPtr->bytes) {
	int numChars = stringPtr->numChars;
	int numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    TclNewObj(objPtr);
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	if (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.
	     */

	    int charCount = 0;
	    int 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.
		 */

		int bytesInChar = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
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
 *---------------------------------------------------------------------------
 */

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;





    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

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

    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;







|
|





>
>
>
>


















|
|







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

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    int first,			/* First index to replace */
    int 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;

    /* Caller is expected to pass sensible arguments */
    assert ( count >= 0 ) ;
    assert ( first >= 0 ) ;

    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

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

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;
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

	/* 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;
	    }

	    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;







|

|












|







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

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    int newBytes;
	    unsigned char *iBytes
		    = Tcl_GetByteArrayFromObj(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;
	    }

	    if (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;
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
     * 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.
     */

    /* 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;
    }
}








|
|







|
|







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

    /* The traditional implementation... */
    {
	int numChars;
	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(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 < numChars) {
	    Tcl_AppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}

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
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    size_t numBytes,
    size_t numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    size_t needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == TCL_INDEX_NONE) {
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;


    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
	stringPtr = GET_STRING(objPtr);
    }

    stringPtr->hasUnicode = 1;







|
|


|





|



>







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
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    int numBytes,
    int numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);
    int needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == -1) {
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;
    stringCheckLimits(needed);

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
	stringPtr = GET_STRING(objPtr);
    }

    stringPtr->hasUnicode = 1;
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
				 * an internal rep of type "String". */
    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.
	 */

	return;







|







4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
				 * an internal rep of type "String". */
    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 == -1) {
	/*
	 * 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.
	 */

	return;
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
	TclInitStringRep(objPtr, NULL, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    size_t numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

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








|



|





|



|







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
	TclInitStringRep(objPtr, NULL, 0);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static int
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    int numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }

4172
4173
4174
4175
4176
4177
4178
4179
4180
4181



4182
4183
4184
4185
4186
4187
4188
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars; i++) {
	size += TclUtfCount(unicode[i]);
    }




    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);







|


>
>
>







4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }

    for (i = 0; i < numChars && size >= 0; i++) {
	size += TclUtfCount(unicode[i]);
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    /*
     * Grow space if needed.
     */

    if (size > stringPtr->allocated) {
	GrowStringBuffer(objPtr, size, 1);
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
 *----------------------------------------------------------------------
 */

static void
FreeStringInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_STRING(objPtr));
    objPtr->typePtr = NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
 *----------------------------------------------------------------------
 */

static void
FreeStringInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ckfree(GET_STRING(objPtr));
    objPtr->typePtr = NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclStringRep.h.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70


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) 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:
 */







<
<
<
<
















|
|



|


|








>
>


>
>
>
>
>
>
>

|

|

|

|






<







27
28
29
30
31
32
33




34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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) 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.
 */





/*
 * 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 {
    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. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int 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_MAXCHARS \
    (int)(((size_t)UINT_MAX - 1 - offsetof(String, unicode))/sizeof(Tcl_UniChar))
#define STRING_SIZE(numChars) \
    (offsetof(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
#define stringCheckLimits(numChars) \
    do {								\
	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		      (int)STRING_MAXCHARS);					\
	}								\
    } while (0)
#define stringAttemptAlloc(numChars) \
    (String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((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))


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclStubInit.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
#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


#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





#endif

#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
#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
#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
#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
#define TclBN_mp_sqrt mp_sqrt
#define TclBN_mp_sub mp_sub



#define TclBN_mp_sub_d mp_sub_d
#define TclBN_mp_signed_rsh mp_signed_rsh
#define TclBN_mp_to_radix mp_to_radix
#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


















































































































































































































































#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
#   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)
{
    /* dummy implementation, no need to do anything */
}

#   define TclWinAddProcess (void (*) (void *, size_t)) doNothing
#   define TclWinFlushDirtyChannels doNothing


























#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
{
    char *p;








>


>
>
>
>



















>
>




>

|
|



|
|
|
>
>
>
>
>



<





<





<



<





<







<














>
>
>
|
|

















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



















>





>
|

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







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

94
95
96
97
98

99
100
101
102
103

104
105
106

107
108
109
110
111

112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
#undef Tcl_GetUnicode
#undef Tcl_GetUnicodeFromObj
#undef Tcl_AppendUnicodeToObj
#undef Tcl_NewUnicodeObj
#undef Tcl_SetUnicodeObj
#undef Tcl_UniCharNcasecmp
#undef Tcl_UniCharCaseMatch
#undef Tcl_UniCharLen
#undef Tcl_UniCharNcmp
#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
#undef TclGuessPackageName
#undef TclGetLoadedPackages
#define TclStaticPackage Tcl_StaticPackage
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_MacOSXOpenBundleResources

#if TCL_UTF_MAX > 3
static void uniCodePanic(void) {
    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 (int *(*)(Tcl_Obj *, Tcl_UniChar *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const int *, Tcl_UniChar))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, int))(void *)uniCodePanic
#   define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
#   define Tcl_UniCharCaseMatch (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, int))(void *)uniCodePanic
#   define Tcl_UniCharLen (int(*)(const Tcl_UniChar *))(void *)uniCodePanic
#   define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
#endif

#define TclBN_mp_add mp_add

#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
#define TclBN_mp_cmp mp_cmp

#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_2 mp_div_2
#define TclBN_mp_div_2d mp_div_2d
#define TclBN_mp_exch mp_exch

#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_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_2 mp_mul_2
#define TclBN_mp_mul_2d mp_mul_2d
#define TclBN_mp_neg mp_neg
#define TclBN_mp_or mp_or
#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
#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
#define TclBN_mp_sqrt mp_sqrt
#define TclBN_mp_sub mp_sub
#define TclBN_mp_signed_rsh mp_signed_rsh
#define TclBN_mp_tc_and TclBN_mp_and
#define TclBN_mp_tc_div_2d mp_signed_rsh
#define TclBN_mp_tc_or TclBN_mp_or
#define TclBN_mp_tc_xor TclBN_mp_xor
#define TclBN_mp_to_radix mp_to_radix
#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
#define TclUnusedStubEntry NULL

/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
#   define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
static int TclSockMinimumBuffersOld(int sock, int size)
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif

mp_err TclBN_mp_set_int(mp_int *a, unsigned long i)
{
    TclBN_mp_set_u64(a, i);
    return MP_OKAY;
}

static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i)
{
    TclBN_mp_set_u64(a, i);
    return MP_OKAY;
}

#define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long

mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) {
	return mp_expt_u32(a, b, c);
}
mp_err	TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) {
   return mp_add_d(a, b, c);
}
mp_err	TclBN_mp_cmp_d(const mp_int *a, unsigned int b) {
   return mp_cmp_d(a, b);
}
mp_err	TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c) {
   return mp_sub_d(a, b, c);
}
mp_err	TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *c, unsigned int *d) {
   mp_digit d2;
   mp_err result = mp_div_d(a, b, c, (d ? &d2 : NULL));
   if (d) {
      *d = d2;
   }
   return result;
}
mp_err	TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *c, uint64_t *d) {
   mp_err result;
   mp_digit d2;

   if ((b | (mp_digit)-1) != (mp_digit)-1) {
      return MP_VAL;
   }
   result = mp_div_d(a, b, c, (d ? &d2 : NULL));
   if (d) {
      *d = d2;
   }
   return result;
}
mp_err TclBN_mp_init_set(mp_int *a, unsigned int b) {
	return mp_init_set(a, b);
}
mp_err	TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) {
	return mp_mul_d(a, b, c);
}

#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
#   define TclBN_mp_expt_d_ex 0
#   define TclBN_mp_to_unsigned_bin 0
#   define TclBN_mp_to_unsigned_bin_n 0
#   define TclBN_mp_toradix_n 0
#   undef TclBN_mp_sqr
#   define TclBN_mp_sqr 0
#   undef TclBN_mp_div_3
#   define TclBN_mp_div_3 0
#   define TclBN_mp_init_l 0
#   define TclBN_mp_init_ul 0
#   define TclBN_mp_set 0
#   define TclSetStartupScriptPath 0
#   define TclGetStartupScriptPath 0
#   define TclSetStartupScriptFileName 0
#   define TclGetStartupScriptFileName 0
#   define TclPrecTraceProc 0
#   define TclpInetNtoa 0
#   define TclWinGetServByName 0
#   define TclWinGetSockOpt 0
#   define TclWinSetSockOpt 0
#   define TclWinNToHS 0
#   define TclWinGetPlatformId 0
#   define TclWinResetInterfaces 0
#   define TclWinSetInterfaces 0
#   define TclWinGetPlatformId 0
#   define Tcl_Backslash 0
#   define Tcl_GetDefaultEncodingDir 0
#   define Tcl_SetDefaultEncodingDir 0
#   define Tcl_EvalTokens 0
#   define Tcl_CreateMathFunc 0
#   define Tcl_GetMathFuncInfo 0
#   define Tcl_ListMathFuncs 0
#   define Tcl_SetIntObj 0
#   define Tcl_SetLongObj 0
#   define Tcl_NewIntObj 0
#   define Tcl_NewLongObj 0
#   define Tcl_DbNewLongObj 0
#   define Tcl_BackgroundError 0
#   define Tcl_FreeResult 0
#   define Tcl_ChannelSeekProc 0
#   define Tcl_ChannelCloseProc 0
#   define Tcl_Close 0
#   define Tcl_MacOSXOpenBundleResources 0
#   define TclGuessPackageName 0
#   define TclGetLoadedPackages 0
#else

#define TclGuessPackageName guessPackageName
static int TclGuessPackageName(
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_DString *)) {
    return 0;
}
#define TclGetLoadedPackages getLoadedPackages
static int TclGetLoadedPackages(
    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. */
{
    return TclGetLoadedPackagesEx(interp, targetName, NULL);
}

mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
    mp_digit d2;
    mp_err result = mp_div_d(a, 3, c, &d2);
    if (d) {
	*d = d2;
    }
    return result;
}

int TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c,
    TCL_UNUSED(int) /*fast*/)
{
    return TclBN_mp_expt_u32(a, b, c);
}

mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
{
    return TclBN_mp_to_ubin(a, b, INT_MAX, NULL);
}

mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen)
{
    size_t n = TclBN_mp_ubin_size(a);
    if (*outlen < (unsigned long)n) {
	return MP_VAL;
    }
    *outlen = (unsigned long)n;
    return TclBN_mp_to_ubin(a, b, n, NULL);
}

void TclBN_reverse(unsigned char *s, int len)
{
    if (len > 0) {
	TclBN_s_mp_reverse(s, (size_t)len);
    }
}

mp_err TclBN_mp_init_ul(mp_int *a, unsigned long b)
{
    return TclBN_mp_init_u64(a,b);
}

mp_err TclBN_mp_init_l(mp_int *a, long b)
{
    return TclBN_mp_init_i64(a,b);
}

void TclBN_mp_set(mp_int *a, unsigned int b) {
    TclBN_mp_set_u64(a, b);
}

mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
{
    if (maxlen < 0) {
	return MP_VAL;
    }
    return TclBN_mp_to_radix(a, str, maxlen, NULL, radix);
}

#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath
static Tcl_Obj *TclGetStartupScriptPath(void)
{
    return Tcl_GetStartupScript(NULL);
}
#define TclSetStartupScriptFileName setStartupScriptFileName
static void TclSetStartupScriptFileName(
    const char *fileName)
{
    Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
}
#define TclGetStartupScriptFileName getStartupScriptFileName
static const char *TclGetStartupScriptFileName(void)
{
    Tcl_Obj *path = Tcl_GetStartupScript(NULL);
    if (path == NULL) {
	return NULL;
    }
    return Tcl_GetString(path);
}
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
#undef TclWinGetPlatformId
#undef TclWinResetInterfaces
#undef TclWinSetInterfaces
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
	return ntohs(ns);
}
#define TclWinGetPlatformId winGetPlatformId
static int
TclWinGetPlatformId(void)
{
    return 2; /* VER_PLATFORM_WIN32_NT */;
}
#define TclWinResetInterfaces doNothing
#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
#endif /* TCL_NO_DEPRECATED */

#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
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpReaddir 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty isatty
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}
#endif
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#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);
}
#endif /* TCL_NO_DEPRECATED */

#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
{
    char *p;

187
188
189
190
191
192
193
194
195
196
197
198























199
200
201
202
203
204
205
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const wchar_t *)&TclWinNoBackslash, &hInstance);
    return hInstance;
}

size_t
TclpGetPid(Tcl_Pid pid)
{
    return (size_t)pid;
}
























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







|


|

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







465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const wchar_t *)&TclWinNoBackslash, &hInstance);
    return hInstance;
}

int
TclpGetPid(Tcl_Pid pid)
{
    return (int)(size_t)pid;
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#undef Tcl_WinUtfToTChar
char *
Tcl_WinUtfToTChar(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    Tcl_DStringInit(dsPtr);
    return (char *)Tcl_UtfToChar16DString(string, len, dsPtr);
}
#undef Tcl_WinTCharToUtf
char *
Tcl_WinTCharToUtf(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    Tcl_DStringInit(dsPtr);
    return Tcl_Char16ToUtfDString((const unsigned short *)string, len >> 1, dsPtr);
}
#endif /* !defined(TCL_NO_DEPRECATED) */

#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.
 */
231
232
233
234
235
236
237










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




































































































































































250
251
252
253
254
255
256
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj










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

#endif /* __CYGWIN__ */





































































































































































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








>
>
>
>
>
>
>
>
>
>












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







532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
		    "integer value too large to represent as non-long integer", -1));
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
#if TCL_UTF_MAX < 4 && !defined(TCL_NO_DEPRECATED)
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))(void *)uniCharNcmp
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))(void *)uniCharNcasecmp
#endif
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
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 */

#endif /* __CYGWIN__ */

#if defined(TCL_NO_DEPRECATED)
#   define Tcl_SeekOld 0
#   define Tcl_TellOld 0
#   undef Tcl_SetBooleanObj
#   define Tcl_SetBooleanObj 0
#   undef Tcl_PkgPresent
#   define Tcl_PkgPresent 0
#   undef Tcl_PkgProvide
#   define Tcl_PkgProvide 0
#   undef Tcl_PkgRequire
#   define Tcl_PkgRequire 0
#   undef Tcl_GetIndexFromObj
#   define Tcl_GetIndexFromObj 0
#   define Tcl_NewBooleanObj 0
#   undef Tcl_DbNewBooleanObj
#   define Tcl_DbNewBooleanObj 0
#   undef Tcl_SetBooleanObj
#   define Tcl_SetBooleanObj 0
#   undef Tcl_SetVar
#   define Tcl_SetVar 0
#   undef Tcl_UnsetVar
#   define Tcl_UnsetVar 0
#   undef Tcl_GetVar
#   define Tcl_GetVar 0
#   undef Tcl_TraceVar
#   define Tcl_TraceVar 0
#   undef Tcl_UntraceVar
#   define Tcl_UntraceVar 0
#   undef Tcl_VarTraceInfo
#   define Tcl_VarTraceInfo 0
#   undef Tcl_UpVar
#   define Tcl_UpVar 0
#   undef Tcl_AddErrorInfo
#   define Tcl_AddErrorInfo 0
#   undef Tcl_AddObjErrorInfo
#   define Tcl_AddObjErrorInfo 0
#   undef Tcl_Eval
#   define Tcl_Eval 0
#   undef Tcl_GlobalEval
#   define Tcl_GlobalEval 0
#   undef Tcl_GetStringResult
#   define Tcl_GetStringResult 0
#   undef Tcl_SaveResult
#   define Tcl_SaveResult 0
#   undef Tcl_RestoreResult
#   define Tcl_RestoreResult 0
#   undef Tcl_DiscardResult
#   define Tcl_DiscardResult 0
#   undef Tcl_SetResult
#   define Tcl_SetResult 0
#   undef Tcl_EvalObj
#   define Tcl_EvalObj 0
#   undef Tcl_GlobalEvalObj
#   define Tcl_GlobalEvalObj 0
#   define TclBackgroundException 0
#   undef TclpReaddir
#   define TclpReaddir 0
#   define TclSetStartupScript 0
#   define TclGetStartupScript 0
#   define TclGetIntForIndex 0
#   define TclCreateNamespace 0
#   define TclDeleteNamespace 0
#   define TclAppendExportList 0
#   define TclExport 0
#   define TclImport 0
#   define TclForgetImport 0
#   define TclGetCurrentNamespace_ 0
#   define TclGetGlobalNamespace_ 0
#   define TclFindNamespace 0
#   define TclFindCommand 0
#   define TclGetCommandFromObj 0
#   define TclGetCommandFullName 0
#   define TclCopyChannelOld 0
#   define Tcl_AppendResultVA 0
#   define Tcl_AppendStringsToObjVA 0
#   define Tcl_SetErrorCodeVA 0
#   define Tcl_PanicVA 0
#   define Tcl_VarEvalVA 0
#   undef TclpGetDate
#   define TclpGetDate 0
#   undef TclpLocaltime
#   define TclpLocaltime 0
#   undef TclpGmtime
#   define TclpGmtime 0
#   define TclpLocaltime_unix 0
#   define TclpGmtime_unix 0
#   define Tcl_SetExitProc 0
#   define Tcl_SetPanicProc 0
#   define Tcl_FindExecutable 0
#   define Tcl_GetUnicode 0
#if TCL_UTF_MAX < 4
#   define Tcl_AppendUnicodeToObj 0
#   define Tcl_UniCharCaseMatch 0
#   define Tcl_UniCharLen 0
#   define Tcl_UniCharNcasecmp 0
#   define Tcl_UniCharNcmp 0
#endif
#   undef Tcl_StringMatch
#   define Tcl_StringMatch 0
#   define TclBN_reverse 0
#   undef TclBN_s_mp_mul_digs_fast
#   define TclBN_s_mp_mul_digs_fast 0
#   undef TclBN_s_mp_sqr_fast
#   define TclBN_s_mp_sqr_fast 0
#   undef TclBN_mp_karatsuba_mul
#   define TclBN_mp_karatsuba_mul 0
#   undef TclBN_mp_karatsuba_sqr
#   define TclBN_mp_karatsuba_sqr 0
#   undef TclBN_mp_toom_mul
#   define TclBN_mp_toom_mul 0
#   undef TclBN_mp_toom_sqr
#   define TclBN_mp_toom_sqr 0
#   undef TclBN_s_mp_add
#   define TclBN_s_mp_add 0
#   undef TclBN_s_mp_mul_digs
#   define TclBN_s_mp_mul_digs 0
#   undef TclBN_s_mp_sqr
#   define TclBN_s_mp_sqr 0
#   undef TclBN_s_mp_sub
#   define TclBN_s_mp_sub 0
#else /* TCL_NO_DEPRECATED */
#   define Tcl_SeekOld seekOld
#   define Tcl_TellOld tellOld
#   define TclBackgroundException Tcl_BackgroundException
#   define TclSetStartupScript Tcl_SetStartupScript
#   define TclGetStartupScript Tcl_GetStartupScript
#   define TclGetIntForIndex Tcl_GetIntForIndex
#   define TclCreateNamespace Tcl_CreateNamespace
#   define TclDeleteNamespace Tcl_DeleteNamespace
#   define TclAppendExportList Tcl_AppendExportList
#   define TclExport Tcl_Export
#   define TclImport Tcl_Import
#   define TclForgetImport Tcl_ForgetImport
#   define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
#   define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
#   define TclFindNamespace Tcl_FindNamespace
#   define TclFindCommand Tcl_FindCommand
#   define TclGetCommandFromObj Tcl_GetCommandFromObj
#   define TclGetCommandFullName Tcl_GetCommandFullName
#   define TclpLocaltime_unix TclpLocaltime
#   define TclpGmtime_unix TclpGmtime

static int
seekOld(
    Tcl_Channel chan,		/* The channel on which to seek. */
    int offset,			/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{
    return Tcl_Seek(chan, offset, mode);
}

static int
tellOld(
    Tcl_Channel chan)		/* The channel to return pos for. */
{
    return Tcl_Tell(chan);
}
#endif /* !TCL_NO_DEPRECATED */

#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
#define Tcl_WinUtfToTChar 0
#define Tcl_WinTCharToUtf 0
#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.
 */

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
    0, /* 1 */
    0, /* 2 */
    TclAllocateFreeObjects, /* 3 */
    0, /* 4 */
    TclCleanupChildren, /* 5 */
    TclCleanupCommand, /* 6 */
    TclCopyAndCollapse, /* 7 */
    0, /* 8 */
    TclCreatePipeline, /* 9 */
    TclCreateProc, /* 10 */
    TclDeleteCompiledLocalVars, /* 11 */
    TclDeleteVars, /* 12 */
    0, /* 13 */
    TclDumpMemoryInfo, /* 14 */
    0, /* 15 */







|







750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
    0, /* 1 */
    0, /* 2 */
    TclAllocateFreeObjects, /* 3 */
    0, /* 4 */
    TclCleanupChildren, /* 5 */
    TclCleanupCommand, /* 6 */
    TclCopyAndCollapse, /* 7 */
    TclCopyChannelOld, /* 8 */
    TclCreatePipeline, /* 9 */
    TclCreateProc, /* 10 */
    TclDeleteCompiledLocalVars, /* 11 */
    TclDeleteVars, /* 12 */
    0, /* 13 */
    TclDumpMemoryInfo, /* 14 */
    0, /* 15 */
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
    0, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    0, /* 29 */
    0, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    0, /* 34 */
    0, /* 35 */
    0, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    0, /* 43 */
    TclGuessPackageName, /* 44 */
    TclHideUnsafeCommands, /* 45 */
    TclInExit, /* 46 */
    0, /* 47 */
    0, /* 48 */
    0, /* 49 */
    0, /* 50 */
    TclInterpInit, /* 51 */
    0, /* 52 */
    TclInvokeObjectCommand, /* 53 */
    TclInvokeStringCommand, /* 54 */
    TclIsProc, /* 55 */
    0, /* 56 */
    0, /* 57 */







|















|







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
    0, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    0, /* 29 */
    0, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    TclGetIntForIndex, /* 34 */
    0, /* 35 */
    0, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    0, /* 43 */
    TclGuessPackageName, /* 44 */
    TclHideUnsafeCommands, /* 45 */
    TclInExit, /* 46 */
    0, /* 47 */
    0, /* 48 */
    0, /* 49 */
    TclInitCompiledLocals, /* 50 */
    TclInterpInit, /* 51 */
    0, /* 52 */
    TclInvokeObjectCommand, /* 53 */
    TclInvokeStringCommand, /* 54 */
    TclIsProc, /* 55 */
    0, /* 56 */
    0, /* 57 */
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
    0, /* 70 */
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    0, /* 77 */
    0, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */
    0, /* 86 */
    0, /* 87 */
    0, /* 88 */
    TclPreventAliasLoop, /* 89 */
    0, /* 90 */
    TclProcCleanupProc, /* 91 */
    TclProcCompileProc, /* 92 */
    TclProcDeleteProc, /* 93 */
    0, /* 94 */
    0, /* 95 */
    TclRenameCommand, /* 96 */
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    0, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    TclSockMinimumBuffers, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    0, /* 112 */
    0, /* 113 */
    0, /* 114 */
    0, /* 115 */
    0, /* 116 */
    0, /* 117 */
    Tcl_GetInterpResolvers, /* 118 */
    Tcl_GetNamespaceResolvers, /* 119 */
    Tcl_FindNamespaceVar, /* 120 */
    0, /* 121 */
    0, /* 122 */
    0, /* 123 */
    0, /* 124 */
    0, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    0, /* 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 */
    TclGetEnv, /* 138 */
    0, /* 139 */
    0, /* 140 */







|










|















|







|
|
|
|
|
|



|
|
|
|
|

|





|







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
    0, /* 70 */
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    TclpGetTime, /* 77 */
    0, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */
    0, /* 86 */
    0, /* 87 */
    TclPrecTraceProc, /* 88 */
    TclPreventAliasLoop, /* 89 */
    0, /* 90 */
    TclProcCleanupProc, /* 91 */
    TclProcCompileProc, /* 92 */
    TclProcDeleteProc, /* 93 */
    0, /* 94 */
    0, /* 95 */
    TclRenameCommand, /* 96 */
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    TclSockMinimumBuffersOld, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    TclSockMinimumBuffers, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    TclAppendExportList, /* 112 */
    TclCreateNamespace, /* 113 */
    TclDeleteNamespace, /* 114 */
    TclExport, /* 115 */
    TclFindCommand, /* 116 */
    TclFindNamespace, /* 117 */
    Tcl_GetInterpResolvers, /* 118 */
    Tcl_GetNamespaceResolvers, /* 119 */
    Tcl_FindNamespaceVar, /* 120 */
    TclForgetImport, /* 121 */
    TclGetCommandFromObj, /* 122 */
    TclGetCommandFullName, /* 123 */
    TclGetCurrentNamespace_, /* 124 */
    TclGetGlobalNamespace_, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    TclImport, /* 127 */
    Tcl_PopCallFrame, /* 128 */
    Tcl_PushCallFrame, /* 129 */
    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    TclpHasSockets, /* 132 */
    TclpGetDate, /* 133 */
    0, /* 134 */
    0, /* 135 */
    0, /* 136 */
    0, /* 137 */
    TclGetEnv, /* 138 */
    0, /* 139 */
    0, /* 140 */
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    TclRegExpRangeUniChar, /* 151 */
    TclSetLibraryPath, /* 152 */
    TclGetLibraryPath, /* 153 */
    0, /* 154 */
    0, /* 155 */
    TclRegError, /* 156 */
    TclVarTraceExists, /* 157 */
    0, /* 158 */
    0, /* 159 */
    0, /* 160 */
    TclChannelTransform, /* 161 */
    TclChannelEventScriptInvoker, /* 162 */
    TclGetInstructionTable, /* 163 */
    TclExpandCodeArray, /* 164 */
    TclpSetInitialEncodings, /* 165 */
    TclListObjSetElement, /* 166 */
    0, /* 167 */
    0, /* 168 */
    TclpUtfNcmp2, /* 169 */
    TclCheckInterpTraces, /* 170 */
    TclCheckExecutionTraces, /* 171 */
    TclInThreadExit, /* 172 */
    TclUniCharMatch, /* 173 */
    0, /* 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 */







|
|







|
|









|
|


|
|







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
    TclRegExpRangeUniChar, /* 151 */
    TclSetLibraryPath, /* 152 */
    TclGetLibraryPath, /* 153 */
    0, /* 154 */
    0, /* 155 */
    TclRegError, /* 156 */
    TclVarTraceExists, /* 157 */
    TclSetStartupScriptFileName, /* 158 */
    TclGetStartupScriptFileName, /* 159 */
    0, /* 160 */
    TclChannelTransform, /* 161 */
    TclChannelEventScriptInvoker, /* 162 */
    TclGetInstructionTable, /* 163 */
    TclExpandCodeArray, /* 164 */
    TclpSetInitialEncodings, /* 165 */
    TclListObjSetElement, /* 166 */
    TclSetStartupScriptPath, /* 167 */
    TclGetStartupScriptPath, /* 168 */
    TclpUtfNcmp2, /* 169 */
    TclCheckInterpTraces, /* 170 */
    TclCheckExecutionTraces, /* 171 */
    TclInThreadExit, /* 172 */
    TclUniCharMatch, /* 173 */
    0, /* 174 */
    TclCallVarTraces, /* 175 */
    TclCleanupVar, /* 176 */
    TclVarErrMsg, /* 177 */
    TclSetStartupScript, /* 178 */
    TclGetStartupScript, /* 179 */
    0, /* 180 */
    0, /* 181 */
    TclpLocaltime, /* 182 */
    TclpGmtime, /* 183 */
    0, /* 184 */
    0, /* 185 */
    0, /* 186 */
    0, /* 187 */
    0, /* 188 */
    0, /* 189 */
    0, /* 190 */
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
    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 */
    TclDbDumpActiveObjects, /* 243 */







|







978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */
    TclVarHashCreateVar, /* 234 */
    TclInitVarHashTable, /* 235 */
    TclBackgroundException, /* 236 */
    TclResetCancellation, /* 237 */
    TclNRInterpProc, /* 238 */
    TclNRInterpProcCore, /* 239 */
    TclNRRunCallbacks, /* 240 */
    TclNREvalObjEx, /* 241 */
    TclNREvalObjv, /* 242 */
    TclDbDumpActiveObjects, /* 243 */
526
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticPackage, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclAppendUnicodeToObj, /* 259 */
    TclGetBytesFromObj, /* 260 */

};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 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 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TclWinConvertError, /* 0 */
    0, /* 1 */
    0, /* 2 */
    0, /* 3 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    0, /* 6 */
    0, /* 7 */
    TclpGetPid, /* 8 */
    0, /* 9 */
    0, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    0, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    0, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */







<
|
>
















|
|
|
|




















|
|
|


|
|

|
|










|




|

|














|
|
|
|







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
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticPackage, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */

    TclGetBytesFromObj, /* 259 */
    TclUnusedStubEntry, /* 260 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    0, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclWinGetServByName, /* 2 */
    TclWinGetSockOpt, /* 3 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    TclWinNToHS, /* 6 */
    TclWinSetSockOpt, /* 7 */
    TclpGetPid, /* 8 */
    TclWinGetPlatformId, /* 9 */
    TclpReaddir, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    TclpInetNtoa, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    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 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
637
638
639
640
641
642
643




644
645
646
647
648
649
650
651
652
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,




#ifdef MAC_OSX_TCL /* MACOSX */
    0, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
#endif /* MACOSX */
};

const TclTomMathStubs tclTomMathStubs = {
    TCL_STUB_MAGIC,
    0,







>
>
>
>

|







1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    Tcl_WinUtfToTChar, /* 0 */
    Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
#endif /* MACOSX */
};

const TclTomMathStubs tclTomMathStubs = {
    TCL_STUB_MAGIC,
    0,
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
    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_exch, /* 18 */
    TclBN_mp_expt_u32, /* 19 */
    TclBN_mp_grow, /* 20 */
    TclBN_mp_init, /* 21 */
    TclBN_mp_init_copy, /* 22 */
    TclBN_mp_init_multi, /* 23 */
    TclBN_mp_init_set, /* 24 */







|







1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
    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 */
    TclBN_mp_div_3, /* 17 */
    TclBN_mp_exch, /* 18 */
    TclBN_mp_expt_u32, /* 19 */
    TclBN_mp_grow, /* 20 */
    TclBN_mp_init, /* 21 */
    TclBN_mp_init_copy, /* 22 */
    TclBN_mp_init_multi, /* 23 */
    TclBN_mp_init_set, /* 24 */
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
    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_sqrt, /* 41 */
    TclBN_mp_sub, /* 42 */
    TclBN_mp_sub_d, /* 43 */
    0, /* 44 */
    0, /* 45 */
    0, /* 46 */
    TclBN_mp_ubin_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_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 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs







|
|



|
|
|



|
|
|
|
|
|
|
|
|
|
|
|
|

|


|





|
|
|



|







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
    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 */
    TclBN_mp_set, /* 39 */
    TclBN_mp_sqr, /* 40 */
    TclBN_mp_sqrt, /* 41 */
    TclBN_mp_sub, /* 42 */
    TclBN_mp_sub_d, /* 43 */
    TclBN_mp_to_unsigned_bin, /* 44 */
    TclBN_mp_to_unsigned_bin_n, /* 45 */
    TclBN_mp_toradix_n, /* 46 */
    TclBN_mp_ubin_size, /* 47 */
    TclBN_mp_xor, /* 48 */
    TclBN_mp_zero, /* 49 */
    TclBN_reverse, /* 50 */
    TclBN_s_mp_mul_digs_fast, /* 51 */
    TclBN_s_mp_sqr_fast, /* 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_ul, /* 61 */
    TclBN_mp_set_ul, /* 62 */
    TclBN_mp_cnt_lsb, /* 63 */
    TclBN_mp_init_l, /* 64 */
    TclBN_mp_init_i64, /* 65 */
    TclBN_mp_init_u64, /* 66 */
    TclBN_mp_expt_d_ex, /* 67 */
    TclBN_mp_set_u64, /* 68 */
    TclBN_mp_get_mag_u64, /* 69 */
    TclBN_mp_set_i64, /* 70 */
    0, /* 71 */
    0, /* 72 */
    TclBN_mp_tc_and, /* 73 */
    TclBN_mp_tc_or, /* 74 */
    TclBN_mp_tc_xor, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    0, /* 77 */
    TclBN_mp_to_ubin, /* 78 */
    TclBN_mp_div_ld, /* 79 */
    TclBN_mp_to_radix, /* 80 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
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
    Tcl_AppendStringsToObj, /* 15 */
    Tcl_AppendToObj, /* 16 */
    Tcl_ConcatObj, /* 17 */
    Tcl_ConvertToType, /* 18 */
    Tcl_DbDecrRefCount, /* 19 */
    Tcl_DbIncrRefCount, /* 20 */
    Tcl_DbIsShared, /* 21 */
    0, /* 22 */
    Tcl_DbNewByteArrayObj, /* 23 */
    Tcl_DbNewDoubleObj, /* 24 */
    Tcl_DbNewListObj, /* 25 */
    0, /* 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_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_NewByteArrayObj, /* 50 */
    Tcl_NewDoubleObj, /* 51 */
    0, /* 52 */
    Tcl_NewListObj, /* 53 */
    0, /* 54 */
    Tcl_NewObj, /* 55 */
    Tcl_NewStringObj, /* 56 */
    0, /* 57 */
    Tcl_SetByteArrayLength, /* 58 */
    Tcl_SetByteArrayObj, /* 59 */
    Tcl_SetDoubleObj, /* 60 */
    0, /* 61 */
    Tcl_SetListObj, /* 62 */
    0, /* 63 */
    Tcl_SetObjLength, /* 64 */
    Tcl_SetStringObj, /* 65 */
    0, /* 66 */
    0, /* 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_BadChannelOption, /* 78 */
    Tcl_CallWhenDeleted, /* 79 */
    Tcl_CancelIdleCall, /* 80 */
    0, /* 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_CreateObjCommand, /* 96 */
    Tcl_CreateChild, /* 97 */
    Tcl_CreateTimerHandler, /* 98 */
    Tcl_CreateTrace, /* 99 */
    Tcl_DeleteAssocData, /* 100 */
    Tcl_DeleteChannelHandler, /* 101 */
    Tcl_DeleteCloseHandler, /* 102 */







|



|









|












|


|

|


|



|

|


|
|








|
|



|













|







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
    Tcl_AppendStringsToObj, /* 15 */
    Tcl_AppendToObj, /* 16 */
    Tcl_ConcatObj, /* 17 */
    Tcl_ConvertToType, /* 18 */
    Tcl_DbDecrRefCount, /* 19 */
    Tcl_DbIncrRefCount, /* 20 */
    Tcl_DbIsShared, /* 21 */
    Tcl_DbNewBooleanObj, /* 22 */
    Tcl_DbNewByteArrayObj, /* 23 */
    Tcl_DbNewDoubleObj, /* 24 */
    Tcl_DbNewListObj, /* 25 */
    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 */
    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 */
    Tcl_NewBooleanObj, /* 49 */
    Tcl_NewByteArrayObj, /* 50 */
    Tcl_NewDoubleObj, /* 51 */
    Tcl_NewIntObj, /* 52 */
    Tcl_NewListObj, /* 53 */
    Tcl_NewLongObj, /* 54 */
    Tcl_NewObj, /* 55 */
    Tcl_NewStringObj, /* 56 */
    Tcl_SetBooleanObj, /* 57 */
    Tcl_SetByteArrayLength, /* 58 */
    Tcl_SetByteArrayObj, /* 59 */
    Tcl_SetDoubleObj, /* 60 */
    Tcl_SetIntObj, /* 61 */
    Tcl_SetListObj, /* 62 */
    Tcl_SetLongObj, /* 63 */
    Tcl_SetObjLength, /* 64 */
    Tcl_SetStringObj, /* 65 */
    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 */
    Tcl_BackgroundError, /* 76 */
    Tcl_Backslash, /* 77 */
    Tcl_BadChannelOption, /* 78 */
    Tcl_CallWhenDeleted, /* 79 */
    Tcl_CancelIdleCall, /* 80 */
    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 */
    Tcl_CreateMathFunc, /* 95 */
    Tcl_CreateObjCommand, /* 96 */
    Tcl_CreateChild, /* 97 */
    Tcl_CreateTimerHandler, /* 98 */
    Tcl_CreateTrace, /* 99 */
    Tcl_DeleteAssocData, /* 100 */
    Tcl_DeleteChannelHandler, /* 101 */
    Tcl_DeleteCloseHandler, /* 102 */
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
    Tcl_DStringInit, /* 122 */
    Tcl_DStringResult, /* 123 */
    Tcl_DStringSetLength, /* 124 */
    Tcl_DStringStartSublist, /* 125 */
    Tcl_Eof, /* 126 */
    Tcl_ErrnoId, /* 127 */
    Tcl_ErrnoMsg, /* 128 */
    0, /* 129 */
    Tcl_EvalFile, /* 130 */
    0, /* 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_FirstHashEntry, /* 145 */
    Tcl_Flush, /* 146 */
    0, /* 147 */
    Tcl_GetAlias, /* 148 */
    Tcl_GetAliasObj, /* 149 */
    Tcl_GetAssocData, /* 150 */
    Tcl_GetChannel, /* 151 */
    Tcl_GetChannelBufferSize, /* 152 */
    Tcl_GetChannelHandle, /* 153 */
    Tcl_GetChannelInstanceData, /* 154 */







|

|












|


|







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
    Tcl_DStringInit, /* 122 */
    Tcl_DStringResult, /* 123 */
    Tcl_DStringSetLength, /* 124 */
    Tcl_DStringStartSublist, /* 125 */
    Tcl_Eof, /* 126 */
    Tcl_ErrnoId, /* 127 */
    Tcl_ErrnoMsg, /* 128 */
    Tcl_Eval, /* 129 */
    Tcl_EvalFile, /* 130 */
    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 */
    Tcl_FindExecutable, /* 144 */
    Tcl_FirstHashEntry, /* 145 */
    Tcl_Flush, /* 146 */
    Tcl_FreeResult, /* 147 */
    Tcl_GetAlias, /* 148 */
    Tcl_GetAliasObj, /* 149 */
    Tcl_GetAssocData, /* 150 */
    Tcl_GetChannel, /* 151 */
    Tcl_GetChannelBufferSize, /* 152 */
    Tcl_GetChannelHandle, /* 153 */
    Tcl_GetChannelInstanceData, /* 154 */
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
#endif /* MACOSX */
    Tcl_GetPathType, /* 168 */
    Tcl_Gets, /* 169 */
    Tcl_GetsObj, /* 170 */
    Tcl_GetServiceMode, /* 171 */
    Tcl_GetChild, /* 172 */
    Tcl_GetStdChannel, /* 173 */
    0, /* 174 */
    0, /* 175 */
    Tcl_GetVar2, /* 176 */
    0, /* 177 */
    0, /* 178 */
    Tcl_HideCommand, /* 179 */
    Tcl_Init, /* 180 */
    Tcl_InitHashTable, /* 181 */
    Tcl_InputBlocked, /* 182 */
    Tcl_InputBuffered, /* 183 */
    Tcl_InterpDeleted, /* 184 */
    Tcl_IsSafe, /* 185 */







|
|

|
|







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
#endif /* MACOSX */
    Tcl_GetPathType, /* 168 */
    Tcl_Gets, /* 169 */
    Tcl_GetsObj, /* 170 */
    Tcl_GetServiceMode, /* 171 */
    Tcl_GetChild, /* 172 */
    Tcl_GetStdChannel, /* 173 */
    Tcl_GetStringResult, /* 174 */
    Tcl_GetVar, /* 175 */
    Tcl_GetVar2, /* 176 */
    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 */
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
    Tcl_RegExpExec, /* 213 */
    Tcl_RegExpMatch, /* 214 */
    Tcl_RegExpRange, /* 215 */
    Tcl_Release, /* 216 */
    Tcl_ResetResult, /* 217 */
    Tcl_ScanElement, /* 218 */
    Tcl_ScanCountedElement, /* 219 */
    0, /* 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_SetRecursionLimit, /* 231 */
    0, /* 232 */
    Tcl_SetServiceMode, /* 233 */
    Tcl_SetObjErrorCode, /* 234 */
    Tcl_SetObjResult, /* 235 */
    Tcl_SetStdChannel, /* 236 */
    0, /* 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_TraceVar2, /* 248 */
    Tcl_TranslateFileName, /* 249 */
    Tcl_Ungets, /* 250 */
    Tcl_UnlinkVar, /* 251 */
    Tcl_UnregisterChannel, /* 252 */
    0, /* 253 */
    Tcl_UnsetVar2, /* 254 */
    0, /* 255 */
    Tcl_UntraceVar2, /* 256 */
    Tcl_UpdateLinkedVar, /* 257 */
    0, /* 258 */
    Tcl_UpVar2, /* 259 */
    Tcl_VarEval, /* 260 */
    0, /* 261 */
    Tcl_VarTraceInfo2, /* 262 */
    Tcl_Write, /* 263 */
    Tcl_WrongNumArgs, /* 264 */
    Tcl_DumpActiveMemory, /* 265 */
    Tcl_ValidateAllMemory, /* 266 */
    0, /* 267 */
    0, /* 268 */
    Tcl_HashStats, /* 269 */
    Tcl_ParseVar, /* 270 */
    0, /* 271 */
    Tcl_PkgPresentEx, /* 272 */
    0, /* 273 */
    0, /* 274 */
    0, /* 275 */
    0, /* 276 */
    Tcl_WaitPid, /* 277 */
    0, /* 278 */
    Tcl_GetVersion, /* 279 */
    Tcl_InitMemory, /* 280 */
    Tcl_StackChannel, /* 281 */
    Tcl_UnstackChannel, /* 282 */
    Tcl_GetStackedChannel, /* 283 */
    Tcl_SetMainLoop, /* 284 */
    0, /* 285 */
    Tcl_AppendObjToObj, /* 286 */
    Tcl_CreateEncoding, /* 287 */
    Tcl_CreateThreadExitHandler, /* 288 */
    Tcl_DeleteThreadExitHandler, /* 289 */
    0, /* 290 */
    Tcl_EvalEx, /* 291 */
    Tcl_EvalObjv, /* 292 */
    Tcl_EvalObjEx, /* 293 */
    Tcl_ExitThread, /* 294 */
    Tcl_ExternalToUtf, /* 295 */
    Tcl_ExternalToUtfDString, /* 296 */
    Tcl_FinalizeThread, /* 297 */







|









|

|




|






|
|
|
|





|

|


|


|





|
|


|

|
|
|
|

|











|







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
    Tcl_RegExpExec, /* 213 */
    Tcl_RegExpMatch, /* 214 */
    Tcl_RegExpRange, /* 215 */
    Tcl_Release, /* 216 */
    Tcl_ResetResult, /* 217 */
    Tcl_ScanElement, /* 218 */
    Tcl_ScanCountedElement, /* 219 */
    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 */
    Tcl_SetPanicProc, /* 230 */
    Tcl_SetRecursionLimit, /* 231 */
    Tcl_SetResult, /* 232 */
    Tcl_SetServiceMode, /* 233 */
    Tcl_SetObjErrorCode, /* 234 */
    Tcl_SetObjResult, /* 235 */
    Tcl_SetStdChannel, /* 236 */
    Tcl_SetVar, /* 237 */
    Tcl_SetVar2, /* 238 */
    Tcl_SignalId, /* 239 */
    Tcl_SignalMsg, /* 240 */
    Tcl_SourceRCFile, /* 241 */
    Tcl_SplitList, /* 242 */
    Tcl_SplitPath, /* 243 */
    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 */
    Tcl_UnsetVar, /* 253 */
    Tcl_UnsetVar2, /* 254 */
    Tcl_UntraceVar, /* 255 */
    Tcl_UntraceVar2, /* 256 */
    Tcl_UpdateLinkedVar, /* 257 */
    Tcl_UpVar, /* 258 */
    Tcl_UpVar2, /* 259 */
    Tcl_VarEval, /* 260 */
    Tcl_VarTraceInfo, /* 261 */
    Tcl_VarTraceInfo2, /* 262 */
    Tcl_Write, /* 263 */
    Tcl_WrongNumArgs, /* 264 */
    Tcl_DumpActiveMemory, /* 265 */
    Tcl_ValidateAllMemory, /* 266 */
    Tcl_AppendResultVA, /* 267 */
    Tcl_AppendStringsToObjVA, /* 268 */
    Tcl_HashStats, /* 269 */
    Tcl_ParseVar, /* 270 */
    Tcl_PkgPresent, /* 271 */
    Tcl_PkgPresentEx, /* 272 */
    Tcl_PkgProvide, /* 273 */
    Tcl_PkgRequire, /* 274 */
    Tcl_SetErrorCodeVA, /* 275 */
    Tcl_VarEvalVA, /* 276 */
    Tcl_WaitPid, /* 277 */
    Tcl_PanicVA, /* 278 */
    Tcl_GetVersion, /* 279 */
    Tcl_InitMemory, /* 280 */
    Tcl_StackChannel, /* 281 */
    Tcl_UnstackChannel, /* 282 */
    Tcl_GetStackedChannel, /* 283 */
    Tcl_SetMainLoop, /* 284 */
    0, /* 285 */
    Tcl_AppendObjToObj, /* 286 */
    Tcl_CreateEncoding, /* 287 */
    Tcl_CreateThreadExitHandler, /* 288 */
    Tcl_DeleteThreadExitHandler, /* 289 */
    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
    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_SetSystemEncoding, /* 316 */
    Tcl_SetVar2Ex, /* 317 */
    Tcl_ThreadAlert, /* 318 */
    Tcl_ThreadQueueEvent, /* 319 */
    Tcl_UniCharAtIndex, /* 320 */
    Tcl_UniCharToLower, /* 321 */
    Tcl_UniCharToTitle, /* 322 */







|
|







1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
    Tcl_InitNotifier, /* 307 */
    Tcl_MutexLock, /* 308 */
    Tcl_MutexUnlock, /* 309 */
    Tcl_ConditionNotify, /* 310 */
    Tcl_ConditionWait, /* 311 */
    Tcl_NumUtfChars, /* 312 */
    Tcl_ReadChars, /* 313 */
    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 */
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
    Tcl_UtfToLower, /* 334 */
    Tcl_UtfToTitle, /* 335 */
    Tcl_UtfToChar16, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    0, /* 341 */
    0, /* 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_GetRegExpFromObj, /* 356 */
    0, /* 357 */
    Tcl_FreeParse, /* 358 */
    Tcl_LogCommandInfo, /* 359 */
    Tcl_ParseBraces, /* 360 */
    Tcl_ParseCommand, /* 361 */
    Tcl_ParseExpr, /* 362 */
    Tcl_ParseQuotedString, /* 363 */
    Tcl_ParseVarName, /* 364 */







|
|









|
|



|







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
    Tcl_UtfToLower, /* 334 */
    Tcl_UtfToTitle, /* 335 */
    Tcl_UtfToChar16, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    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 */
    Tcl_UniCharLen, /* 352 */
    Tcl_UniCharNcmp, /* 353 */
    Tcl_Char16ToUtfDString, /* 354 */
    Tcl_UtfToChar16DString, /* 355 */
    Tcl_GetRegExpFromObj, /* 356 */
    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
    Tcl_UniCharIsPunct, /* 375 */
    Tcl_RegExpExecObj, /* 376 */
    Tcl_RegExpGetInfo, /* 377 */
    Tcl_NewUnicodeObj, /* 378 */
    Tcl_SetUnicodeObj, /* 379 */
    Tcl_GetCharLength, /* 380 */
    Tcl_GetUniChar, /* 381 */
    0, /* 382 */
    Tcl_GetRange, /* 383 */
    0, /* 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_ChannelClose2Proc, /* 402 */
    Tcl_ChannelInputProc, /* 403 */
    Tcl_ChannelOutputProc, /* 404 */
    0, /* 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_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_SubstObj, /* 437 */
    Tcl_DetachChannel, /* 438 */
    Tcl_IsStandardChannel, /* 439 */
    Tcl_FSCopyFile, /* 440 */
    Tcl_FSCopyDirectory, /* 441 */
    Tcl_FSCreateDirectory, /* 442 */
    Tcl_FSDeleteFile, /* 443 */







|

|
















|



|













|
|
|
|












|
|







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
    Tcl_UniCharIsPunct, /* 375 */
    Tcl_RegExpExecObj, /* 376 */
    Tcl_RegExpGetInfo, /* 377 */
    Tcl_NewUnicodeObj, /* 378 */
    Tcl_SetUnicodeObj, /* 379 */
    Tcl_GetCharLength, /* 380 */
    Tcl_GetUniChar, /* 381 */
    Tcl_GetUnicode, /* 382 */
    Tcl_GetRange, /* 383 */
    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 */
    Tcl_ChannelCloseProc, /* 401 */
    Tcl_ChannelClose2Proc, /* 402 */
    Tcl_ChannelInputProc, /* 403 */
    Tcl_ChannelOutputProc, /* 404 */
    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 */
    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 */
    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
    Tcl_GetCurrentNamespace, /* 512 */
    Tcl_GetGlobalNamespace, /* 513 */
    Tcl_FindNamespace, /* 514 */
    Tcl_FindCommand, /* 515 */
    Tcl_GetCommandFromObj, /* 516 */
    Tcl_GetCommandFullName, /* 517 */
    Tcl_FSEvalFileEx, /* 518 */
    0, /* 519 */
    Tcl_LimitAddHandler, /* 520 */
    Tcl_LimitRemoveHandler, /* 521 */
    Tcl_LimitReady, /* 522 */
    Tcl_LimitCheck, /* 523 */
    Tcl_LimitExceeded, /* 524 */
    Tcl_LimitSetCommands, /* 525 */
    Tcl_LimitSetTime, /* 526 */







|







1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
    Tcl_GetCurrentNamespace, /* 512 */
    Tcl_GetGlobalNamespace, /* 513 */
    Tcl_FindNamespace, /* 514 */
    Tcl_FindCommand, /* 515 */
    Tcl_GetCommandFromObj, /* 516 */
    Tcl_GetCommandFullName, /* 517 */
    Tcl_FSEvalFileEx, /* 518 */
    Tcl_SetExitProc, /* 519 */
    Tcl_LimitAddHandler, /* 520 */
    Tcl_LimitRemoveHandler, /* 521 */
    Tcl_LimitReady, /* 522 */
    Tcl_LimitCheck, /* 523 */
    Tcl_LimitExceeded, /* 524 */
    Tcl_LimitSetCommands, /* 525 */
    Tcl_LimitSetTime, /* 526 */
Changes to generic/tclStubLib.c.
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
    /*
     * 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 */
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }







|
|







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
    /*
     * 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->result = (char *)"interpreter uses an incompatible stubs mechanism";
	iPtr->freeProc = 0;
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
Changes to generic/tclTest.c.
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
static Tcl_ObjCmdProc	NoopObjCmd;
static int		ObjTraceProc(void *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		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(void *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
static Tcl_ObjCmdProc	TeststringbytesObjCmd;







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
static Tcl_ObjCmdProc	NoopObjCmd;
static int		ObjTraceProc(void *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		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(char *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
static Tcl_ObjCmdProc	TeststringbytesObjCmd;
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
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);
static Tcl_ObjCmdProc	TestsaveresultCmd;
static void		TestsaveresultFree(void *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_CmdProc	TeststaticpkgCmd;







|

|







261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
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,
			    int length, int *cflagsPtr, int *eflagsPtr);
static Tcl_ObjCmdProc	TestsaveresultCmd;
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_CmdProc	TeststaticpkgCmd;
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
	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);
	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);
	    }
            Tcl_MutexUnlock(&asyncTestMutex);
	    return TCL_OK;
	}
	if (argc != 3) {
	    goto wrongNumArgs;
	}







|
|

















|
|







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
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	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);
		ckfree(asyncPtr->command);
		ckfree(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
	    }
	    if (prevPtr == NULL) {
		firstHandler = asyncPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = asyncPtr->nextPtr;
	    }
	    Tcl_AsyncDelete(asyncPtr->handler);
	    Tcl_Free(asyncPtr->command);
	    Tcl_Free(asyncPtr);
	    break;
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else if (strcmp(argv[1], "mark") == 0) {
	if (argc != 5) {
	    goto wrongNumArgs;
	}







|
|







784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
	    }
	    if (prevPtr == NULL) {
		firstHandler = asyncPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = asyncPtr->nextPtr;
	    }
	    Tcl_AsyncDelete(asyncPtr->handler);
	    ckfree(asyncPtr->command);
	    ckfree(asyncPtr);
	    break;
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else if (strcmp(argv[1], "mark") == 0) {
	if (argc != 5) {
	    goto wrongNumArgs;
	}
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
                                 * 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];
    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[2] = string;
    listArgv[3] = NULL;
    cmd = Tcl_Merge(3, listArgv);
    if (interp != NULL) {
	code = Tcl_EvalEx(interp, cmd, -1, 0);
    } 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);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * AsyncThreadProc --







|
<


















|











|







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
                                 * 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], *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_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);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    ckfree(cmd);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * AsyncThreadProc --
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
    }

    child = Tcl_GetChild(interp, argv[1]);
    if (child == NULL) {
	return TCL_ERROR;
    }

    dPtr = (DelCmd *)Tcl_Alloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = (char *)Tcl_Alloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    void *clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = (DelCmd *)clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestdelassocdataCmd --
 *







|

|

















|
|











|
|







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
    }

    child = Tcl_GetChild(interp, argv[1]);
    if (child == NULL) {
	return TCL_ERROR;
    }

    dPtr = (DelCmd *)ckalloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    void *clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = (DelCmd *)clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestdelassocdataCmd --
 *
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(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;
}







|







1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-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;
}
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	} 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);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = (char *)Tcl_Alloc(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;
	    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;







|



|







1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	} 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);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = (char *)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*)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;
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822

/*
 * 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. */
) {
    Tcl_Free(((char *)blockPtr) - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *







|

|







1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(
    char *blockPtr			/* Block to free. */
) {
    ckfree(blockPtr - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;







|



|



|







1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = (TclEncoding*)ckalloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982

static void
EncodingFreeProc(
    void *clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = (TclEncoding *)clientData;

    Tcl_Free(encodingPtr->toUtfCmd);
    Tcl_Free(encodingPtr->fromUtfCmd);
    Tcl_Free(encodingPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestevalexObjCmd --
 *







|
|
|







1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981

static void
EncodingFreeProc(
    void *clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = (TclEncoding *)clientData;

    ckfree(encodingPtr->toUtfCmd);
    ckfree(encodingPtr->fromUtfCmd);
    ckfree(encodingPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestevalexObjCmd --
 *
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
	    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->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);







|







2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
	    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 *)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);
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
	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);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(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);







|




|







2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
	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) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		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
	    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);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(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) {







|




|







3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_UpdateLinkedVar(interp, "bool");
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		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) {
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
    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 LinkOption { 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,







|







3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
    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,
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
	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 LinkOption) 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++) {







|







3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
	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++) {
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
 */

static void
CleanupTestSetassocdataTests(
    void *clientData,	/* Data to be released. */
    TCL_UNUSED(Tcl_Interp *))
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
 *







|







3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
 */

static void
CleanupTestSetassocdataTests(
    void *clientData,	/* Data to be released. */
    TCL_UNUSED(Tcl_Interp *))
{
    ckfree(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
 *
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
static int
TestregexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, 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[] = {
	"-indices",	"-nocase",	"-about",	"-expanded",
	"-line",	"-linestop",	"-lineanchor",
	"-xflags",
	"--",		NULL
    };
    enum options {
	REGEXP_INDICES, REGEXP_NOCASE,	REGEXP_ABOUT,	REGEXP_EXPANDED,
	REGEXP_MULTI,	REGEXP_NOCROSS,	REGEXP_NEWL,
	REGEXP_XFLAGS,
	REGEXP_LAST
    };

    indices = 0;







|
<











|







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
static int
TestregexpObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, ii, indices, stringLength, match, about;

    int hasxflags, cflags, eflags;
    Tcl_RegExp regExpr;
    const char *string;
    Tcl_Obj *objPtr;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
	"-indices",	"-nocase",	"-about",	"-expanded",
	"-line",	"-linestop",	"-lineanchor",
	"-xflags",
	"--",		NULL
    };
    enum optionsEnum {
	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
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	case REGEXP_INDICES:
	    indices = 1;
	    break;
	case REGEXP_NOCASE:
	    cflags |= REG_ICASE;
	    break;
	case REGEXP_ABOUT:







|







3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum optionsEnum) 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
	 * 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;
	    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);
	    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);
	    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;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;
		end = TCL_INDEX_NONE;
	    } 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) {
		end--;
	    }

	    objs[0] = Tcl_NewIntObj(start);
	    objs[1] = Tcl_NewIntObj(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
		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);







|




|













|




















|



|



|


|
|










|



|
|



|







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
	 * value 0.
	 */

	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    int start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%d %d", start, end-1);
	    value = Tcl_SetVar2(interp, varName, NULL, 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, "%ld", info.extendStart);
	    value = Tcl_SetVar2(interp, varName, NULL, 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++) {
	int start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == -1) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		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 >= 0) {
		end--;
	    }

	    objs[0] = Tcl_NewWideIntObj(start);
	    objs[1] = Tcl_NewWideIntObj(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    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);
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    size_t length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{
    size_t i;
    int cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;







|



<
|







4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020

4021
4022
4023
4024
4025
4026
4027
4028
 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    int length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{

    int i, cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;
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

    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);
    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);
    }

    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,	buf);
    return TCL_OK;
}

/*







|









|







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

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key data_item\"", NULL);
	return TCL_ERROR;
    }

    buf = (char *)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)) {
	ckfree(oldData);
    }

    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,	buf);
    return TCL_OK;
}

/*
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
    /*
     *  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);
    Tcl_Panic("%s", argString);
    Tcl_Free(argString);

    return TCL_OK;
}

static int
TestfileCmd(
    TCL_UNUSED(void *),







|







4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
    /*
     *  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);
    Tcl_Panic("%s", argString);
    ckfree(argString);

    return TCL_OK;
}

static int
TestfileCmd(
    TCL_UNUSED(void *),
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
    const char *s;
    char newString[TCL_INTEGER_SPACE];

    /* 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);
    }
    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 *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	objv[i] = (Tcl_Obj *)Tcl_Alloc(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]);
    }
    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");







|
|







|


|









|







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
    const char *s;
    char newString[TCL_INTEGER_SPACE];

    /* 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 *)ckalloc(sizeof(Tcl_Obj));
	ckfree(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 **)ckalloc(5000 * sizeof(Tcl_Obj *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	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++) {
	ckfree(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
    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);

    /* 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);







|







4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
    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);
    ckfree(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);
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
    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;
}








|







4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
    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 *)ckalloc(objPtr->length + 1);
	memcpy(objPtr->bytes, s, objPtr->length);
	objPtr->bytes[objPtr->length] = 0;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
static int
TestbytestringObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t n = 0;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }








|







5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
static int
TestbytestringObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n = 0;
    const char *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }

5190
5191
5192
5193
5194
5195
5196

5197
5198
5199
5200
5201
5202
5203
static int
TestsaveresultCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{

    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {







>







5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
static int
TestsaveresultCmd(
    TCL_UNUSED(void *),
    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[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = (char *)Tcl_Alloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);







|







5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = (char *)ckalloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
5257
5258
5259
5260
5261
5262
5263
5264


5265
5266

5267
5268
5269
5270
5271
5272
5273
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC:


	Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
	break;

    case RESULT_OBJECT:
	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
		? "same" : "different");
	break;
    default:
	break;
    }







|
>
>
|

>







5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC: {
	int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;

	Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
	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
 *	Increments the freeCount.
 *
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    TCL_UNUSED(void *))
{
    freeCount++;
}

/*
 *----------------------------------------------------------------------
 *







|







5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
 *	Increments the freeCount.
 *
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    TCL_UNUSED(char *))
{
    freeCount++;
}

/*
 *----------------------------------------------------------------------
 *
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
		 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);
		    break;
		}
	    }
	} else {
	    chan = Tcl_GetChannel(interp, argv[2], &mode);
	}
	if (chan == (Tcl_Channel) NULL) {







|







5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
		 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;
		    ckfree(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
	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->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }








|







5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
	Tcl_UnregisterChannel(interp, chan);

	Tcl_CutChannel(chan);

	/* Remember the channel in the pool of detached channels */

	det = (TestChannel *)ckalloc(sizeof(TestChannel));
	det->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }

5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
	    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->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);







|







5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = (EventScriptRecord *)ckalloc(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);
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
		Tcl_Panic("TestChannelEventCmd: damaged event script list");
	    }
	    prevEsPtr->nextPtr = esPtr->nextPtr;
	}
	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		TclChannelEventScriptInvoker, esPtr);
	Tcl_DecrRefCount(esPtr->scriptPtr);
	Tcl_Free(esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],







|







5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
		Tcl_Panic("TestChannelEventCmd: damaged event script list");
	    }
	    prevEsPtr->nextPtr = esPtr->nextPtr;
	}
	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		TclChannelEventScriptInvoker, esPtr);
	Tcl_DecrRefCount(esPtr->scriptPtr);
	ckfree(esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = nextEsPtr) {
	    nextEsPtr = esPtr->nextPtr;
	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);
	    Tcl_DecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);
	}
	statePtr->scriptRecordPtr = NULL;
	return TCL_OK;
    }

    if	((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
	if (argc != 5) {







|







6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = nextEsPtr) {
	    nextEsPtr = esPtr->nextPtr;
	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);
	    Tcl_DecrRefCount(esPtr->scriptPtr);
	    ckfree(esPtr);
	}
	statePtr->scriptRecordPtr = NULL;
	return TCL_OK;
    }

    if	((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
	if (argc != 5) {
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
static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t numBytes;
    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");
	return TCL_ERROR;
    }
	bytes = Tcl_GetString(objv[1]);
	numBytes = objv[1]->length;

    if (numBytes > (int)sizeof(buffer) - 4) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %d bytes",
		(int)sizeof(buffer) - 4));
	return TCL_ERROR;
    }







|










|
<







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
static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int numBytes;
    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");
	return TCL_ERROR;
    }
	bytes = Tcl_GetStringFromObj(objv[1], &numBytes);


    if (numBytes > (int)sizeof(buffer) - 4) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %d bytes",
		(int)sizeof(buffer) - 4));
	return TCL_ERROR;
    }
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
static int
TestUtfPrevCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t 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]);
    numBytes = objv[1]->length;

    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset == TCL_INDEX_NONE) {
	    offset = 0;
	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, bytes);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes));
    return TCL_OK;
}

/*
 * Used to check correct string-length determining in Tcl_NumUtfChars
 */

static int
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    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]);
	size_t numBytes = objv[1]->length;

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(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));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindFirst
 */







|








|
<





|









|















|
|
<










|







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
static int
TestUtfPrevCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    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_GetStringFromObj(objv[1], &numBytes);


    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset < 0) {
	    offset = 0;
	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, 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 *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int numBytes, len, limit = -1;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);


	if (objc > 2) {
	    if (Tcl_GetIntForIndex(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_NewIntObj(len));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindFirst
 */
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
	    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) {
	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));







|







7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    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));
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
    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,







|







7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
    int argc,
    TCL_UNUSED(const char **) /*argv*/)
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
    return TCL_OK;
}

static int
NREUnwind_callback(
    void *data[],
    Tcl_Interp *interp,
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
        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(







|
|
|







7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
        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((int) ((char *) data[1] - (char *) data[0]));
        idata[1] = Tcl_NewIntObj((int) ((char *) data[2] - (char *) data[0]));
        idata[2] = Tcl_NewIntObj((int) ((char *) &none   - (char *) data[0]));
        Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
    }
    return TCL_OK;
}

static int
TestNREUnwind(
7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
    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:







<
<







7484
7485
7486
7487
7488
7489
7490


7491
7492
7493
7494
7495
7496
7497
    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) {


	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:
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
    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:







<
<







7514
7515
7516
7517
7518
7519
7520


7521
7522
7523
7524
7525
7526
7527
    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) {


	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:
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
    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:







<
<







7545
7546
7547
7548
7549
7550
7551


7552
7553
7554
7555
7556
7557
7558
    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) {


	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:
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
    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.
 */








|







7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
    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));
    ckfree(remObjv);
    return TCL_OK;
}

/**
 * Test harness for command and variable resolvers.
 */

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







|















|







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
} MyResolvedVarInfo;

static inline void
HashVarFree(
    Tcl_Var var)
{
    if (VarHashRefCount(var) < 2) {
        ckfree(var);
    } else {
        VarHashRefCount(var)--;
    }
}

static void
MyCompiledVarFree(
    Tcl_ResolvedVarInfo *vInfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;

    Tcl_DecrRefCount(resVarInfo->nameObj);
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    ckfree(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
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
        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;







|
















|







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
        var = (Tcl_Var) TclVarHashGetValue(hPtr);
    } else {
        var = NULL;
    }
    resVarInfo->var = var;

    /*
     * Increment the reference counter to avoid ckfree() 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 *)ckalloc(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;
Changes to generic/tclTestObj.c.
21
22
23
24
25
26
27








28
29
30
31
32
33
34
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"










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

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,







>
>
>
>
>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"

#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

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

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{
    int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
    Tcl_Free(varPtr);
}

static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
    Tcl_InterpDeleteProc *proc;

    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);







|







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
{
    int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
    ckfree(varPtr);
}

static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
    Tcl_InterpDeleteProc *proc;

    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    /*
     * 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;
    }







|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    /*
     * 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 **) ckalloc(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;
    }
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
    static const char *const 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. */
    };
    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







|
|







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
    static const char *const tablePtr[] = {"a", "b", "check", NULL};

    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	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
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
    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 *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
	    &index);
    Tcl_Free((void *)argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*







|








|







616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
    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 **)ckalloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
	    &index);
    ckfree(argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
	    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);
	    break;
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],







|
|







1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
	    string = Tcl_GetString(varPtr[varIndex]);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
	    break;
	case 4:				/* length */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    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],
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
	    }
	    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_SetObjResult(interp, varPtr[varIndex]);
	    break;
    }

    return TCL_OK;
}








|







1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
	    }
	    if ((i < 0) || (i > length)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
    }

    return TCL_OK;
}

Changes to generic/tclTestProcBodyObj.c.
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
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 */
    Tcl_ObjCmdProc *proc;	/* command proc */
    int exportIt;		/* if 1, export the command */
} CmdTable;

/*
 * Declarations for functions defined in this file.







|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
static const char checkCommand[] = "check";

/*
 * this struct describes an entry in the table of command names and command
 * procs
 */

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.
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
    for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
	if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyTestProcObjCmd --
 *







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
    cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
    for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
	if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    return Tcl_PkgProvide(interp, packageName, packageVersion);
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyTestProcObjCmd --
 *
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    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:
 */







|












335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    const char *version;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
    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.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
 *
 *----------------------------------------------------------------------
 */

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

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	TclThreadStorageKeySet(keyPtr, result);
    }
#else /* TCL_THREADS */
    if (*keyPtr == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	*keyPtr = result;
	RememberSyncObject(keyPtr, &keyRecord);
    } else {
	result = *keyPtr;
    }
#endif /* TCL_THREADS */







|










|





|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
 *
 *----------------------------------------------------------------------
 */

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

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
	result = ckalloc(size);
	memset(result, 0, size);
	TclThreadStorageKeySet(keyPtr, result);
    }
#else /* TCL_THREADS */
    if (*keyPtr == NULL) {
	result = ckalloc(size);
	memset(result, 0, size);
	*keyPtr = result;
	RememberSyncObject(keyPtr, &keyRecord);
    } else {
	result = *keyPtr;
    }
#endif /* TCL_THREADS */
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    /*
     * 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 *));
	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);
	}
	recPtr->list = newList;
	recPtr->num = j;
    }

    recPtr->list[recPtr->num] = objPtr;
    recPtr->num++;







|






|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    /*
     * 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 **)ckalloc(recPtr->max * sizeof(void *));
	for (i=0,j=0 ; i<recPtr->num ; i++) {
	    if (recPtr->list[i] != NULL) {
		newList[j++] = recPtr->list[i];
	    }
	}
	if (recPtr->list != NULL) {
	    ckfree(recPtr->list);
	}
	recPtr->list = newList;
	recPtr->num = j;
    }

    recPtr->list[recPtr->num] = objPtr;
    recPtr->num++;
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
     * 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);
	}
	Tcl_Free(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if TCL_THREADS
    /*
     * Call thread storage global 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);
	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);
	condRecord.list = NULL;
    }
    condRecord.max = 0;
    condRecord.num = 0;

    TclpGlobalUnlock();
#endif /* TCL_THREADS */







|

|



















|












|







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
     * 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;
	    ckfree(blockPtr);
	}
	ckfree(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

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

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
	if (mutexPtr != NULL) {
	    TclpFinalizeMutex(mutexPtr);
	}
    }
    if (mutexRecord.list != NULL) {
	ckfree(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) {
	ckfree(condRecord.list);
	condRecord.list = NULL;
    }
    condRecord.max = 0;
    condRecord.num = 0;

    TclpGlobalUnlock();
#endif /* TCL_THREADS */
Changes to generic/tclThreadAlloc.c.
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#define MAXALLOC	(MINALLOC << (NBUCKETS - 1))

/*
 * The following structure defines a bucket of blocks with various accounting
 * and statistics information.
 */

typedef struct {
    Block *firstPtr;		/* First block available */
    Block *lastPtr;		/* End of block list */
    size_t 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 */
} 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
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().







|


|



|
|
|
|
|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#define MAXALLOC	(MINALLOC << (NBUCKETS - 1))

/*
 * The following structure defines a bucket of blocks with various accounting
 * and statistics information.
 */

typedef struct Bucket {
    Block *firstPtr;		/* First block available */
    Block *lastPtr;		/* End of block list */
    long numFree;		/* Number of blocks available */

    /* All fields below for accounting only */

    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
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
/*
 * 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. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
} bucketInfo[NBUCKETS];

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








|
|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
/*
 * 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. */
    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.
 */

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = (Cache*)TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = (Cache*)TclpSysAlloc(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;







|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = (Cache*)TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache), 0);
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
        memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
297
298
299
300
301
302
303
304
305
306
307
308
309













310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    size_t reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;
    size_t size;














    GETCACHE(cachePtr);

    /*
     * Increment the requested size to include room for the Block structure.
     * Call TclpSysAlloc() 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++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = (Block *)TclpSysAlloc(size);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;







|





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

















|







297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    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

    GETCACHE(cachePtr);

    /*
     * Increment the requested size to include room for the Block structure.
     * Call TclpSysAlloc() 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++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = (Block *)TclpSysAlloc(size, 0);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438













439
440
441
442
443
444
445
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *ptr,
    size_t reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    void *newPtr;
    size_t size, min;
    int bucket;

    if (ptr == NULL) {
	return TclpAlloc(reqSize);
    }














    GETCACHE(cachePtr);

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







|










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







434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
 *
 *----------------------------------------------------------------------
 */

void *
TclpRealloc(
    void *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

    GETCACHE(cachePtr);

    /*
     * 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.
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
	    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);
	    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) {
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;







|







559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
	    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, 0);
	    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) {
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
	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,
		    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);







|
|







667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
	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, "%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);
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945

static int
GetBlocks(
    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    size_t 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.
     */







|







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971

static int
GetBlocks(
    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    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.
     */
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
	 * 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) {
	    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--;
		break;
	    }
	}

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = (Block*)TclpSysAlloc(size);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.







|















|







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
	 * 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 > 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--;
		break;
	    }
	}

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = (Block*)TclpSysAlloc(size, 0);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
{
    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();
}








|







1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
{
    unsigned int i;

    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();
    }
    TclpInitAllocCache();
}

Changes to generic/tclThreadJoin.c.
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);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







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);
    ckfree(threadPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);







|







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 *)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);
Changes to generic/tclThreadStorage.c.
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

static TSDTable *
TSDTableCreate(void)
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    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);
    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }







|






|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

static TSDTable *
TSDTableCreate(void)
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable), 0);
    if (tsdTablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    tsdTablePtr->allocated = 8;
    tsdTablePtr->tablePtr =
	    (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
	if (tsdTablePtr->tablePtr[i] != NULL) {
	    /*
	     * These values were allocated in Tcl_GetThreadData in tclThread.c
	     * and must now be deallocated or they will leak.
	     */

	    Tcl_Free(tsdTablePtr->tablePtr[i]);
	}
    }

    TclpSysFree(tsdTablePtr->tablePtr);
    TclpSysFree(tsdTablePtr);
}








|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
	if (tsdTablePtr->tablePtr[i] != NULL) {
	    /*
	     * These values were allocated in Tcl_GetThreadData in tclThread.c
	     * and must now be deallocated or they will leak.
	     */

	    ckfree(tsdTablePtr->tablePtr[i]);
	}
    }

    TclpSysFree(tsdTablePtr->tablePtr);
    TclpSysFree(tsdTablePtr);
}

Changes to generic/tclThreadTest.c.
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
	    return TCL_ERROR;
	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    Tcl_Free(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = (char *)Tcl_Alloc(strlen(proc) + 1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");







|


|







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
	    return TCL_ERROR;
	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    ckfree(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = (char *)ckalloc(strlen(proc) + 1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    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);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);

    /*
     * Notify the parent we are alive.
     */







|







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    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 *)ckalloc(strlen(ctrlPtr->script) + 1);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);

    /*
     * Notify the parent we are alive.
     */
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
	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);
    }
}

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







|







664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
	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);
	ckfree(script);
    }
}


/*
 *------------------------------------------------------------------------
 *
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = (ThreadEvent*)Tcl_Alloc(sizeof(ThreadEvent));
    threadEventPtr->script = (char *)Tcl_Alloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = (ThreadEventResult *)Tcl_Alloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;







|
|




|







834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent));
    threadEventPtr->script = (char *)ckalloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = (ThreadEventResult *)ckalloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;
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
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    Tcl_Free(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    Tcl_Free(resultPtr->errorInfo);
	}
    }
    Tcl_AppendResult(interp, resultPtr->result, NULL);
    Tcl_ConditionFinalize(&resultPtr->done);
    code = resultPtr->code;

    Tcl_Free(resultPtr->result);
    Tcl_Free(resultPtr);

    return code;
}

/*
 *------------------------------------------------------------------------
 *







|



|






|
|







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
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_AppendResult(interp, resultPtr->result, NULL);
    Tcl_ConditionFinalize(&resultPtr->done);
    code = resultPtr->code;

    ckfree(resultPtr->result);
    ckfree(resultPtr);

    return code;
}

/*
 *------------------------------------------------------------------------
 *
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
	    errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    Tcl_Free(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = (char *)Tcl_Alloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = (char *)Tcl_Alloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = (char *)Tcl_Alloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);







|



|


|



|







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
	    errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = (char *)ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = (char *)ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = (char *)ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
 */

static void
ThreadFreeProc(
    void *clientData)
{
    if (clientData) {
	Tcl_Free(clientData);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadDeleteEvent --







|







1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
 */

static void
ThreadFreeProc(
    void *clientData)
{
    if (clientData) {
	ckfree(clientData);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadDeleteEvent --
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118

static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    TCL_UNUSED(void *))
{
    if (eventPtr->proc == ThreadEventProc) {
	Tcl_Free(((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
     * should be removed
     */







|







1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118

static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    TCL_UNUSED(void *))
{
    if (eventPtr->proc == ThreadEventProc) {
	ckfree(((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
     * should be removed
     */
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    Tcl_Free(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	Tcl_Free(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);

    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
	nextPtr = resultPtr->nextPtr;
	if (resultPtr->srcThreadId == self) {







|






|







1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    ckfree(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	ckfree(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);

    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
	nextPtr = resultPtr->nextPtr;
	if (resultPtr->srcThreadId == self) {
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
		resultList = resultPtr->nextPtr;
	    }
	    if (resultPtr->nextPtr) {
		resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
	    }
	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
	    resultPtr->eventPtr->resultPtr = NULL;
	    Tcl_Free(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);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}







|









|







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
		resultList = resultPtr->nextPtr;
	    }
	    if (resultPtr->nextPtr) {
		resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
	    }
	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
	    resultPtr->eventPtr->resultPtr = NULL;
	    ckfree(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 *)ckalloc(strlen(msg) + 1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}
Changes to generic/tclTimer.c.
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	    Tcl_Free(timerHandlerPtr);
	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	}
    }
}

/*
 *--------------------------------------------------------------







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	    ckfree(timerHandlerPtr);
	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	}
    }
}

/*
 *--------------------------------------------------------------
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;







|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = (TimerHandler *)ckalloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
	}
	Tcl_Free(timerHandlerPtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
	}
	ckfree(timerHandlerPtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	/*
	 * 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->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*







|







484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
	/*
	 * 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 *)ckalloc(sizeof(Tcl_Event));
	    timerEvPtr->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	Tcl_Free(timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------







|







587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	ckfree(timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
	tsdPtr->idleList = idlePtr;
    } else {







|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    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 {
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    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);
	    idlePtr = nextPtr;
	    if (prevPtr == NULL) {
		tsdPtr->idleList = idlePtr;
	    } else {
		prevPtr->nextPtr = idlePtr;
	    }
	    if (idlePtr == NULL) {







|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
    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;
	    ckfree(idlePtr);
	    idlePtr = nextPtr;
	    if (prevPtr == NULL) {
		tsdPtr->idleList = idlePtr;
	    } else {
		prevPtr->nextPtr = idlePtr;
	    }
	    if (idlePtr == NULL) {
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
		    && ((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);
    }
    if (tsdPtr->idleList) {
	blockTime.sec = 0;
	blockTime.usec = 0;
	Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;







|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
		    && ((oldGeneration - idlePtr->generation) >= 0));
	    idlePtr = tsdPtr->idleList) {
	tsdPtr->idleList = idlePtr->nextPtr;
	if (tsdPtr->idleList == NULL) {
	    tsdPtr->lastIdlePtr = NULL;
	}
	idlePtr->proc(idlePtr->clientData);
	ckfree(idlePtr);
    }
    if (tsdPtr->idleList) {
	blockTime.sec = 0;
	blockTime.usec = 0;
	Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;
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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    size_t length;
    int index = -1;
    static const char *const afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?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);
    if (assocPtr == NULL) {
	assocPtr = (AfterAssocData *)Tcl_Alloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
     */

    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]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad argument \"%s\": must be"
                    " cancel, idle, info, or an integer", arg));
            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
                    arg, NULL);
	    return TCL_ERROR;







|




|














|












|







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
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    int length;
    int index = -1;
    static const char *const afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmdsEnum {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?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);
    if (assocPtr == NULL) {
	assocPtr = (AfterAssocData *)ckalloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
     */

    if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
	if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
		!= TCL_OK) {
            const char *arg = Tcl_GetString(objv[1]);

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad argument \"%s\": must be"
                    " cancel, idle, info, or an integer", arg));
            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
                    arg, NULL);
	    return TCL_ERROR;
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = (AfterInfo *)Tcl_Alloc(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);







|







840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = (AfterInfo *)ckalloc(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);
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	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;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];







|







878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
	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;
	int tempLength;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = (AfterInfo *)Tcl_Alloc(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);







|







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = (AfterInfo *)ckalloc(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);
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
    Tcl_Release(interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *







|







1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
    Tcl_Release(interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
		prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body. */
	}
	prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *







|







1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
		prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body. */
	}
	prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    ckfree(afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {
	    Tcl_CancelIdleCall(AfterProc, afterPtr);
	}
	Tcl_DecrRefCount(afterPtr->commandPtr);
	Tcl_Free(afterPtr);
    }
    Tcl_Free(assocPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







|

|











1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {
	    Tcl_CancelIdleCall(AfterProc, afterPtr);
	}
	Tcl_DecrRefCount(afterPtr->commandPtr);
	ckfree(afterPtr);
    }
    ckfree(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.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
    int MP_WUR TclBN_revision(void)
}

declare 2 {
    mp_err MP_WUR TclBN_mp_add(const mp_int *a, const 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)
}
declare 4 {
    mp_err MP_WUR 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)
}
declare 9 {
    mp_ord MP_WUR 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)
}
declare 11 {
    mp_err MP_WUR TclBN_mp_copy(const mp_int *a, mp_int *b)
}
declare 12 {
    int MP_WUR TclBN_mp_count_bits(const 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)
}
declare 14 {
    mp_err MP_WUR TclBN_mp_div_d(const 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)
}
declare 16 {
    mp_err MP_WUR TclBN_mp_div_2d(const 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 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)
}
declare 20 {
    mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
    mp_err MP_WUR TclBN_mp_init(mp_int *a)
}
declare 22 {
    mp_err MP_WUR TclBN_mp_init_copy(mp_int *a, const mp_int *b)
}
declare 23 {
    mp_err MP_WUR TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
    mp_err MP_WUR 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)
}
declare 26 {
    mp_err MP_WUR 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)
}
declare 28 {
    mp_err MP_WUR TclBN_mp_mod_2d(const 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)
}
declare 30 {
    mp_err MP_WUR TclBN_mp_mul_d(const 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)
}
declare 32 {
    mp_err MP_WUR TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
}







|

















|














|







<
|
|
<
>




|














|

















|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

77
78

79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    int MP_WUR TclBN_revision(void)
}

declare 2 {
    mp_err MP_WUR TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 3 {
    mp_err MP_WUR TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c)
}
declare 4 {
    mp_err MP_WUR 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)
}
declare 9 {
    mp_ord MP_WUR TclBN_mp_cmp_d(const mp_int *a, unsigned int b)
}
declare 10 {
    mp_ord MP_WUR 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)
}
declare 12 {
    int MP_WUR TclBN_mp_count_bits(const 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)
}
declare 14 {
    mp_err MP_WUR TclBN_mp_div_d(const mp_int *a, unsigned int b, mp_int *q, unsigned int *r)
}
declare 15 {
    mp_err MP_WUR TclBN_mp_div_2(const 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)
}

declare 17 {deprecated {is private function in libtommath}} {
    mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, unsigned int *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, unsigned int b, mp_int *c)
}
declare 20 {
    mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
    mp_err MP_WUR TclBN_mp_init(mp_int *a)
}
declare 22 {
    mp_err MP_WUR TclBN_mp_init_copy(mp_int *a, const mp_int *b)
}
declare 23 {
    mp_err MP_WUR TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
    mp_err MP_WUR TclBN_mp_init_set(mp_int *a, unsigned int b)
}
declare 25 {
    mp_err MP_WUR TclBN_mp_init_size(mp_int *a, int size)
}
declare 26 {
    mp_err MP_WUR 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)
}
declare 28 {
    mp_err MP_WUR TclBN_mp_mod_2d(const 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)
}
declare 30 {
    mp_err MP_WUR TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *p)
}
declare 31 {
    mp_err MP_WUR TclBN_mp_mul_2(const 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)
}
137
138
139
140
141
142
143
144
145
146
147
148

149
150
151

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

166
167
168
169
170

171
172
173

174
175
176
177
178
179
180
181
182
183




































184
185
186
187

188
189
190

191
192
193
194
195
196
197

198
199
200
201
202
203
204
205
206
207
208

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

226
227
228
229

230
231
232

233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252
}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
declare 38 {
    mp_err MP_WUR 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)
#}
# 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 41 {
    mp_err MP_WUR TclBN_mp_sqrt(const 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)
}
declare 43 {
    mp_err MP_WUR TclBN_mp_sub_d(const 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)
#}
# Removed in 9.0

#declare 45 {
#    mp_err TclBN_mp_to_unsigned_bin_n(const 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 47 {
    size_t MP_WUR TclBN_mp_ubin_size(const mp_int *a)
}
declare 48 {
    mp_err MP_WUR 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)
#}
# 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)
}
# 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 66 {
    int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal)
}

# 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)
#}

# Added in libtommath 1.0.1
declare 68 {
    void TclBN_mp_set_u64(mp_int *a, uint64_t i)
}
declare 69 {
    uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a)
}
declare 70 {
    void TclBN_mp_set_i64(mp_int *a, int64_t i)
}

# 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)
#}
# 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)
}

# 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)
}
# 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 80 {
    int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix)
}


# Local Variables:
# mode: tcl
# End:







<
|
|
<
<
>
|
|
<
>







|

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

|







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



<
|
|
<
>







|
|
|
<
>












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








<
|
|
<
>








136
137
138
139
140
141
142

143
144


145
146
147

148
149
150
151
152
153
154
155
156
157

158
159


160
161
162
163


164
165
166

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215


216
217
218

219
220
221
222

223
224

225
226
227
228
229
230
231
232
233
234
235

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

249
250


251
252
253


254
255
256

257
258
259
260
261
262
263
264
265

266
267

268
269
270
271
272
273
274
275
276
}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
declare 38 {
    mp_err MP_WUR TclBN_mp_shrink(mp_int *a)
}

declare 39 {deprecated {macro calling mp_set_u64}} {
    void TclBN_mp_set(mp_int *a, unsigned int b)


}
declare 40 {nostub {is private function in libtommath}} {
    mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b)

}
declare 41 {
    mp_err MP_WUR TclBN_mp_sqrt(const 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)
}
declare 43 {
    mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, unsigned int b, mp_int *c)
}

declare 44 {deprecated {Use mp_to_ubin}} {
    mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)


}
declare 45 {deprecated {Use mp_to_ubin}} {
    mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b,
	    unsigned long *outlen)


}
declare 46 {deprecated {Use mp_to_radix}} {
    mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)

}
declare 47 {
    size_t TclBN_mp_ubin_size(const mp_int *a)
}
declare 48 {
    mp_err MP_WUR TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 49 {
    void TclBN_mp_zero(mp_int *a)
}

# internal routines to libtommath - should not be called but must be
# exported to accommodate the "tommath" extension

declare 50 {deprecated {is private function in libtommath}} {
    void TclBN_reverse(unsigned char *s, int len)
}
declare 51 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs)
}
declare 52 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b)
}
declare 53 {deprecated {is private function in libtommath}} {
    mp_err TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 54 {deprecated {is private function in libtommath}} {
    mp_err TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b)
}
declare 55 {deprecated {is private function in libtommath}} {
    mp_err TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 56 {deprecated {is private function in libtommath}} {
    mp_err TclBN_mp_toom_sqr(const mp_int *a, mp_int *b)
}
declare 57 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 58 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
}
declare 59 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_sqr(const mp_int *a, mp_int *b)
}
declare 60 {deprecated {is private function in libtommath}} {
    mp_err TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 61 {deprecated {macro calling mp_init_u64}} {
    mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i)


}
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 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 66 {
    int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal)
}

# Added in libtommath 1.0
declare 67 {deprecated {Use mp_expt_u32}} {
    mp_err TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, int fast)

}
# Added in libtommath 1.0.1
declare 68 {
    void TclBN_mp_set_u64(mp_int *a, uint64_t i)
}
declare 69 {
    uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a)
}
declare 70 {
    void TclBN_mp_set_i64(mp_int *a, int64_t i)
}

# Added in libtommath 1.1.0

declare 73 {deprecated {merged with mp_and}} {
    mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)


}
declare 74 {deprecated {merged with mp_or}} {
    mp_err TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)


}
declare 75 {deprecated {merged with mp_xor}} {
    mp_err 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)
}

# 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 79 {
    mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, uint64_t b, mp_int *q, uint64_t *r)

}
declare 80 {
    int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix)
}


# Local Variables:
# mode: tcl
# End:
Changes to generic/tclTomMathDecls.h.
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62

63






64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
#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))
/* 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)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (Tcl_Free((char*)(x)))

#undef MP_MALLOC
#undef MP_CALLOC
#undef MP_REALLOC
#undef MP_FREE
#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
#endif

#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

/* Rename the global symbols in libtommath to avoid linkage conflicts */

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#define bn_reverse TclBN_reverse
#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_3 TclBN_mp_div_3
#define mp_div_2d TclBN_mp_div_2d
#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_size TclBN_mp_init_size
#define mp_init_u64 TclBN_mp_init_u64
#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_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_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_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







|

|

|

|

















>
|
>
|
>
>
>
>
>
>









|





|





|

|




|






|






|

















|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
#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*)ckalloc((size_t)(s)))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
#define TclBNCalloc(m,s) memset(ckalloc((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*)ckrealloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (ckfree((char*)(x)))

#undef MP_MALLOC
#undef MP_CALLOC
#undef MP_REALLOC
#undef MP_FREE
#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
#endif

#ifdef __cplusplus
extern "C" {
#endif
MODULE_SCOPE mp_err	TclBN_s_mp_add_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE mp_ord	TclBN_s_mp_cmp_d(const mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
MODULE_SCOPE mp_err	TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *b);
MODULE_SCOPE mp_err	TclBN_s_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c);
MODULE_SCOPE mp_err	TclBN_s_mp_init_set(mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE void	TclBN_s_mp_reverse(unsigned char *s, size_t len);
MODULE_SCOPE void	TclBN_s_mp_set(mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
#ifdef __cplusplus
}
#endif

/* Rename the global symbols in libtommath to avoid linkage conflicts */

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#define bn_reverse TclBN_reverse
#define mp_add TclBN_mp_add
#define mp_add_d TclBN_s_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_s_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_s_mp_div_d
#define mp_div_2 TclBN_mp_div_2
#define mp_div_3 TclBN_s_mp_div_3
#define mp_div_2d TclBN_mp_div_2d
#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_s_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_s_mp_init_set
#define mp_init_size TclBN_mp_init_size
#define mp_init_u64 TclBN_mp_init_u64
#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_s_mp_mul_d
#define mp_mul_2 TclBN_mp_mul_2
#define mp_mul_2d TclBN_mp_mul_2d
#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_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_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_s_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
144
145
146
147
148
149
150






151
152
153
154
155
156
157
#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







>
>
>
>
>
>







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
#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 */

#define mp_init_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_init_ul") TclBN_mp_init_u64(a,(unsigned int)(b)))
#define mp_set_int(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),((unsigned int)(b))),MP_OKAY))
#define mp_set_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_ul") (TclBN_mp_set_u64((a),(long)(b)),MP_OKAY))
#define mp_set_long_long(a,b) (MP_DEPRECATED_PRAGMA("replaced by mp_set_u64") (TclBN_mp_set_u64((a),(b)),MP_OKAY))
#define mp_unsigned_bin_size(mp) (MP_DEPRECATED_PRAGMA("replaced by mp_ubin_size") (int)TclBN_mp_ubin_size(mp))

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219



220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269


270

271
272
273
274
275
276
277
278
279



280



281



282
283
284
285
286
287
288
289


290



291


292



293


294



295


296



297



298


299



300


301


302
303
304


305
306
307
308
309



310
311
312
313
314
315
316
317
318



319



320



321
322
323
324
325
326
327
328


329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
EXTERN int		TclBN_epoch(void) MP_WUR;
/* 1 */
EXTERN int		TclBN_revision(void) MP_WUR;
/* 2 */
EXTERN mp_err		TclBN_mp_add(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 3 */
EXTERN mp_err		TclBN_mp_add_d(const mp_int *a, mp_digit b,
				mp_int *c) MP_WUR;
/* 4 */
EXTERN mp_err		TclBN_mp_and(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 5 */
EXTERN void		TclBN_mp_clamp(mp_int *a);
/* 6 */
EXTERN void		TclBN_mp_clear(mp_int *a);
/* 7 */
EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
/* 8 */
EXTERN mp_ord		TclBN_mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
/* 9 */
EXTERN mp_ord		TclBN_mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR;
/* 10 */
EXTERN mp_ord		TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
/* 11 */
EXTERN mp_err		TclBN_mp_copy(const mp_int *a, mp_int *b) MP_WUR;
/* 12 */
EXTERN int		TclBN_mp_count_bits(const mp_int *a) MP_WUR;
/* 13 */
EXTERN mp_err		TclBN_mp_div(const mp_int *a, const mp_int *b,
				mp_int *q, mp_int *r) MP_WUR;
/* 14 */
EXTERN mp_err		TclBN_mp_div_d(const mp_int *a, mp_digit b,
				mp_int *q, mp_digit *r) MP_WUR;
/* 15 */
EXTERN mp_err		TclBN_mp_div_2(const mp_int *a, mp_int *q) MP_WUR;
/* 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 */



/* 18 */
EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
/* 19 */
EXTERN mp_err		TclBN_mp_expt_u32(const mp_int *a, uint32_t b,
				mp_int *c) MP_WUR;
/* 20 */
EXTERN mp_err		TclBN_mp_grow(mp_int *a, int size) MP_WUR;
/* 21 */
EXTERN mp_err		TclBN_mp_init(mp_int *a) MP_WUR;
/* 22 */
EXTERN mp_err		TclBN_mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
/* 23 */
EXTERN mp_err		TclBN_mp_init_multi(mp_int *a, ...) MP_WUR;
/* 24 */
EXTERN mp_err		TclBN_mp_init_set(mp_int *a, mp_digit b) MP_WUR;
/* 25 */
EXTERN mp_err		TclBN_mp_init_size(mp_int *a, int size) MP_WUR;
/* 26 */
EXTERN mp_err		TclBN_mp_lshd(mp_int *a, int shift) MP_WUR;
/* 27 */
EXTERN mp_err		TclBN_mp_mod(const mp_int *a, const mp_int *b,
				mp_int *r) MP_WUR;
/* 28 */
EXTERN mp_err		TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) MP_WUR;
/* 29 */
EXTERN mp_err		TclBN_mp_mul(const mp_int *a, const mp_int *b,
				mp_int *p) MP_WUR;
/* 30 */
EXTERN mp_err		TclBN_mp_mul_d(const mp_int *a, mp_digit b,
				mp_int *p) MP_WUR;
/* 31 */
EXTERN mp_err		TclBN_mp_mul_2(const mp_int *a, mp_int *p) MP_WUR;
/* 32 */
EXTERN mp_err		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) MP_WUR;
/* 33 */
EXTERN mp_err		TclBN_mp_neg(const mp_int *a, mp_int *b) MP_WUR;
/* 34 */
EXTERN mp_err		TclBN_mp_or(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 35 */
EXTERN mp_err		TclBN_mp_radix_size(const mp_int *a, int radix,
				int *size) MP_WUR;
/* 36 */
EXTERN mp_err		TclBN_mp_read_radix(mp_int *a, const char *str,
				int radix) MP_WUR;
/* 37 */
EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
/* 38 */
EXTERN mp_err		TclBN_mp_shrink(mp_int *a) MP_WUR;
/* Slot 39 is reserved */


/* Slot 40 is reserved */

/* 41 */
EXTERN mp_err		TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR;
/* 42 */
EXTERN mp_err		TclBN_mp_sub(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 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 */



/* 47 */
EXTERN size_t		TclBN_mp_ubin_size(const mp_int *a) MP_WUR;
/* 48 */
EXTERN mp_err		TclBN_mp_xor(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 49 */
EXTERN void		TclBN_mp_zero(mp_int *a);
/* 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 */


/* 63 */
EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a) MP_WUR;
/* Slot 64 is reserved */


/* 65 */
EXTERN int		TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) MP_WUR;
/* 66 */
EXTERN int		TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) MP_WUR;
/* Slot 67 is reserved */



/* 68 */
EXTERN void		TclBN_mp_set_u64(mp_int *a, uint64_t i);
/* 69 */
EXTERN uint64_t		TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR;
/* 70 */
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 */
EXTERN mp_err		TclBN_mp_signed_rsh(const mp_int *a, int b,
				mp_int *c) MP_WUR;
/* Slot 77 is reserved */
/* 78 */
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 */


/* 80 */
EXTERN int		TclBN_mp_to_radix(const mp_int *a, char *str,
				size_t maxlen, size_t *written, int radix) MP_WUR;

typedef struct TclTomMathStubs {
    int magic;
    void *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 */
    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);
    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 */
    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 */
    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);
    int (*tclBN_mp_cnt_lsb) (const mp_int *a) MP_WUR; /* 63 */
    void (*reserved64)(void);
    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 (*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);
    mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */
    void (*reserved77)(void);
    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 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}







|













|










|
|





|
>
>
>



|










|













|




















|
>
>
|
>






|

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

|





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


|
>
>




|
>
>
>








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







|
>
>











|





|




|


|

|




|





|








|
|


|
|
|
|
|


|
|
|
|
|
|
|
|
|
|
|
|
|

|


|





|
|
|



|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
EXTERN int		TclBN_epoch(void) MP_WUR;
/* 1 */
EXTERN int		TclBN_revision(void) MP_WUR;
/* 2 */
EXTERN mp_err		TclBN_mp_add(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 3 */
EXTERN mp_err		TclBN_mp_add_d(const mp_int *a, unsigned int b,
				mp_int *c) MP_WUR;
/* 4 */
EXTERN mp_err		TclBN_mp_and(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 5 */
EXTERN void		TclBN_mp_clamp(mp_int *a);
/* 6 */
EXTERN void		TclBN_mp_clear(mp_int *a);
/* 7 */
EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
/* 8 */
EXTERN mp_ord		TclBN_mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
/* 9 */
EXTERN mp_ord		TclBN_mp_cmp_d(const mp_int *a, unsigned int b) MP_WUR;
/* 10 */
EXTERN mp_ord		TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
/* 11 */
EXTERN mp_err		TclBN_mp_copy(const mp_int *a, mp_int *b) MP_WUR;
/* 12 */
EXTERN int		TclBN_mp_count_bits(const mp_int *a) MP_WUR;
/* 13 */
EXTERN mp_err		TclBN_mp_div(const mp_int *a, const mp_int *b,
				mp_int *q, mp_int *r) MP_WUR;
/* 14 */
EXTERN mp_err		TclBN_mp_div_d(const mp_int *a, unsigned int b,
				mp_int *q, unsigned int *r) MP_WUR;
/* 15 */
EXTERN mp_err		TclBN_mp_div_2(const mp_int *a, mp_int *q) MP_WUR;
/* 16 */
EXTERN mp_err		TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
				mp_int *r) MP_WUR;
/* 17 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_mp_div_3(const mp_int *a, mp_int *q,
				unsigned int *r);
/* 18 */
EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
/* 19 */
EXTERN mp_err		TclBN_mp_expt_u32(const mp_int *a, unsigned int b,
				mp_int *c) MP_WUR;
/* 20 */
EXTERN mp_err		TclBN_mp_grow(mp_int *a, int size) MP_WUR;
/* 21 */
EXTERN mp_err		TclBN_mp_init(mp_int *a) MP_WUR;
/* 22 */
EXTERN mp_err		TclBN_mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
/* 23 */
EXTERN mp_err		TclBN_mp_init_multi(mp_int *a, ...) MP_WUR;
/* 24 */
EXTERN mp_err		TclBN_mp_init_set(mp_int *a, unsigned int b) MP_WUR;
/* 25 */
EXTERN mp_err		TclBN_mp_init_size(mp_int *a, int size) MP_WUR;
/* 26 */
EXTERN mp_err		TclBN_mp_lshd(mp_int *a, int shift) MP_WUR;
/* 27 */
EXTERN mp_err		TclBN_mp_mod(const mp_int *a, const mp_int *b,
				mp_int *r) MP_WUR;
/* 28 */
EXTERN mp_err		TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) MP_WUR;
/* 29 */
EXTERN mp_err		TclBN_mp_mul(const mp_int *a, const mp_int *b,
				mp_int *p) MP_WUR;
/* 30 */
EXTERN mp_err		TclBN_mp_mul_d(const mp_int *a, unsigned int b,
				mp_int *p) MP_WUR;
/* 31 */
EXTERN mp_err		TclBN_mp_mul_2(const mp_int *a, mp_int *p) MP_WUR;
/* 32 */
EXTERN mp_err		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) MP_WUR;
/* 33 */
EXTERN mp_err		TclBN_mp_neg(const mp_int *a, mp_int *b) MP_WUR;
/* 34 */
EXTERN mp_err		TclBN_mp_or(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 35 */
EXTERN mp_err		TclBN_mp_radix_size(const mp_int *a, int radix,
				int *size) MP_WUR;
/* 36 */
EXTERN mp_err		TclBN_mp_read_radix(mp_int *a, const char *str,
				int radix) MP_WUR;
/* 37 */
EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
/* 38 */
EXTERN mp_err		TclBN_mp_shrink(mp_int *a) MP_WUR;
/* 39 */
TCL_DEPRECATED("macro calling mp_set_u64")
void			TclBN_mp_set(mp_int *a, unsigned int b);
/* 40 */
EXTERN mp_err		TclBN_mp_sqr(const mp_int *a, mp_int *b);
/* 41 */
EXTERN mp_err		TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR;
/* 42 */
EXTERN mp_err		TclBN_mp_sub(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 43 */
EXTERN mp_err		TclBN_mp_sub_d(const mp_int *a, unsigned int b,
				mp_int *c) MP_WUR;
/* 44 */
TCL_DEPRECATED("Use mp_to_ubin")
mp_err			TclBN_mp_to_unsigned_bin(const mp_int *a,
				unsigned char *b);
/* 45 */
TCL_DEPRECATED("Use mp_to_ubin")
mp_err			TclBN_mp_to_unsigned_bin_n(const mp_int *a,
				unsigned char *b, unsigned long *outlen);
/* 46 */
TCL_DEPRECATED("Use mp_to_radix")
mp_err			TclBN_mp_toradix_n(const mp_int *a, char *str,
				int radix, int maxlen);
/* 47 */
EXTERN size_t		TclBN_mp_ubin_size(const mp_int *a);
/* 48 */
EXTERN mp_err		TclBN_mp_xor(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
/* 49 */
EXTERN void		TclBN_mp_zero(mp_int *a);
/* 50 */
TCL_DEPRECATED("is private function in libtommath")
void			TclBN_reverse(unsigned char *s, int len);
/* 51 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_mul_digs_fast(const mp_int *a,
				const mp_int *b, mp_int *c, int digs);
/* 52 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_sqr_fast(const mp_int *a, mp_int *b);
/* 53 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_mp_karatsuba_mul(const mp_int *a,
				const mp_int *b, mp_int *c);
/* 54 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b);
/* 55 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_mp_toom_mul(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 56 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_mp_toom_sqr(const mp_int *a, mp_int *b);
/* 57 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_add(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 58 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b,
				mp_int *c, int digs);
/* 59 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_sqr(const mp_int *a, mp_int *b);
/* 60 */
TCL_DEPRECATED("is private function in libtommath")
mp_err			TclBN_s_mp_sub(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 61 */
TCL_DEPRECATED("macro calling mp_init_u64")
mp_err			TclBN_mp_init_ul(mp_int *a, unsigned long i);
/* 62 */
TCL_DEPRECATED("macro calling mp_set_u64")
void			TclBN_mp_set_ul(mp_int *a, unsigned long i);
/* 63 */
EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a) MP_WUR;
/* 64 */
TCL_DEPRECATED("macro calling mp_init_i64")
int			TclBN_mp_init_l(mp_int *bignum, long initVal);
/* 65 */
EXTERN int		TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) MP_WUR;
/* 66 */
EXTERN int		TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) MP_WUR;
/* 67 */
TCL_DEPRECATED("Use mp_expt_u32")
mp_err			TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b,
				mp_int *c, int fast);
/* 68 */
EXTERN void		TclBN_mp_set_u64(mp_int *a, uint64_t i);
/* 69 */
EXTERN uint64_t		TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR;
/* 70 */
EXTERN void		TclBN_mp_set_i64(mp_int *a, int64_t i);
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* 73 */
TCL_DEPRECATED("merged with mp_and")
mp_err			TclBN_mp_tc_and(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 74 */
TCL_DEPRECATED("merged with mp_or")
mp_err			TclBN_mp_tc_or(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 75 */
TCL_DEPRECATED("merged with mp_xor")
mp_err			TclBN_mp_tc_xor(const mp_int *a, const mp_int *b,
				mp_int *c);
/* 76 */
EXTERN mp_err		TclBN_mp_signed_rsh(const mp_int *a, int b,
				mp_int *c) MP_WUR;
/* Slot 77 is reserved */
/* 78 */
EXTERN int		TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf,
				size_t maxlen, size_t *written) MP_WUR;
/* 79 */
EXTERN mp_err		TclBN_mp_div_ld(const mp_int *a, uint64_t b,
				mp_int *q, uint64_t *r) MP_WUR;
/* 80 */
EXTERN int		TclBN_mp_to_radix(const mp_int *a, char *str,
				size_t maxlen, size_t *written, int radix) MP_WUR;

typedef struct TclTomMathStubs {
    int magic;
    void *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, unsigned int 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 */
    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, unsigned int 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, unsigned int b, mp_int *q, unsigned int *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 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r); /* 17 */
    void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
    mp_err (*tclBN_mp_expt_u32) (const mp_int *a, unsigned int 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, unsigned int 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, unsigned int 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 */
    void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
    mp_err (*tclBN_mp_shrink) (mp_int *a) MP_WUR; /* 38 */
    TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set) (mp_int *a, unsigned int b); /* 39 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */
    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, unsigned int b, mp_int *c) MP_WUR; /* 43 */
    TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */
    TCL_DEPRECATED_API("Use mp_to_ubin") mp_err (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
    TCL_DEPRECATED_API("Use mp_to_radix") mp_err (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */
    size_t (*tclBN_mp_ubin_size) (const mp_int *a); /* 47 */
    mp_err (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 48 */
    void (*tclBN_mp_zero) (mp_int *a); /* 49 */
    TCL_DEPRECATED_API("is private function in libtommath") void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs_fast) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr_fast) (const mp_int *a, mp_int *b); /* 52 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */
    TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */
    TCL_DEPRECATED_API("macro calling mp_init_u64") mp_err (*tclBN_mp_init_ul) (mp_int *a, unsigned long i); /* 61 */
    TCL_DEPRECATED_API("macro calling mp_set_u64") void (*tclBN_mp_set_ul) (mp_int *a, unsigned long i); /* 62 */
    int (*tclBN_mp_cnt_lsb) (const mp_int *a) MP_WUR; /* 63 */
    TCL_DEPRECATED_API("macro calling mp_init_i64") int (*tclBN_mp_init_l) (mp_int *bignum, long initVal); /* 64 */
    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 */
    TCL_DEPRECATED_API("Use mp_expt_u32") mp_err (*tclBN_mp_expt_d_ex) (const mp_int *a, unsigned int b, mp_int *c, int fast); /* 67 */
    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);
    TCL_DEPRECATED_API("merged with mp_and") mp_err (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */
    TCL_DEPRECATED_API("merged with mp_or") mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */
    TCL_DEPRECATED_API("merged with mp_xor") mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */
    mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */
    void (*reserved77)(void);
    int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */
    mp_err (*tclBN_mp_div_ld) (const mp_int *a, uint64_t b, mp_int *q, uint64_t *r) MP_WUR; /* 79 */
    int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
459
460
461
462
463
464
465
466

467
468
469
470
471
472
473
	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
#define TclBN_mp_div_d \
	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
#define TclBN_mp_div_2 \
	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
#define TclBN_mp_div_2d \
	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
/* Slot 17 is reserved */

#define TclBN_mp_exch \
	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
#define TclBN_mp_expt_u32 \
	(tclTomMathStubsPtr->tclBN_mp_expt_u32) /* 19 */
#define TclBN_mp_grow \
	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
#define TclBN_mp_init \







|
>







536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
#define TclBN_mp_div_d \
	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
#define TclBN_mp_div_2 \
	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
#define TclBN_mp_div_2d \
	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
#define TclBN_mp_div_3 \
	(tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
#define TclBN_mp_exch \
	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
#define TclBN_mp_expt_u32 \
	(tclTomMathStubsPtr->tclBN_mp_expt_u32) /* 19 */
#define TclBN_mp_grow \
	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
#define TclBN_mp_init \
502
503
504
505
506
507
508
509
510


511
512
513
514
515
516
517
518
519



520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
















539
540
541


542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557



558
559
560
561
562
563

564
565
566
567
568
569
570

















































571
572
573
574
575
576
577
	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
#define TclBN_mp_read_radix \
	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
#define TclBN_mp_rshd \
	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
#define TclBN_mp_shrink \
	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
/* Slot 39 is reserved */
/* Slot 40 is reserved */


#define TclBN_mp_sqrt \
	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
#define TclBN_mp_sub \
	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
#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 */
#define TclBN_mp_xor \
	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
#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 */
/* 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 */
/* Slot 67 is reserved */

#define TclBN_mp_set_u64 \
	(tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */
#define TclBN_mp_get_mag_u64 \
	(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 \
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */
/* Slot 77 is reserved */
#define TclBN_mp_to_ubin \
	(tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */
/* Slot 79 is reserved */

#define TclBN_mp_to_radix \
	(tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */

#endif /* defined(USE_TCL_STUBS) */

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







|
|
>
>






|
|
|
>
>
>






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


<
>
>




|
>








|
|
|
>
>
>





|
>







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







580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
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
	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
#define TclBN_mp_read_radix \
	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
#define TclBN_mp_rshd \
	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
#define TclBN_mp_shrink \
	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
#define TclBN_mp_set \
	(tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
#define TclBN_mp_sqr \
	(tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
#define TclBN_mp_sqrt \
	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
#define TclBN_mp_sub \
	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
#define TclBN_mp_sub_d \
	(tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
#define TclBN_mp_to_unsigned_bin \
	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
#define TclBN_mp_to_unsigned_bin_n \
	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
#define TclBN_mp_toradix_n \
	(tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
#define TclBN_mp_ubin_size \
	(tclTomMathStubsPtr->tclBN_mp_ubin_size) /* 47 */
#define TclBN_mp_xor \
	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
#define TclBN_mp_zero \
	(tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */



#define TclBN_reverse \
	(tclTomMathStubsPtr->tclBN_reverse) /* 50 */
#define TclBN_s_mp_mul_digs_fast \
	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs_fast) /* 51 */
#define TclBN_s_mp_sqr_fast \
	(tclTomMathStubsPtr->tclBN_s_mp_sqr_fast) /* 52 */
#define TclBN_mp_karatsuba_mul \
	(tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
#define TclBN_mp_karatsuba_sqr \
	(tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
#define TclBN_mp_toom_mul \
	(tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
#define TclBN_mp_toom_sqr \
	(tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
#define TclBN_s_mp_add \
	(tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
#define TclBN_s_mp_mul_digs \
	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
#define TclBN_s_mp_sqr \
	(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
#define TclBN_s_mp_sub \
	(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
#define TclBN_mp_init_ul \
	(tclTomMathStubsPtr->tclBN_mp_init_ul) /* 61 */
#define TclBN_mp_set_ul \
	(tclTomMathStubsPtr->tclBN_mp_set_ul) /* 62 */
#define TclBN_mp_cnt_lsb \
	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */

#define TclBN_mp_init_l \
	(tclTomMathStubsPtr->tclBN_mp_init_l) /* 64 */
#define TclBN_mp_init_i64 \
	(tclTomMathStubsPtr->tclBN_mp_init_i64) /* 65 */
#define TclBN_mp_init_u64 \
	(tclTomMathStubsPtr->tclBN_mp_init_u64) /* 66 */
#define TclBN_mp_expt_d_ex \
	(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */
#define TclBN_mp_set_u64 \
	(tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */
#define TclBN_mp_get_mag_u64 \
	(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 */
#define TclBN_mp_tc_and \
	(tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */
#define TclBN_mp_tc_or \
	(tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */
#define TclBN_mp_tc_xor \
	(tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */
#define TclBN_mp_signed_rsh \
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */
/* Slot 77 is reserved */
#define TclBN_mp_to_ubin \
	(tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */
#define TclBN_mp_div_ld \
	(tclTomMathStubsPtr->tclBN_mp_div_ld) /* 79 */
#define TclBN_mp_to_radix \
	(tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#undef mp_add_d
#define mp_add_d TclBN_mp_add_d
#undef mp_cmp_d
#define mp_cmp_d TclBN_mp_cmp_d
#undef mp_div_d
#ifdef MP_64BIT
#define mp_div_d TclBN_mp_div_ld
#else
#define mp_div_d TclBN_mp_div_d
#endif
#undef mp_sub_d
#define mp_sub_d TclBN_mp_sub_d
#undef mp_init_set
#define mp_init_set TclBN_mp_init_set
#undef mp_mul_d
#define mp_mul_d TclBN_mp_mul_d
#undef mp_set
#define mp_set TclBN_mp_set
#undef mp_expt_u32
#define mp_expt_u32 TclBN_mp_expt_u32
#endif /* USE_TCL_STUBS */

#define TclBNInitBignumFromLong(a,b) \
	do { \
	    (a)->dp = NULL; \
	    (void)mp_init_i64((a),(b)); \
	    if ((a)->dp == NULL) { \
	    Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); \
	    } \
	} while (0)
#undef TclBNInitBignumFromWideInt
#define TclBNInitBignumFromWideInt(a,b) \
	do { \
	    (a)->dp = NULL; \
	    (void)mp_init_i64((a),(b)); \
	    if ((a)->dp == NULL) { \
	    Tcl_Panic("initialization failure in TclBNInitBignumFromWideInt"); \
	    } \
	} while (0)
#undef TclBNInitBignumFromWideUInt
#define TclBNInitBignumFromWideUInt(a,b) \
	do { \
	    (a)->dp = NULL; \
	    (void)mp_init_u64((a),(b)); \
	    if ((a)->dp == NULL) { \
	    Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); \
	    } \
	} while (0)
#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
Changes to generic/tclTrace.c.
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
};

/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t 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;







|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
};

/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    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;
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    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 ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    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.
	 */







|















|







198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptionsEnum {
	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 ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum traceOptionsEnum) 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.
	 */
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code;
	size_t numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	TclNewObj(opsList);







|
<







265
266
267
268
269
270
271
272

273
274
275
276
277
278
279
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code, numFlags;


	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	TclNewObj(opsList);
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
	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;
	    char *q = ops;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*q = 'r';







|







317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
	TclNewObj(resultListPtr);
	name = Tcl_GetString(objv[2]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
	    char *q = ops;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*q = 'r';
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
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;
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
    };
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {







|

|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
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 commandLength, index;
    const char *name, *command;
    size_t length;
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
    };
    static const char *const opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    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]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(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.
	     */

	    ClientData clientData;

	    /*
	     * 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;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *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)) {
		    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;
			Tcl_Free(tcmdPtr->startCmd);
		    }
		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
			/*
			 * Postpone deletion.
			 */

			tcmdPtr->flags = 0;
		    }
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	name = TclGetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    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
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    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 = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(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.
	     */

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *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,
				(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;
			ckfree(tcmdPtr->startCmd);
		    }
		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
			/*
			 * Postpone deletion.
			 */

			tcmdPtr->flags = 0;
		    }
		    if (tcmdPtr->refCount-- <= 1) {
			ckfree(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	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;
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
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;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };

    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {







|

|







645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
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 commandLength, index;
    const char *name, *command;
    size_t length;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };

    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
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
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    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]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(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.
	     */

	    ClientData clientData;

	    /*
	     * 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;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	/*
	 * 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);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;







|

|










|


|















|









|




|




















|







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
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    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 = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(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.
	     */

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if (tcmdPtr->refCount-- <= 1) {
			ckfree(tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	/*
	 * First ensure the name given is valid.
	 */

	name = Tcl_GetString(objv[3]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
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;
    ClientData clientData;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE







|

|







839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
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 commandLength, index;
    const char *name, *command;
    size_t length;
    ClientData clientData;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
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
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    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.flags = flags;
	    name = TclGetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		Tcl_Free(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.
	     */

	    name = TclGetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *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)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	Tcl_Obj *resultListPtr;

	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;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this







|

|















|


|









|










|


















|







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
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    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.flags = flags;
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		ckfree(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.
	     */

	    name = Tcl_GetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
						)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	TclNewObj(resultListPtr);
	name = Tcl_GetString(objv[3]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
	    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
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    tracePtr = (CommandTrace *)Tcl_Alloc(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;







|







1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    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;
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return;







|







1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return;
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
	cmdPtr->tracePtr = tracePtr->nextPtr;
    } else {
	prevPtr->nextPtr = tracePtr->nextPtr;
    }
    tracePtr->flags = 0;

    if (tracePtr->refCount-- <= 1) {
	Tcl_Free(tracePtr);
    }

    if (hasExecTraces) {
	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
		return;







|







1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
	cmdPtr->tracePtr = tracePtr->nextPtr;
    } else {
	prevPtr->nextPtr = tracePtr->nextPtr;
    }
    tracePtr->flags = 0;

    if (tracePtr->refCount-- <= 1) {
	ckfree(tracePtr);
    }

    if (hasExecTraces) {
	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
		return;
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
	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++;
	}
    }
}

/*
 *----------------------------------------------------------------------







<







1248
1249
1250
1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261
	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;

        /*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */

	if (cmdPtr->compileProc != NULL) {

	    iPtr->compileEpoch++;
	}
    }
}

/*
 *----------------------------------------------------------------------
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
	    && !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_DStringAppendElement(&cmd, oldName);
	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
	if (flags & TCL_TRACE_RENAME) {
	    TclDStringAppendLiteral(&cmd, " rename");
	} else if (flags & TCL_TRACE_DELETE) {
	    TclDStringAppendLiteral(&cmd, " delete");
	}







|







1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
	    && !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, (int) tcmdPtr->length);
	Tcl_DStringAppendElement(&cmd, oldName);
	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
	if (flags & TCL_TRACE_RENAME) {
	    TclDStringAppendLiteral(&cmd, " rename");
	} else if (flags & TCL_TRACE_DELETE) {
	    TclDStringAppendLiteral(&cmd, " delete");
	}
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
    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;
	    Tcl_Free(tcmdPtr->startCmd);
	}
	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	    /*
	     * Postpone deletion, until exec trace returns.
	     */

	    tcmdPtr->flags = 0;







|







1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
    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;
	    ckfree(tcmdPtr->startCmd);
	}
	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	    /*
	     * Postpone deletion, until exec trace returns.
	     */

	    tcmdPtr->flags = 0;
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckExecutionTraces --







|







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if (tcmdPtr->refCount-- <= 1) {
	ckfree(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckExecutionTraces --
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(size_t) /*numChars*/,
    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;







|







1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(int) /*numChars*/,
    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;
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
		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);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }







|







1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
		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) {
		    ckfree(tcmdPtr);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
 */

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







|







1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
 */

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    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. */
{
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    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
				 * source. */
    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;







|







1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    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. */
    int numChars,		/* The number of characters in the command's
				 * source. */
    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;
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionProc --







|







1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	ckfree(tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionProc --
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
	 */

	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;
	    Tcl_Free(tcmdPtr->startCmd);
	}

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd, sub;
	    int i, saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length);

	    /*
	     * Append command with arguments.
	     */

	    Tcl_DStringInit(&sub);
	    for (i = 0; i < objc; i++) {
		Tcl_DStringAppendElement(&sub, TclGetString(objv[i]));
	    }
	    Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
	    Tcl_DStringFree(&sub);

	    if (flags & TCL_TRACE_ENTER_EXEC) {
		/*
		 * Append trace operation.







|











|







|







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

	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;
	    ckfree(tcmdPtr->startCmd);
	}

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd, sub;
	    int i, saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);

	    /*
	     * Append command with arguments.
	     */

	    Tcl_DStringInit(&sub);
	    for (i = 0; i < objc; 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.
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
		const char *resultCodeStr;

		/*
		 * Append result code.
		 */

		TclNewIntObj(resultCode, code);
		resultCodeStr = TclGetString(resultCode);
		Tcl_DStringAppendElement(&cmd, resultCodeStr);
		Tcl_DecrRefCount(resultCode);

		/*
		 * Append result string.
		 */








|







1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
		const char *resultCodeStr;

		/*
		 * Append result code.
		 */

		TclNewIntObj(resultCode, code);
		resultCodeStr = Tcl_GetString(resultCode);
		Tcl_DStringAppendElement(&cmd, resultCodeStr);
		Tcl_DecrRefCount(resultCode);

		/*
		 * Append result string.
		 */

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

	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;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)Tcl_Alloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    Tcl_Free(tcmdPtr->startCmd);
	}
    }
    if (call) {
	if (tcmdPtr->refCount-- <= 1) {
	    Tcl_Free(tcmdPtr);
	}
    }
    return traceCode;
}

/*
 *----------------------------------------------------------------------







|











|




|







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

	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;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    ckfree(tcmdPtr->startCmd);
	}
    }
    if (call) {
	if (tcmdPtr->refCount-- <= 1) {
	    ckfree(tcmdPtr);
	}
    }
    return traceCode;
}

/*
 *----------------------------------------------------------------------
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
     * 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) {
	    /*
	     * 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_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");
		} else if (flags & TCL_TRACE_READS) {







|






|







1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
     * 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 != (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, (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");
		} else if (flags & TCL_TRACE_READS) {
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172

	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    tracePtr = (Trace *)Tcl_Alloc(sizeof(Trace));
    tracePtr->level = level;
    tracePtr->proc = proc;
    tracePtr->clientData = clientData;
    tracePtr->delProc = delProc;
    tracePtr->nextPtr = iPtr->tracePtr;
    tracePtr->flags = flags;
    iPtr->tracePtr = tracePtr;







|







2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170

	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    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;
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
    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));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}








|







2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
    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 *)ckalloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}

2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
     * 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 *));
    for (i = 0; i < objc; i++) {
	argv[i] = TclGetString(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.







|







2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
     * 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 *));
    for (i = 0; i < objc; 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.
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteTrace --
 *







|







2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    ckfree(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteTrace --
 *
2556
2557
2558
2559
2560
2561
2562



2563
2564
2565
2566
2567
2568
2569
    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
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */







>
>
>







2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
    part1 = TclGetString(part1Ptr);
    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;

    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

#undef TCL_INTERP_DESTROYED
#define TCL_INTERP_DESTROYED     0x100

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    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. */
2634
2635
2636
2637
2638
2639
2640







2641
2642
2643
2644
2645
2646
2647
		    copiedName = 1;
		}
		break;
	    }
	}
    }








    /*
     * Invoke traces on the array containing the variable, if relevant.
     */

    result = NULL;
    active.nextPtr = iPtr->activeVarTracePtr;
    iPtr->activeVarTracePtr = &active;







>
>
>
>
>
>
>







2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
		    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;
2655
2656
2657
2658
2659
2660
2661



2662
2663
2664
2665
2666
2667
2668
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);



	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.







>
>
>







2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
2696
2697
2698
2699
2700
2701
2702



2703
2704
2705
2706
2707
2708
2709
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);



	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.







>
>
>







2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *) iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772

	    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));
	    } else {
		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result);
	    }
	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
	    Tcl_DiscardInterpState(state);
	} else {
	    Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);







|







2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786

	    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,
			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);
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829



































2830
2831
2832
2833
2834
2835
2836
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);
    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
	Tcl_DecrRefCount((Tcl_Obj *) result);
    }
}




































/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceVar2 --
 *
 *	Remove a previously-created trace for a variable.
 *







|





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







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
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) {
	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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceVar2 --
 *
 *	Remove a previously-created trace for a variable.
 *
2956
2957
2958
2959
2960
2961
2962











































2963
2964
2965
2966
2967
2968
2969
	TclCleanupVar(varPtr, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *











































 * Tcl_VarTraceInfo2 --
 *
 *	Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
 *	one.
 *
 * Results:
 *	Same as Tcl_VarTraceInfo.







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







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

#ifndef TCL_NO_DEPRECATED
#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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarTraceInfo2 --
 *
 *	Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
 *	one.
 *
 * Results:
 *	Same as Tcl_VarTraceInfo.
3026
3027
3028
3029
3030
3031
3032









































3033
3034
3035
3036
3037
3038
3039
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *









































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







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







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

#ifndef TCL_NO_DEPRECATED
#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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceVar2 --
 *
 *	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:
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	Tcl_Free(tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *







|







|







3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	ckfree(tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
				 * 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
				 * clientData fields. Others should be left
				 * blank. Will be Tcl_Free()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;







|







3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
				 * 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
				 * clientData fields. Others should be left
				 * 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;
Changes to generic/tclUtf.c.
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
TclUtfCount(
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {







|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
    const int *uniStr,	/* Unicode string to convert to UTF-8. */
    size_t uniLength,		/* Length of Unicode string. */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const int *w, *wEnd;
    char *p, *string;
    size_t oldLength;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength == TCL_INDEX_NONE) {
	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }







|





|








|







310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
    const int *uniStr,	/* Unicode string to convert to UTF-8. */
    int uniLength,		/* Length of Unicode string. */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const int *w, *wEnd;
    char *p, *string;
    int oldLength;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength < 0) {
	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381

    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++;
	}







|





|
<








|







351
352
353
354
355
356
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380

    return string;
}

char *
Tcl_Char16ToUtfDString(
    const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
    int 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;
    int oldLength, len = 1;


    /*
     * UTF-8 string length in bytes will be <= Utf16 string length * 3.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength < 0) {

	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
 *	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.







|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
 *	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 <= 4, 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.
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
 *---------------------------------------------------------------------------
 */

#undef Tcl_UtfToUniCharDString
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
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    int 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 Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */







|







|








|







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

#undef Tcl_UtfToUniCharDString
int *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    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;
    const char *p;
    int 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 < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */
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

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







|







|








|




|







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

    return wString;
}

unsigned short *
Tcl_UtfToChar16DString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    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. */
{
    unsigned short ch = 0, *w, *wString;
    const char *p;
    int 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 < 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(unsigned short)));
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
 *---------------------------------------------------------------------------
 */

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. */
{
    return length >= complete[UCHAR(*src)];
}

/*
 *---------------------------------------------------------------------------
 *







|







785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    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
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
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). */
{
    Tcl_UniChar ch = 0;
    size_t i = 0;

    if (length == TCL_INDEX_NONE) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	    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] */







|


|
|


|

|

|







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
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    int length)		/* The length of the string in bytes, or -1
			 * for strlen(string). */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	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] */
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfNext(
    const char *src)		/* The current location in the string. */
{
    size_t left;
    const char *next;

    if (((*src) & 0xC0) == 0x80) {
	if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
	    ++src;
	}
	return src;







|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfNext(
    const char *src)		/* The current location in the string. */
{
    int left;
    const char *next;

    if (((*src) & 0xC0) == 0x80) {
	if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
	    ++src;
	}
	return src;
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (index == TCL_INDEX_NONE) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
#if TCL_UTF_MAX <= 3
    if ((ch >= 0xD800) && (i < 3)) {
	/* Index points at character following high Surrogate */
	return -1;







|




|


|







1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    int i = 0;

    if (index < 0) {
	return -1;
    }
    while (index-- > 0) {
	i = TclUtfToUniChar(src, &ch);
	src += i;
    }
#if TCL_UTF_MAX <= 3
    if ((ch >= 0xD800) && (i < 3)) {
	/* Index points at character following high Surrogate */
	return -1;
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
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    size_t index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
#if TCL_UTF_MAX <= 3
    size_t len = 0;
#endif

    if (index != TCL_INDEX_NONE) {
	while (index--) {
#if TCL_UTF_MAX <= 3
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    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 --







|


<
|
<

<
|
<
|
<
|
<
|






<







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

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;

    int len = 0;



    while (index-- > 0) {

	len = TclUtfToUniChar(src, &ch);

	src += len;

    }
#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 --
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
 *	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
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;


    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */








|









|
>







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

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
    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()
	 */

1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296

int
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    int ch, upChar;
    char *src, *dst;
    size_t len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {







|







1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289

int
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    int ch, upChar;
    char *src, *dst;
    int len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349

int
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    int ch, lowChar;
    char *src, *dst;
    size_t len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {







|







1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342

int
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    int ch, lowChar;
    char *src, *dst;
    int len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403

int
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    int ch, titleChar, lowChar;
    char *src, *dst;
    size_t len;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;







|







1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396

int
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    int ch, titleChar, lowChar;
    char *src, *dst;
    int len;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
 *----------------------------------------------------------------------
 */

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








|







1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
 *----------------------------------------------------------------------
 */

int
TclpUtfNcmp2(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    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
 *----------------------------------------------------------------------
 */

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. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

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







|







1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    /*
     * 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.)
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
 *----------------------------------------------------------------------
 */

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. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of







|







1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of
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
    /* Clear away extension bits, if any */
    return ch & 0x1FFFFF;
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharLen --
 *
 *	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(
    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
{
    size_t len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcmp --
 *
 *	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(
    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. */
{
#ifdef WORDS_BIGENDIAN
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));







|













|
|


|











|














|


|







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
    /* Clear away extension bits, if any */
    return ch & 0x1FFFFF;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniCharLen(
    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
{
    int len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * 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
Tcl_UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    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
    return 0;
#endif /* WORDS_BIGENDIAN */
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcasecmp --
 *
 *	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(
    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. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {







|















|


|







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
    return 0;
#endif /* WORDS_BIGENDIAN */
}

/*
 *----------------------------------------------------------------------
 *
 * 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
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    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) {
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
    }
    return ((WORD_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharCaseMatch --
 *
 *	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(
    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;







|




















|







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
    }
    return ((WORD_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * 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
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;
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
			}
		    } else {
			while (*uniStr && (p != *uniStr)) {
			    uniStr++;
			}
		    }
		}
		if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) {
		    return 1;
		}
		if (*uniStr == 0) {
		    return 0;
		}
		uniStr++;
	    }







|







2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
			}
		    } else {
			while (*uniStr && (p != *uniStr)) {
			    uniStr++;
			}
		    }
		}
		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
/*
 *----------------------------------------------------------------------
 *
 * 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
 *	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 */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    size_t 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;







|
















|


|







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
/*
 *----------------------------------------------------------------------
 *
 * 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 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. */
    int strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    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;
Changes to generic/tclUtil.c.
90
91
92
93
94
95
96







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#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








/*
 * 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,
			    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
 * for it. This is a caching intrep, keeping the result of a parse







>
>
>
>
>
>
>















|







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#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,
			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, int *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
 * for it. This is a caching intrep, keeping the result of a parse
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    size_t numBytes,
    const char **endPtr)
{
    size_t count = 0;

    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
     * No list element before leading white space.
     */

    count += 1 - TclIsSpaceProcM(*bytes);

    /*
     * Count white space runs as potential element separators.
     */

    while (numBytes) {
	if ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProcM(*bytes)) {
	    /*
	     * Space run started; bump count.
	     */

	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != TCL_INDEX_NONE);
	    } while (numBytes && TclIsSpaceProcM(*bytes));
	    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
		break;
	    }

	    /*
	     * (*bytes) is non-space; return to counting state.
	     */
	}
	bytes++;
	numBytes -= (numBytes != TCL_INDEX_NONE);
    }

    /*
     * No list element following trailing white space.
     */

    count -= TclIsSpaceProcM(bytes[-1]);







|


|

|















|










|

|








|







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    int numBytes,
    const char **endPtr)
{
    int count = 0;

    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
     * No list element before leading white space.
     */

    count += 1 - TclIsSpaceProcM(*bytes);

    /*
     * Count white space runs as potential element separators.
     */

    while (numBytes) {
	if ((numBytes == -1) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProcM(*bytes)) {
	    /*
	     * Space run started; bump count.
	     */

	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != -1);
	    } while (numBytes && TclIsSpaceProcM(*bytes));
	    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
		break;
	    }

	    /*
	     * (*bytes) is non-space; return to counting state.
	     */
	}
	bytes++;
	numBytes -= (numBytes != -1);
    }

    /*
     * No list element following trailing white space.
     */

    count -= TclIsSpaceProcM(bytes[-1]);
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
				 * elements (possibly in braces). */
    int listLength,		/* Number of bytes in the list's string. */
    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
				 * 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
				 * 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. */







|







502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
				 * elements (possibly in braces). */
    int listLength,		/* Number of bytes in the list's string. */
    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
				 * after all white space following end of
				 * argument (next arg or end of list). */
    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. */
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
    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. */







|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
    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). */
    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 key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
    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. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;
    size_t numChars;
    int literal = 1;
    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).







|














|







563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
    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). */
    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/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. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;
    int numChars;
    int literal = 1;
    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).
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclCopyAndCollapse(
    size_t count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    size_t newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    size_t numRead;
	    size_t backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;







|

|



|





|
|







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclCopyAndCollapse(
    int count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    int newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    int numRead;
	    int backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;
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
    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
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int length, size, i, result;
    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.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = (const char **)Tcl_Alloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	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);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    Tcl_Free((void *)argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;







|
<











|










|






|







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
    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
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    char *p;
    int length, size, i, result, 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.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = (const char **)ckalloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &literal);
	length -= (list - prevList);
	if (result != TCL_OK) {
	    ckfree(argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    ckfree(argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
	    }
	    return TCL_ERROR;
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, -1, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *







|



|







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
				 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, -1, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    int numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;







|


|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ScanCountedElement(
    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 numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
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
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * 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
				 * 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 */

    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == TCL_INDEX_NONE))) {
	/*
	 * Empty string element must be brace quoted.
	 */

	*flagPtr = CONVERT_BRACE;
	return 2;
    }







|


|












|







|







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * 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. */
    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 */

    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
	/*
	 * Empty string element must be brace quoted.
	 */

	*flagPtr = CONVERT_BRACE;
	return 2;
    }
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		 */

		requireEscape = 1;
		break;
	    }







|







1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		 */

		requireEscape = 1;
		break;
	    }
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
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == TCL_INDEX_NONE) {
		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);
	p++;
    }

  endOfString:
    if (nestingLevel != 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.







|















|







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
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
	    break;
	case '\0':	/* TYPE_SUBS */
	    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 > 0);
	p++;
    }

  endOfString:
    if (nestingLevel != 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
	 * Make room to escape leading #, if needed.
	 */

	if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	return bytesNeeded;
    }
    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







|







1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
	 * Make room to escape leading #, if needed.
	 */

	if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	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
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
	     * escape the braces.
	     */

	    if (*flagPtr & TCL_DONT_USE_BRACES) {
		bytesNeeded += braceCount;
	    }
	    *flagPtr = CONVERT_MASK;
	    return bytesNeeded;
	}
#endif /* COMPAT */
	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.
	     */







|







1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
	     * escape the braces.
	     */

	    if (*flagPtr & TCL_DONT_USE_BRACES) {
		bytesNeeded += braceCount;
	    }
	    *flagPtr = CONVERT_MASK;
	    goto overflowCheck;
	}
#endif /* COMPAT */
	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.
	     */
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
	    /*
	     * Add 2 bytes for room for the enclosing braces.
	     */

	    bytesNeeded += 2;
	}
	*flagPtr = CONVERT_BRACE;
	return bytesNeeded;
    }

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

	bytesNeeded += 2;
    }
    *flagPtr = CONVERT_NONE;





    return bytesNeeded;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConvertElement --







|














>
>
>
>
>







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
	    /*
	     * Add 2 bytes for room for the enclosing braces.
	     */

	    bytesNeeded += 2;
	}
	*flagPtr = CONVERT_BRACE;
	goto overflowCheck;
    }

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

	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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
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. */
{
    return Tcl_ConvertCountedElement(src, -1, dst, flags);
}







|







1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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. */
{
    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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
Tcl_ConvertCountedElement(
    const char *src,	/* Source information for list element. */
    size_t 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);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *







|


|



|







1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ConvertCountedElement(
    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 numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclConvertElement(
    const char *src,	/* Source information for list element. */
    size_t 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.
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * 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;
    }

    /*
     * 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);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
     */

    if (conversion == CONVERT_NONE) {
	if (length == TCL_INDEX_NONE) {
	    /* 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.
     */

    if (conversion == CONVERT_BRACE) {
	*p = '{';
	p++;
	if (length == TCL_INDEX_NONE) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return (size_t)(p - dst);
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length+1 > 1)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':







|


|


















|















|










|


















|










|








|







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclConvertElement(
    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.
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
	p[0] = '{';
	p[1] = '}';
	return 2;
    }

    /*
     * 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 > 0);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
     */

    if (conversion == CONVERT_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.
     */

    if (conversion == CONVERT_BRACE) {
	*p = '{';
	p++;
	if (length == -1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return p - dst;
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
     */

    for ( ; length; src++, length -= (length > 0)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':
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
	case '\v':
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == TCL_INDEX_NONE) {
		return (size_t)(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().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return (size_t)(p - dst);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *







|
|















|







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
	case '\v':
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    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().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return p - dst;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *
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
char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    int i;
    size_t bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = (char *)Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)Tcl_Alloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);






    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = (char *)Tcl_Alloc(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);
    }
    return result;
}





































/*
 *----------------------------------------------------------------------
 *
 * 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
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    size_t 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 */
			/* 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.
     */

    do {
	const char *q = trim;
    size_t pInc = 0, bytesLeft = numTrim;

	pp = TclUtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
	} while (pp + pInc < p);

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    size_t qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;







<
|








|











|




>
>
>
>
>
>







|










|



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


















|


|



|

















|












|







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
char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;

    int i, bytesNeeded = 0;
    char *result, *dst;

    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = (char *)ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = (char *)ckalloc(argc);
    }
    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 *)ckalloc(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) {
	ckfree(flagPtr);
    }
    return result;
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 *----------------------------------------------------------------------
 *
 * 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[4] = "";
    Tcl_UniChar ch = 0;

    Tcl_UtfBackslash(src, readPtr, buf);
    TclUtfToUniChar(buf, &ch);
    return (char) ch;
}
#endif /* !TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    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... */
    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.
     */

    do {
	const char *q = trim;
	int pInc = 0, bytesLeft = numTrim;

	pp = TclUtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
	} while (pp + pInc < p);

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    int qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    size_t 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 */
			/* 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.
     */

    do {
	size_t pInc = TclUtfToUCS4(p, &ch1);
	const char *q = trim;
	size_t bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    size_t qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;







|


|



|
















|

|






|







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    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... */
    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.
     */

    do {
	int pInc = TclUtfToUCS4(p, &ch1);
	const char *q = trim;
	int bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	 */

	do {
	    int qInc = TclUtfToUCS4(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    size_t 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 */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    size_t *trimRightPtr)	/* Offset from the end of the string. */
{
    size_t 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;







|


|



|


|

|







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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    int numBytes,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    int numTrim,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    int *trimRightPtr)	/* Offset from the end of the string. */
{
    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;
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
 *	Memory is allocated for the result; the caller is responsible for
 *	freeing the memory.
 *
 *----------------------------------------------------------------------
 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    int argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{
    int i;
    size_t needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) Tcl_Alloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);











    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = (char *)Tcl_Alloc(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	size_t 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,







|






<
|







|










>
>
>
>
>
>
>
>
>
>
>






|


|







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
 *	Memory is allocated for the result; the caller is responsible for
 *	freeing the memory.
 *
 *----------------------------------------------------------------------
 */

/* The whitespace characters trimmed during [concat] operations */
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)

char *
Tcl_Concat(
    int argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
{

    int i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
     */

    if (argc == 0) {
	result = (char *) ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * 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");
	}
    }
    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(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	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,
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
 */

Tcl_Obj *
Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{
    int i, needSpace = 0;
    size_t bytesNeeded = 0, elemLength;
    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;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	(void)TclGetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {







<
|










|





|







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

Tcl_Obj *
Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
{

    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++) {
	int length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	TclGetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
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
     *
     * First try to pre-allocate the size required.
     */

    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);
	bytesNeeded += elemLength;



    }

    /*
     * 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_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	size_t triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;







>
>
>













|







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

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	int triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
		CONCAT_WS_SIZE, &trimr);
	element += triml;
2038
2039
2040
2041
2042
2043
2044





























2045
2046
2047
2048
2049
2050
2051
	}
	Tcl_AppendToObj(resPtr, element, elemLength);
	needSpace = 1;
    }
    return resPtr;
}






























/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringCaseMatch --
 *
 *	See if a particular string matches a particular pattern. Allows case
 *	insensitivity.







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







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
	}
	Tcl_AppendToObj(resPtr, element, elemLength);
	needSpace = 1;
    }
    return resPtr;
}

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_StringMatch
int
Tcl_StringMatch(
    const char *str,		/* String. */
    const char *pattern)	/* Pattern, which may contain special
				 * characters. */
{
    return Tcl_StringCaseMatch(str, pattern, 0);
}
#endif /* TCL_NO_DEPRECATED */
/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringCaseMatch --
 *
 *	See if a particular string matches a particular pattern. Allows case
 *	insensitivity.
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    size_t strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;







|



|







2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    int strLen,			/* Length of String */
    const unsigned char *pattern,
				/* Pattern, which may contain special
				 * characters. */
    int ptnLen,			/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
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
int
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match;
    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)) {
	Tcl_UniChar *udata, *uptn;

	udata = TclGetUnicodeFromObj(strObj, &length);
	uptn  = TclGetUnicodeFromObj(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);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
		TclGetString(ptnObj), flags);
    }
    return match;
}







|
<











|
|





|
|







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
int
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
				 * 0. */
{
    int match, length, plen;


    /*
     * 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)) {
	Tcl_UniChar *udata, *uptn;

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

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
				 * at end. */
{
    size_t newSize;

    if (length == TCL_INDEX_NONE) {
	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);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t index = TCL_INDEX_NONE;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		index = bytes - dsPtr->string;
	    }

	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);

	    if (index != TCL_INDEX_NONE) {
		bytes = dsPtr->string + index;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */







|
|
|
|


|

|













|




|




|


|

|
|







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

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    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. */
{
    int newSize;

    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 *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *bytes = TclGetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,







|
|







2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    int length;
    char *bytes = TclGetStringFromObj(objPtr, &length);

    return Tcl_DStringAppend(dsPtr, bytes, length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    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;
    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.
	 */







|
<







2758
2759
2760
2761
2762
2763
2764
2765

2766
2767
2768
2769
2770
2771
2772
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    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, 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
     * 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);

	    memcpy(newString, dsPtr->string, 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);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;







|












|







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
     * 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 *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, 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 *)ckrealloc(dsPtr->string, 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
 *	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.

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

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    size_t length)			/* New length for dynamic string. */
{
    size_t newsize;




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

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*







|
>







|

|

>
>
>




















|




|







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
 *	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. If length is larger than the space
 *	allocated for dsPtr, then a panic occurs.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    int length)			/* New length for dynamic string. */
{
    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 *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
 */

void
Tcl_DStringFree(
    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	Tcl_Free(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}








|







2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
 */

void
Tcl_DStringFree(
    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}

2889
2890
2891
2892
2893
2894
2895

2896
2897
2898
2899
2900
2901









































































2902
2903
2904
2905
2906
2907
2908

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);
    char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);









































































}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *







>

|




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







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

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. */
{
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    const char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
#else
    Interp *iPtr = (Interp *) interp;

    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }

    /*
     * Do more efficient transfer when we know the result is a Tcl_Obj. When
     * there's no string result, we only have to deal with two cases:
     *
     *  1. When the string rep is the empty string, when we don't copy but
     *     instead use the staticSpace in the DString to hold an empty string.

     *  2. When the string rep is not there or there's a real string rep, when
     *     we use Tcl_GetString to fetch (or generate) the string rep - which
     *     we know to have been allocated with ckalloc() - and use it to
     *     populate the DString space. Then, we free the internal rep. and set
     *     the object's string representation back to the canonical empty
     *     string.
     */

    if (!iPtr->result[0] && iPtr->objResultPtr
	    && !Tcl_IsShared(iPtr->objResultPtr)) {
	if (iPtr->objResultPtr->bytes == &tclEmptyString) {
	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->string[0] = 0;
	    dsPtr->length = 0;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = TclGetString(iPtr->objResultPtr);
	    dsPtr->length = iPtr->objResultPtr->length;
	    dsPtr->spaceAvl = dsPtr->length + 1;
	    TclFreeIntRep(iPtr->objResultPtr);
	    iPtr->objResultPtr->bytes = &tclEmptyString;
	    iPtr->objResultPtr->length = 0;
	}
	return;
    }

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    (void) Tcl_GetStringResult(interp);

    dsPtr->length = strlen(iPtr->result);
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    dsPtr->string = iPtr->result;
	    dsPtr->spaceAvl = dsPtr->length+1;
	} else {
	    dsPtr->string = (char *)ckalloc(dsPtr->length+1);
	    memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
	    iPtr->freeProc(iPtr->result);
	}
	dsPtr->spaceAvl = dsPtr->length+1;
	iPtr->freeProc = NULL;
    } else {
	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = (char *)ckalloc(dsPtr->length+1);
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif /* !TCL_NO_DEPRECATED */
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *
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
 *
 * 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.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_PrintDouble(
    TCL_UNUSED(Tcl_Interp *),
    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;


    /*
     * Handle NaN.
     */

    if (TclIsNaN(value)) {
	TclFormatNaN(value, dst);







|
>
|
|



















>







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
 *
 * 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 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 *),
    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;
    int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * Handle NaN.
     */

    if (TclIsNaN(value)) {
	TclFormatNaN(value, dst);
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
	return;
    }

    /*
     * Ordinary (normal and denormal) values.
     */


    digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
	    &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);



    } else {
	/*
	 * F format for others.
	 */

	if (exponent < 0) {
	    *dst++ = '0';







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



















>
>
>
>
>
>
|
>
>
>







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
	return;
    }

    /*
     * Ordinary (normal and denormal) values.
     */

    if (*precisionPtr == 0) {
	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_SHORTEST 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_SHORTEST */,
		&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;
	    }
	}

	/*
	 * 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
3141
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}
	*dst++ = '\0';
    }
    Tcl_Free(digits);
}
















































































/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *
 *	This function checks to see whether it is appropriate to add a space







|

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







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
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}
	*dst++ = '\0';
    }
    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.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
char *
TclPrecTraceProc(
    ClientData clientData,
    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;
    Tcl_WideInt prec;
    int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, 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_NewWideIntObj(*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 (char *) "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetWideIntFromObj(NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return (char *) "improper value for precision";
    }
    *precisionPtr = (int)prec;
    return NULL;
}
#endif /* !TCL_NO_DEPRECATED)*/

/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *
 *	This function checks to see whether it is appropriate to add a space
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260

3261
3262
3263
3264
3265
3266
3267
3268
 * Side effects:
 *	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
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
    Tcl_WideUInt intVal;

    size_t i = 0, numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);







|





|
>
|







3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

int
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
{
	Tcl_WideUInt intVal;
    int i = 0;
    int numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
 *
 *----------------------------------------------------------------------
 */

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







|
|


|







3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
 *
 *----------------------------------------------------------------------
 */

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);
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
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntForIndex(
    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
				 * "objPtr" holds "end". */
    size_t *indexPtr)		/* Location filled in with an integer
				 * representing an index. */
{
    Tcl_WideInt wide;

    /* 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;
	} else if ((Tcl_WideUInt)wide > TCL_INDEX_END) {
	    *indexPtr = TCL_INDEX_END;


	} else {
	    *indexPtr = (size_t) wide;
	}
    }
    return TCL_OK;
}
/*
 *----------------------------------------------------------------------
 *







|
|
|

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

|
<
|
|











|

|
|



<
<
|



|
|
|
|
>
>

|







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
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *
 *	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
 *	format integer([+-]integer)? or the format end([+-]integer)?.
 *
 * Results:
 *	The return value is normally TCL_OK, which means that the index was

 *	successfully stored into the location referenced by "indexPtr". If the
 *	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,
 *	an error message is left in the interpreter's result object.

 *
 * Side effects:

 *	The object referenced by "objPtr" might be converted to an integer,
 *	wide integer, or end-based-index object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntForIndex(
    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. */
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. May be NULL.*/
{
    Tcl_WideInt wide;



    if (GetWideForIndex(interp, objPtr, (size_t)(endValue + 1) - 1, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (indexPtr != NULL) {
	if ((wide < 0) && (endValue > TCL_INDEX_END)) {
	    *indexPtr = -1;
	} else if (wide > INT_MAX) {
	    *indexPtr = INT_MAX;
	} else if (wide < INT_MIN) {
	    *indexPtr = INT_MIN;
	} else {
	    *indexPtr = (int) wide;
	}
    }
    return TCL_OK;
}
/*
 *----------------------------------------------------------------------
 *
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
{
    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);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int length, t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

	    /* If we reach here, the string rep of objPtr exists. */

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

	    /*
	     * Quick scan to see if multi-value list is even possible.
	     * This relies on TclGetString() returning a NUL-terminated string.
	     */
	    if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)

		    /* If it's possible, do the full list parse. */
	            && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
	            && (length > 1)) {
	        goto parseError;
	    }








|





|
















|







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
{
    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;
	int length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
	    int numType;
	    const char *opPtr;
	    int t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

	    /* If we reach here, the string rep of objPtr exists. */

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

	    /*
	     * 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, &length))
	            && (length > 1)) {
	        goto parseError;
	    }

3662
3663
3664
3665
3666
3667
3668

3669
3670
3671
3672
3673
3674
3675
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad index \"%s\": must be integer?[+-]integer? or"
                " end?[+-]integer?", bytes));
        if (!strncmp(bytes, "end-", 4)) {
            bytes += 4;
        }

        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }

    return TCL_ERROR;
}

/*







>







3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad index \"%s\": must be integer?[+-]integer? or"
                " end?[+-]integer?", bytes));
        if (!strncmp(bytes, "end-", 4)) {
            bytes += 4;
        }
        TclCheckBadOctal(interp, bytes);
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
    }

    return TCL_ERROR;
}

/*
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
 *----------------------------------------------------------------------
 */

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







|
|







4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
 *----------------------------------------------------------------------
 */

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    int before,		/* Value to return for index before beginning */
    int 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);
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
	 */
	if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
	    /*
	     * All end+postive or end-negative expressions
	     * always indicate "after the end".
	     */
	    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 {







|







4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
	 */
	if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
	    /*
	     * All end+postive or end-negative expressions
	     * always indicate "after the end".
	     */
	    idx = after;
	} else if (wide <= (irPtr ? INT_MAX : TCL_INDEX_NONE)) {
	    /* These indices always indicate "before the beginning */
	    idx = before;
	} else {
	    /* Encoded end-positive (or end+negative) are offset */
	    idx = (int)wide;
	}
    } else {
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
 *
 * Results:
 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

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

    if (endValue >= TCL_INDEX_END - encoded) {
	return endValue + encoded - TCL_INDEX_END;
    }
    return TCL_INDEX_NONE;
}




































































/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
 *	Remove all the entries in the hash table *tablePtr.







|


|

|


>
|
|



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







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
 *
 * Results:
 *	The decoded index value.
 *
 *----------------------------------------------------------------------
 */

int
TclIndexDecode(
    int encoded,	/* Value to decode */
    int endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > TCL_INDEX_END) {
	return encoded;
    }
    endValue += encoded - TCL_INDEX_END;
    if (endValue >= 0) {
	return endValue;
    }
    return TCL_INDEX_NONE;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckBadOctal --
 *
 *	This function checks for a bad octal value and appends a meaningful
 *	error to the interp's result.
 *
 * Results:
 *	1 if the argument was a bad octal, else 0.
 *
 * Side effects:
 *	The interpreter's result is modified.
 *
 *----------------------------------------------------------------------
 */

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. */
{
    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_AppendToObj(Tcl_GetObjResult(interp),
			" (looks like invalid octal number)", -1);
	    }
	    return 1;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
 *	Remove all the entries in the hash table *tablePtr.
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*







|







4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    Tcl_Free(tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessGlobalValue --
 *







|







4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessGlobalValue --
 *
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    Tcl_Free(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
	pgvPtr->encoding = NULL;
    }
    Tcl_MutexFinalize(&pgvPtr->mutex);
}







|







4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    ckfree(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
	pgvPtr->encoding = NULL;
    }
    Tcl_MutexFinalize(&pgvPtr->mutex);
}
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955

    /*
     * Fill the global string value.
     */

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	Tcl_Free(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*







|





|







4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324

    /*
     * Fill the global string value.
     */

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
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
Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    size_t 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
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    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);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {







|




















|
|







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
Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    unsigned 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
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    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);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = (char *)ckalloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
4145
4146
4147
4148
4149
4150
4151

























4152
4153
4154
4155
4156
4157
4158
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------
 *

























 * TclGetPlatform --
 *
 *	This is a kludge that allows the test library to get access the
 *	internal tclPlatform variable.
 *
 * Results:
 *	Returns a pointer to the tclPlatform variable.







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







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
    }
    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"
 *
 *----------------------------------------------------------------------
 */

void
TclpGetTime(
    Tcl_Time *timePtr)
{
    Tcl_GetTime(timePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetPlatform --
 *
 *	This is a kludge that allows the test library to get access the
 *	internal tclPlatform variable.
 *
 * Results:
 *	Returns a pointer to the tclPlatform variable.
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
 *----------------------------------------------------------------------
 */

int
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    size_t reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr,
    int *quantifiersFoundPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;







|







4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
 *----------------------------------------------------------------------
 */

int
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    int reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr,
    int *quantifiersFoundPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;
Changes to generic/tclVar.c.
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    Tcl_DeleteHashTable(&(tablePtr)->table)

/*
 * 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 =
	"upvar refers to element in deleted array";
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 =
	"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.
 */








|
|
|
|
|

|

|
|
|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    Tcl_DeleteHashTable(&(tablePtr)->table)

/*
 * 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[] =
	"upvar refers to element in deleted array";
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[] =
	"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.
 */

338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
}

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







|







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
}

static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = Tcl_GetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
    return TCL_ERROR;
}

380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

void







|









|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    ckfree(varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    ckfree(arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

void
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
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify
		 * a part2.
		 */

		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    part2Ptr = elem;
	    part1Ptr = arrayPtr;
	    goto restart;
    }

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	size_t len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				needArray, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}

		arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));







|














|









|







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
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify
		 * a part2.
		 */

		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    NOSUCHVAR, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    part2Ptr = elem;
	    part1Ptr = arrayPtr;
	    goto restart;
    }

    if (!parsed) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	int len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				NEEDARRAY, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}

		arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
    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;
    size_t varLen;
    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {







|
<







842
843
844
845
846
847
848
849

850
851
852
853
854
855
856
    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, varLen;

    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
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
		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {

	    flags = (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);
	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.
	     */

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







>
|
>
>
|
>














|










|


|







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
		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    if (flags & TCL_AVOID_RESOLVERS) {
		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);
	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.
	     */

	    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;
	    }
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
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    size_t localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = (TclVarHashTable *)Tcl_Alloc(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;
	    }
	}
    }
    return varPtr;
}

/*







|


















|










|







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
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    int localLen;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		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;
	    }
	}
    }
    return varPtr;
}

/*
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
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			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);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclInitArrayVar(arrayPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}
	return NULL;
    }








|














|









|







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
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			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);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclInitArrayVar(arrayPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}
	return NULL;
    }

1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143













































1144
1145
1146
1147
1148
1149
1150
	    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);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), NULL);
	    }
	}
    }
    return varPtr;
}














































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2 --
 *
 *	Return the value of a Tcl variable as a string, given a two-part name
 *	consisting of array name and element within array.







|








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







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
	    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);
		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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#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. */
{
    Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1);
    Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);

    TclDecrRefCount(varNamePtr);

    if (resultPtr == NULL) {
	return NULL;
    }
    return TclGetString(resultPtr);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2 --
 *
 *	Return the value of a Tcl variable as a string, given a two-part name
 *	consisting of array name and element within array.
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
	    return avhtPtr->defaultObj;
	}
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = isArray;
	} else {
	    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.







|

|

|







1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
	    return avhtPtr->defaultObj;
	}
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = NOSUCHELEMENT;
	} else if (TclIsVarArray(varPtr)) {
	    msg = ISARRAY;
	} else {
	    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.
1502
1503
1504
1505
1506
1507
1508















































1509
1510
1511
1512
1513
1514
1515
	return TCL_OK;
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
	return TCL_ERROR;
    }
}
















































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar2 --
 *
 *	Given a two-part variable name, which may refer either to a scalar
 *	variable or an element of an array, change the value of the variable.







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







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

#ifndef TCL_NO_DEPRECATED
#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. */
{
    Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, varName, NULL,
	    Tcl_NewStringObj(newValue, -1), flags);

    if (varValuePtr == NULL) {
	return NULL;
    }
    return TclGetString(varValuePtr);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar2 --
 *
 *	Given a two-part variable name, which may refer either to a scalar
 *	variable or an element of an array, change the value of the variable.
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
     * allocation and is meaningless anyway).
     */

    if (TclIsVarDeadHash(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    if (TclIsVarArrayElement(varPtr)) {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			danglingElement, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
	    } else {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			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);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	}
	goto earlyError;
    }

    /*
     * Invoke any read traces that have been set for the variable if it is







|



|












|







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
     * allocation and is meaningless anyway).
     */

    if (TclIsVarDeadHash(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    if (TclIsVarArrayElement(varPtr)) {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGELEMENT, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
	    } else {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			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);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	}
	goto earlyError;
    }

    /*
     * Invoke any read traces that have been set for the variable if it is
2257
2258
2259
2260
2261
2262
2263



















































2264
2265
2266
2267
2268
2269
2270
	}
    }
}

/*
 *----------------------------------------------------------------------
 *



















































 * Tcl_UnsetVar2 --
 *
 *	Delete a variable, given a 2-part name.
 *
 * 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







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







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

#ifndef TCL_NO_DEPRECATED
#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. */
{
    int result;
    Tcl_Obj *varNamePtr;

    varNamePtr = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(varNamePtr);

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
    result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags);

    Tcl_DecrRefCount(varNamePtr);
    return result;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnsetVar2 --
 *
 *	Delete a variable, given a 2-part name.
 *
 * 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
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
    /*
     * 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);
	}
    }

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







|







2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
    /*
     * 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);
	}
    }

    /*
     * 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
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
	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.
     */








|







3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
	/*
	 * 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;
}








|







3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
	/*
	 * 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);
	ckfree(searchPtr);
    }

    TclDecrRefCount(varListObj);
    TclDecrRefCount(scriptObj);
    return result;
}

3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
	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;
}

/*
 *----------------------------------------------------------------------







|







3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
    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 --







|







3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    Tcl_DecrRefCount(searchPtr->name);
    ckfree(searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayExistsCmd --
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const 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)) {







|







3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum arrayNamesOptionsEnum { 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)) {
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
	    continue;
	}
	nameObj = VarHashGetKey(varPtr2);
	if (patternObj) {
	    const char *name = TclGetString(nameObj);
	    int matched = 0;

	    switch ((enum options) 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);







|







3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
	    continue;
	}
	nameObj = VarHashGetKey(varPtr2);
	if (patternObj) {
	    const char *name = TclGetString(nameObj);
	    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);
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
	    /*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);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), NULL);
	return TCL_ERROR;
    }

    /*
     * Install the contents of the dictionary or list into the array.







|







4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
	    /*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);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), NULL);
	return TCL_ERROR;
    }

    /*
     * Install the contents of the dictionary or list into the array.
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclInitArrayVar(varPtr);
    return TCL_OK;
}







|







4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    NEEDARRAY, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclInitArrayVar(varPtr);
    return TCL_OK;
}
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
    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 --







|







4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
    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));
    ckfree(stats);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayUnsetCmd --
4649
4650
4651
4652
4653
4654
4655

























































4656
4657
4658
4659
4660
4661
4662
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

























































 * 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







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







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
    }
    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 localNameStr, so that references to
 *	localNameStr are redirected to the other variable like a symbolic
 *	link.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#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 *localNameStr,	/* Name of link variable. */
    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of localNameStr. */
{
    int result;
    CallFrame *framePtr;
    Tcl_Obj *varNamePtr, *localNamePtr;

    if (TclGetFrame(interp, frameName, &framePtr) == -1) {
	return TCL_ERROR;
    }

    varNamePtr = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(varNamePtr);
    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
    Tcl_IncrRefCount(localNamePtr);

    result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0,
	    localNamePtr, flags, -1);
    Tcl_DecrRefCount(varNamePtr);
    Tcl_DecrRefCount(localNamePtr);
    return result;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * 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
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
	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);
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
	    return TCL_ERROR;
	}

	if (varPtr == NULL) {
	    return TCL_ERROR;
	}







|







5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
	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);
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
	    return TCL_ERROR;
	}

	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    Tcl_Free(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*







|







5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    ckfree(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
	}
    }

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







<
<
<
<







5976
5977
5978
5979
5980
5981
5982




5983
5984
5985
5986
5987
5988
5989
	}
    }

    /*
     * Find the namespace(s) that contain the variable.
     */





    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.
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = (Var *)Tcl_Alloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;







|







6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = (Var *)ckalloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;
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
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	Tcl_Free(varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    size_t 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;
     */







|










|





|







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
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	ckfree(varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    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;
     */
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
    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 options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray, option;

    /*
     * Parse arguments.
     */







|







6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
    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;

    /*
     * Parse arguments.
     */
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    switch (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);







|







6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    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);
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
	if (arrayPtr) {
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
	    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;
	}

	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
	}







|










|







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
	if (arrayPtr) {
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
	    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;
	}

	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
	}
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);








|







6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)ckalloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);

6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
    SetArrayDefault(arrayPtr, NULL);

    /*
     * Regular TclVarHashTable cleanup.
     */

    VarHashDeleteTable(arrayPtr->value.tablePtr);
    Tcl_Free(tablePtr);
}

/*
 * Get array default value if any.
 */

Tcl_Obj *







|







6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
    SetArrayDefault(arrayPtr, NULL);

    /*
     * Regular TclVarHashTable cleanup.
     */

    VarHashDeleteTable(arrayPtr->value.tablePtr);
    ckfree(tablePtr);
}

/*
 * Get array default value if any.
 */

Tcl_Obj *
Changes to generic/tclZipfs.c.
328
329
330
331
332
333
334




335
336
337
338
339
340
341
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);








>
>
>
>







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
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);
#ifndef TCL_NO_DEPRECATED
static int		ZipChannelSeek(void *instanceData, long offset,
			    int mode, int *errloc);
#endif
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);

380
381
382
383
384
385
386
387
388
389



390

391
392
393
394
395
396
397
398
399
400
401
402






403
404
405
406
407
408
409
/*
 * 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







|


>
>
>

>












>
>
>
>
>
>







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
/*
 * The channel type/driver definition used for ZIP archive members.
 */

static Tcl_ChannelType ZipChannelType = {
    "zip",		    /* Type name. */
    TCL_CHANNEL_VERSION_5,
    TCL_CLOSE2PROC,	    /* Close channel, clean instance data */
    ZipChannelRead,	    /* Handle read request */
    ZipChannelWrite,	    /* Handle write request */
#ifndef TCL_NO_DEPRECATED
    ZipChannelSeek,	    /* Move location of access point, NULL'able */
#else
	NULL,	    /* Move location of access point, NULL'able */
#endif
    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 */
};

/*
 * Miscellaneous constants.
 */

#define ERROR_LENGTH	((size_t) -1)

/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861

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







|




|







856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875

static void
ZipFSCloseArchive(
    Tcl_Interp *interp,		/* Current interpreter. */
    ZipFile *zf)
{
    if (zf->nameLength) {
	ckfree(zf->name);
    }
    if (zf->isMemBuffer) {
	/* Pointer to memory */
	if (zf->ptrToFree) {
	    ckfree(zf->ptrToFree);
	    zf->ptrToFree = NULL;
	}
	zf->data = NULL;
	return;
    }

#ifdef _WIN32
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
    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;
    }
}

/*
 *-------------------------------------------------------------------------
 *







|



|







884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
    if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
	munmap(zf->data, zf->length);
	zf->data = (unsigned char *)MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	ckfree(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
    if (zf->chan) {
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    }
}

/*
 *-------------------------------------------------------------------------
 *
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
    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);







|















|












|







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
    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 == ERROR_LENGTH) {
	    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 *)attemptckalloc(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_Close(interp, zf->chan);
	zf->chan = NULL;
    } else {
#ifdef _WIN32
	int readSuccessful;
#   ifdef _WIN64
	i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
	readSuccessful = (i != 0);
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
		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) {







|







1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
		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 == ERROR_LENGTH || 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) {
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
		    "%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;







|
















|


















|







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
		    "%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 *)attemptckalloc(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 *)ckalloc(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 *)ckalloc(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;
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
	     * 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);







|







1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
	z = (ZipEntry *)ckalloc(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);
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
	    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;







|







1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
	    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 */
	    ckfree(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;
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
		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;







|







1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
		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 *)ckalloc(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;
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
		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 --







|








|




|


|







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
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = (ZipFile *)attemptckalloc(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) {
	ckfree(zf);
	return TCL_ERROR;
    }
    if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
	    != TCL_OK) {
	ckfree(zf);
	return TCL_ERROR;
    }
    ckfree(zf);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_MountBuffer --
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
    }
    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 --







|










|



















|







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
    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = (ZipFile *)attemptckalloc(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 *)attemptckalloc(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");
    ckfree(zf);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
    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;







|

|



|







1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
    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) {
	    ckfree(z->data);
	}
	ckfree(z);
    }
    ZipFSCloseArchive(interp, zf);
    Tcl_DeleteExitHandler(ZipfsExitHandler, zf);
    ckfree(zf);
    unmounted = 1;
  done:
    Unlock();
    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841

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







|
|
|







1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		 "?mountpoint? ?zipfile? ?password?");
	return TCL_ERROR;
    }

    return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
	    (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
	    (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountBufferObjCmd --
 *
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
    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;
    }








|














|







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
    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;
    int length;

    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 = Tcl_GetString(objv[1]);
    if (objc < 3) {
	ReadLock();
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }

1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
    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 --
 *







|







1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
    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;







|







1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
    int len, i = 0;
    char *pw, passBuf[264];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetString(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;
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
	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);







|



|
















|

|




|











|






|



|














|


















|









|

















|

















|




|



|














|











|



|

















|







|



|












|


|









|









|







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
	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_Close(interp, in);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_Close(interp, in);
	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 == ERROR_LENGTH) {
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_Close(interp, in);
	    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_Close(interp, in);
	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 ((size_t) Tcl_Write(out, buf, len) != len) {
    wrerr:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));
	Tcl_Close(interp, in);
	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 ((size_t) 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_Close(interp, in);
		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_Close(interp, in);
		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_Close(interp, in);
	    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_Close(interp, in);
	return TCL_ERROR;
    }
    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == ERROR_LENGTH) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_Close(interp, in);
	    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_Close(interp, in);
		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 && ((size_t) Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		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_Close(interp, in);
	    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 == ERROR_LENGTH) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		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 ((size_t) Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;
	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_Close(interp, in);

    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 *)ckalloc(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);
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
    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;
}








|






|







|







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
    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);
	ckfree(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);
	ckfree(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);
	ckfree(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    return TCL_OK;
}

2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422

    /*
     * 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;
	}







|







2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = Tcl_GetString(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;
	}
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
    }
    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];








|














|


|







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
    }
    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, Tcl_GetString(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) ? Tcl_GetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? Tcl_GetString(objv[5]) :
		    Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    for (len = pwlen; len-- > 0;) {
		int ch = pw[len];

2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
	    }
	}
	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();
		}







|





|







2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
	    }
	}
	Unlock();
	if (!isMounted) {
	    zf = &zf0;
	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
	    if ((size_t) 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_Close(interp, out);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->numOpen--;
		    Unlock();
		}
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
	     */

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







|



|





|
|







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

	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == ERROR_LENGTH) {
	    cperr:
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s: %s", errMsg, Tcl_PosixError(interp)));
		Tcl_Close(interp, out);
		Tcl_Close(interp, in);
		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);
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
		}
		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;
		}







|








|









|





|

|







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
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
	    }
	    Tcl_Close(interp, in);
	}
	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_Close(interp, out);
		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 = Tcl_GetString(objv[3]);
	slen = strlen(strip);
    }
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
	}
    }
    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;
		}







|

|







2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
	}
    }
    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
	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);







|







2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
	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)
		|| ((size_t) Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    goto done;
	}
	count++;
    }
    Tcl_Flush(out);
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
	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;
}

/*







|

|





|







2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

  done:
    if (ret == TCL_OK) {
	ret = Tcl_Close(interp, out);
    } else {
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	ckfree(z);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

/*
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

    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;
}

/*







|


|
|







|
|







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

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if (objc == 2) {
	filename = Tcl_GetString(objv[1]);
	result = CanonicalPath("", filename, &dPath, 1);
    } else if (objc == 3) {
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, 1);
    } else {
	int zipfs = 0;

	if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) {
	    return TCL_ERROR;
	}
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, zipfs);
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    return TCL_OK;
}

/*
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
	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;







|







2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = Tcl_GetString(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;
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
    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));







|







2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
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
    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);








|
|


|

|










|







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
    Tcl_Obj *result = Tcl_GetObjResult(interp);

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	int n;
	char *what = Tcl_GetStringFromObj(objv[1], &n);

	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	    pattern = Tcl_GetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    regexp = Tcl_RegExpCompile(interp, Tcl_GetString(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 = Tcl_GetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160

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







|







3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174

    /*
     * 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 = 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)
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
    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 --







|








|



|










|





|







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
    ZipChannel *info = (ZipChannel *)instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    if (info->iscompr && info->ubuf) {
	ckfree(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 *)attemptckrealloc(info->ubuf, info->numRead);

	if (newdata) {
	    if (z->data) {
		ckfree(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 {
	    ckfree(info->ubuf);
	}
    }
    WriteLock();
    info->zipFilePtr->numOpen--;
    Unlock();
    ckfree(info);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelRead --
3480
3481
3482
3483
3484
3485
3486












3487
3488
3489
3490
3491
3492
3493
    } 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







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







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
    } else if ((size_t) offset > end) {
	*errloc = EINVAL;
	return -1;
    }
    info->numRead = (size_t) offset;
    return info->numRead;
}

#ifndef TCL_NO_DEPRECATED
static int
ZipChannelSeek(
    void *instanceData,
    long offset,
    int mode,
    int *errloc)
{
    return ZipChannelWideSeek(instanceData, offset, mode, errloc);
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWatchChannel --
 *
 *	This function is called for event notifications on channel. Does
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
		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 {







|

















|



|

|










|







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
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = (ZipChannel *)attemptckalloc(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 *)attemptckalloc(info->maxWrite);
	if (!info->ubuf) {
	merror0:
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(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) {
	    unsigned int j = z->numBytes;

	    if (j > info->maxWrite) {
		j = info->maxWrite;
	    }
	    memcpy(info->ubuf, z->data, j);
	    info->numBytes = j;
	} else {
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706

		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);
		    }







|


|







3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732

		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) {
		    unsigned int j;

		    stream.avail_in -= 12;
		    cbuf = (unsigned char *)attemptckalloc(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);
		    }
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
		}
		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++) {







|






|


|

|







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
		}
		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));
			ckfree(cbuf);
		    }
		    goto wrapchan;
		}
	    cerror0:
		if (cbuf) {
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(cbuf);
		}
		if (info->ubuf) {
		    ckfree(info->ubuf);
		}
		ckfree(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++) {
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
	    }
	    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++) {







|








|












|





|

|


















|







|


|

|







|







|

|







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
	    }
	    info->ubuf += i;
	}
	if (info->iscompr) {
	    z_stream stream;
	    int err;
	    unsigned char *ubuf = NULL;
	    unsigned int 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 *)attemptckalloc(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 *)attemptckalloc(info->numBytes);
	    if (!info->ubuf) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
		ckfree(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));
		    ckfree(ubuf);
		}
		goto wrapchan;
	    }
	cerror:
	    if (ubuf) {
		info->isEncrypted = 0;
		memset(info->keys, 0, sizeof(info->keys));
		ckfree(ubuf);
	    }
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(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;
	    unsigned int 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 *) attemptckalloc(len);
	    if (ubuf == NULL) {
		ckfree((char *) info);
		if (interp != NULL) {
		    Tcl_SetObjResult(interp,
			Tcl_NewStringObj("out of memory", -1));
		}
		goto error;
	    }
	    for (j = 0; j < len; j++) {
3987
3988
3989
3990
3991
3992
3993


3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
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 --







>
>




|







4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
static Tcl_Channel
ZipFSOpenFileChannelProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *pathPtr,
    int mode,
    int permissions)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }
    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode,
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
4017
4018
4019
4020
4021
4022
4023

4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{


    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(TclGetString(pathPtr), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSAccessProc --
 *







>





|







4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSAccessProc --
 *
4047
4048
4049
4050
4051
4052
4053


4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
 */

static int
ZipFSAccessProc(
    Tcl_Obj *pathPtr,
    int mode)
{


    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryAccess(TclGetString(pathPtr), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemSeparatorProc --
 *







>
>




|







4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
 */

static int
ZipFSAccessProc(
    Tcl_Obj *pathPtr,
    int mode)
{
    int len;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemSeparatorProc --
 *
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
    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 {







|
|














|





|
>







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
    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, prefixLen, strip = 0;
    size_t len;
    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 = Tcl_GetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = Tcl_GetString(normPathPtr);
    len = normPathPtr->length;

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
		}
	    }
	}
	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;







|







4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
		}
	    }
	}
	goto end;
    }

    l = strlen(pattern);
    pat = (char *)ckalloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
		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;
}








|







4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    ckfree(pat);

  end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    return TCL_OK;
}

4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314


4315
4316
4317
4318
4319
4320
4321
    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;
    }







|



>
>







4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }

    path = Tcl_GetString(pathPtr);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    len = pathPtr->length;

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }
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
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:
	*objPtrRef = Tcl_NewWideIntObj(z->numBytes);
	break;
    case 1:
	*objPtrRef = Tcl_NewWideIntObj(z->numCompressedBytes);
	break;
    case 2:
	*objPtrRef = Tcl_NewWideIntObj(z->offset);
	break;
    case 3:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);







|







|










|


|


|







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
static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = Tcl_GetStringFromObj(pathPtr, &len);
    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);
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
	 */

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







|







4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
	 */

	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_PkgProvide(interp, "zipfs", "2.0");
    }
    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 */
Changes to generic/tclZlib.c.
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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







|







60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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. */
    int 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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
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);







|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
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,
			    int bufferSize, int flush, int *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);
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
/*
 * 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,







|







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
/*
 * Type of zlib-based compressing and decompressing channels.
 */

static const Tcl_ChannelType zlibChannelType = {
    "zlib",
    TCL_CHANNEL_VERSION_5,
    TCL_CLOSE2PROC,
    ZlibTransformInput,
    ZlibTransformOutput,
    NULL,			/* seekProc */
    ZlibTransformSetOption,
    ZlibTransformGetOption,
    ZlibTransformWatch,
    ZlibTransformGetHandle,
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
				 * 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;
	}
    }







<



















|
|



















|
|







419
420
421
422
423
424
425

426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
				 * 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;

    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, &len);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 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, &len);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }
590
591
592
593
594
595
596
597
598
599
600
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 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);
    }
}







|
|












|
|










|

|
















|







589
590
591
592
593
594
595
596
597
598
599
600
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

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return inflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int
Deflate(
    z_streamp strm,
    void *bufferPtr,
    int bufferSize,
    int flush,
    int *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,
    int size)
{
    if (size > 0) {
	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);

	Tcl_ListObjAppendElement(NULL, listObj, baObj);
    }
}
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
	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;







|



|







696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    if (dictObj) {
		gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader));
		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
			NULL) != TCL_OK) {
		    ckfree(gzHeaderPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	case TCL_ZLIB_FORMAT_ZLIB:
	    wbits = WBITS_ZLIB;
	    break;
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745

	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;







|







730
731
732
733
734
735
736
737
738
739
740
741
742
743
744

	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    gzHeaderPtr = (GzipHeader *)ckalloc(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;
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
	}
	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;







|







756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
	}
	break;
    default:
	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
		" TCL_ZLIB_STREAM_INFLATE");
    }

    zshPtr = (ZlibStreamHandle *)ckalloc(sizeof(ZlibStreamHandle));
    zshPtr->interp = interp;
    zshPtr->mode = mode;
    zshPtr->format = format;
    zshPtr->level = level;
    zshPtr->wbits = wbits;
    zshPtr->currentInput = NULL;
    zshPtr->streamEnd = 0;
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
    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 --







|

|







856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
    return TCL_OK;

  error:
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	ckfree(zshPtr->gzHeaderPtr);
    }
    ckfree(zshPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCmdDelete --
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
    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 --
 *







|


|







969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
    if (zshPtr->currentInput) {
	Tcl_DecrRefCount(zshPtr->currentInput);
    }
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	ckfree(zshPtr->gzHeaderPtr);
    }

    ckfree(zshPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamReset --
 *
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
    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);







<
|







1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1206
    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, 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);
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
	 * 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







|







1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;
	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = (char *)ckalloc(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
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
	     */

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








|








|







1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
	     */

	    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 *)ckrealloc(dataTmp, outSize);
	    }
	}

	/*
	 * And append the final data block to the outData list.
	 */

	AppendByteArray(zshPtr->outData, dataTmp, toStore);
	ckfree(dataTmp);
    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);

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

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







|



|
<


|














|







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

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    int count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e, i, listLen, itemLen, dataPos = 0;

    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    int existing;

    /*
     * 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 == -1) {
	    /*
	     * 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;
	}
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
		 * 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







|







1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
		 * under our feet. [Bug 3081008]
		 */

		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
		if (Tcl_IsShared(itemObj)) {
		    itemObj = Tcl_DuplicateObj(itemObj);
		}
		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		Tcl_IncrRefCount(itemObj);
		zshPtr->currentInput = itemObj;
		zshPtr->stream.next_in = itemPtr;
		zshPtr->stream.avail_in = itemLen;

		/*
		 * And remove it from the list
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
	     * 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.







|







1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
	     * 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 = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    Tcl_IncrRefCount(itemObj);
	    zshPtr->currentInput = itemObj;
	    zshPtr->stream.next_in = itemPtr;
	    zshPtr->stream.avail_in = itemLen;

	    /*
	     * Remove it from the list.
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
		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;
		}
	    }
	}







|



|







1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
	if (count == -1) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
		    count += itemLen;
		}
	    }
	}
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
		&& (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;







|
|







1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
		&& (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 = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos >= count-dataPos) {
		size_t len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
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) {







|
<







1572
1573
1574
1575
1576
1577
1578
1579

1580
1581
1582
1583
1584
1585
1586
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, inLen = 0, e = 0, extraSize = 0;

    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
    /*
     * 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,







|







1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
    /*
     * Allocate some space to store the output.
     */

    TclNewObj(obj);

    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = (uInt) inLen;
    stream.next_in = inData;

    /*
     * No output buffer available yet, will alloc after deflateInit2.
     */

    e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
 */

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







|


|
<







1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733

1734
1735
1736
1737
1738
1739
1740
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, inLen = 0, e = 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) {
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
		"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.







|


|







1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
		"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 *)ckalloc(MAXPATHLEN);
	header.name = (Bytef *) nameBuf;
	header.name_max = MAXPATHLEN - 1;
	commentBuf = (char *)ckalloc(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.
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
	    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.







|







1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
	    bufferSize = inLen;
	}
    }

    TclNewObj(obj);
    outData = Tcl_SetByteArrayLength(obj, bufferSize);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = (uInt) 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.
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
     */

    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);
}

/*
 *----------------------------------------------------------------------
 *







|
|








|


|


















|









|







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

    Tcl_SetByteArrayLength(obj, stream.total_out);
    if (headerPtr != NULL) {
	ExtractHeader(&header, gzipHeaderDictObj);
	SetValue(gzipHeaderDictObj, "size",
		Tcl_NewWideIntObj(stream.total_out));
	ckfree(nameBuf);
	ckfree(commentBuf);
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

  error:
    TclDecrRefCount(obj);
    ConvertError(interp, e, stream.adler);
    if (nameBuf) {
	ckfree(nameBuf);
    }
    if (commentBuf) {
	ckfree(commentBuf);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
 *
 *	Access to the checksumming engines.
 *
 *----------------------------------------------------------------------
 */

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    int 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,
    int len)
{
    return adler32(adler, (Bytef *) buf, len);
}

/*
 *----------------------------------------------------------------------
 *
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
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







|
|
<







1943
1944
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954
1955
1956
1957
1958
static int
ZlibCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int command, dlen, i, option, level = -1;
    unsigned start, buffersize = 0;

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








|
|


|
|


<











|
|


|
|


<







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
    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_GetIntFromObj(interp, objv[3],
		    (int *) &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
		    || buffersize > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }

	}
	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_GetIntFromObj(interp, objv[3],
		    (int *) &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
		    || buffersize > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }

	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
		buffersize, NULL);
    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
					 *	-> decompressedData */
	Tcl_Obj *headerVarObj;

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

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







|
|


|
|


<







2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161

2162
2163
2164
2165
2166
2167
2168

	    if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
		    &option) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (option) {
	    case 0:
		if (Tcl_GetIntFromObj(interp, objv[i+1],
			(int *) &buffersize) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
			|| buffersize > MAX_BUFFER_SIZE) {
		    goto badBuffer;
		}

		break;
	    case 1:
		headerVarObj = objv[i+1];
		TclNewObj(headerDictObj);
		break;
	    }
	}
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
    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 pushOptions {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;
    }







|







2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
    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;
    }
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
	}
	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 pushOptions) option) {
	case poHeader:
	    headerObj = objv[i];
	    if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
		goto genericOptionError;
	    }
	    break;
	case poLevel:







|







2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
	}
	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:
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
    }

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







|







2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	int len;

	if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    compDictObj = NULL;
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
    }

    /*
     * 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;
	}







|







2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	int len;

	if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}
	if (len == 0) {
	    compDictObj = NULL;
	}
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
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.







|
<







2938
2939
2940
2941
2942
2943
2944
2945

2946
2947
2948
2949
2950
2951
2952
static int
ZlibTransformClose(
    void *instanceData,
    Tcl_Interp *interp,
	int flags)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    int e, written, result = TCL_OK;


    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    /*
     * Delete the support timer.
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045

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







|



|


|







3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035

    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
	cd->compDictObj = NULL;
    }

    if (cd->inBuffer) {
	ckfree(cd->inBuffer);
	cd->inBuffer = NULL;
    }
    if (cd->outBuffer) {
	ckfree(cd->outBuffer);
	cd->outBuffer = NULL;
    }
    ckfree(cd);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformInput --
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
	}
	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();







|





|







3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
	}
	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 < 0) 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 < 0) {

	    /* See ReflectInput() in tclIORTrans.c */
	    if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
		break;
	    }

	    *errorCodePtr = Tcl_GetErrno();
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
    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);
    }








<
|







3180
3181
3182
3183
3184
3185
3186

3187
3188
3189
3190
3191
3192
3193
3194
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverOutputProc *outProc =
	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));

    int e, produced;
    Tcl_Obj *errObj;

    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }

3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268

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








|
<







3242
3243
3244
3245
3246
3247
3248
3249

3250
3251
3252
3253
3254
3255
3256

static int
ZlibTransformFlush(
    Tcl_Interp *interp,
    ZlibChannelData *cd,
    int flushType)
{
    int e, len;


    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */

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







|





|
|

|


















|







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
	 * Embedded NUL bytes are ok; they'll be C080-encoded.
	 */

	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-dictionary");
	    if (cd->compDictObj) {
		Tcl_DStringAppendElement(dsPtr,
			Tcl_GetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		int len;
		const char *str = TclGetStringFromObj(cd->compDictObj, &len);

		Tcl_DStringAppend(dsPtr, str, len);
	    }
	    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, Tcl_GetString(tmpObj));
	    Tcl_DecrRefCount(tmpObj);
	} else {
	    TclDStringAppendObj(dsPtr, tmpObj);
	    Tcl_DecrRefCount(tmpObj);
	    return TCL_OK;
	}
    }
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
    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);
    }








|







3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
    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 *)ckalloc(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);
    }

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







|
















|







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
	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 *)ckalloc(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 *)ckalloc(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) {
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
    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 --







|



|





|







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
    cd->chan = chan;
    cd->parent = Tcl_GetStackedChannel(chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return chan;

  error:
    if (cd->inBuffer) {
	ckfree(cd->inBuffer);
	inflateEnd(&cd->inStream);
    }
    if (cd->outBuffer) {
	ckfree(cd->outBuffer);
	deflateEnd(&cd->outStream);
    }
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
    }
    ckfree(cd);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultDecompress --
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
     * 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, "iso8859-1");

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







|











|







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
     * 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_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}

/*
 *----------------------------------------------------------------------
 *	Stubs used when a suitable zlib installation was not found during
 *	configure.
 *----------------------------------------------------------------------
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
    return TCL_OK;
}

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *data,
    size_t count)
{
    return TCL_OK;
}

int
Tcl_ZlibDeflate(
    Tcl_Interp *interp,







|







4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
    return TCL_OK;
}

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *data,
    int count)
{
    return TCL_OK;
}

int
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
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
}

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,







|












|
|







|
|







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
}

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int 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 char *buf,
    int len)
{
    return 0;
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const char *buf,
    int len)
{
    return 0;
}

void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
Changes to library/clock.tcl.
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    try {
	source -encoding utf-8 [file join $DataDir $fileName]
    } on error {} {
	return -code error \
	    -errorcode [list CLOCK badTimeZone :$fileName] \
	    "time zone \":$fileName\" not found"
    }
    return
}







|







3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324

    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 {} {
	return -code error \
	    -errorcode [list CLOCK badTimeZone :$fileName] \
	    "time zone \":$fileName\" not found"
    }
    return
}
Changes to library/cookiejar/cookiejar.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
# 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.
#










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
# 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.
#
Changes to library/dde/pkgIndex.tcl.
1
2
3
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]


|
1
2
3
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]
Changes to library/http/http.tcl.
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
    array set type {
	-binary		boolean
	-blocksize	integer
	-queryblocksize integer
	-strict		boolean
	-timeout	integer
	-validate	boolean

    }
    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 {
		[info exists type($flag)] &&
		![string is $type($flag) -strict $value]
	    } {
		unset $token
		return -code error \
		    "Bad value for $flag ($value), must be $type($flag)"
	    }
	    set state($flag) $value
	} else {







>













<
|
|







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
    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 {($flag eq "-headers") ? [catch {dict size $value}] :
		([info exists type($flag)] && ![string is $type($flag) -strict $value])
	    } {
		unset $token
		return -code error \
		    "Bad value for $flag ($value), must be $type($flag)"
	    }
	    set state($flag) $value
	} else {
Changes to library/init.tcl.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# 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

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







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# 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 8.7a4

# 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.
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

    proc ::tcl::initClock {} {
	# Auto-loading stubs for 'clock.tcl'

	foreach cmd {add format scan} {
	    proc ::tcl::clock::$cmd args {
		variable TclLibDir
		source -encoding utf-8 [file join $TclLibDir clock.tcl]
		return [uplevel 1 [info level 0]]
	    }
	}

	rename ::tcl::initClock {}
    }
    ::tcl::initClock







|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

    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]
		return [uplevel 1 [info level 0]]
	    }
	}

	rename ::tcl::initClock {}
    }
    ::tcl::initClock
Changes to library/reg/pkgIndex.tcl.
1
2
3
4
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded registry 1.3.5 \
        [list load [file join $dir tclreg13.dll] registry]



|
1
2
3
4
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {[info sharedlibextension] != ".dll"} return
package ifneeded registry 1.3.5 \
        [list load [file join $dir tclreg13.dll] Registry]
Changes to library/safe.tcl.
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
# -> 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 ?)
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
	    # checks for the "-help" option.







|







111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
# -> 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 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
	    # checks for the "-help" option.
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
	set at 2
	if {$encoding eq "identity"} {
	    Log $child "attempt to use the identity encoding"
	    return -code error "permission denied"
	}
    } else {
	set at 0
	set encoding {}
    }
    if {$argc != 1} {
	set msg "wrong # args: should be \"source ?-encoding E? fileName\""
	Log $child "$msg ($args)"
	return -code error $msg
    }
    set file [lindex $args $at]







|







933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
	set at 2
	if {$encoding eq "identity"} {
	    Log $child "attempt to use the identity encoding"
	    return -code error "permission denied"
	}
    } else {
	set at 0
	set encoding utf-8
    }
    if {$argc != 1} {
	set msg "wrong # args: should be \"source ?-encoding E? fileName\""
	Log $child "$msg ($args)"
	return -code error $msg
    }
    set file [lindex $args $at]
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    # 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
    # doesn't leak so much. [Bug 2913625]
    set old [::interp eval $child {info script}]
    set replacementMsg "script error"
    set code [catch {
	set f [open $realfile]
	fconfigure $f -eofchar \032
	if {$encoding ne ""} {
	    fconfigure $f -encoding $encoding
	}
	set contents [read $f]
	close $f
	::interp eval $child [list info script $file]
    } msg opt]
    if {$code == 0} {
	set code [catch {::interp eval $child $contents} msg opt]
	set replacementMsg $msg







<
<
|
<







976
977
978
979
980
981
982


983

984
985
986
987
988
989
990
    # 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
    # doesn't leak so much. [Bug 2913625]
    set old [::interp eval $child {info script}]
    set replacementMsg "script error"
    set code [catch {
	set f [open $realfile]


	fconfigure $f -encoding $encoding -eofchar \032

	set contents [read $f]
	close $f
	::interp eval $child [list info script $file]
    } msg opt]
    if {$code == 0} {
	set code [catch {::interp eval $child $contents} msg opt]
	set replacementMsg $msg
Changes to library/tm.tcl.
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
		    # 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 -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)







|







263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
		    # 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]"

		    # 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/Algiers.
1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Algiers) {
    {-9223372036854775808 732 0 LMT}
    {-2486679072 561 0 PMT}
    {-1855958961 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}




|







1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Algiers) {
    {-9223372036854775808 732 0 LMT}
    {-2486592732 561 0 PMT}
    {-1855958961 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}
Changes to library/tzdata/Africa/Casablanca.
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682215200 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927159200 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172103200 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417047200 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2661991200 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2906935200 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3151879200 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3396823200 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3549837600 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3641767200 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}







|















|















|















|















|















|















|















|









|





|





62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682820000 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927764000 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172708000 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417652000 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2662596000 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2907540000 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3152484000 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3397428000 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3550442400 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3642372000 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}
Changes to library/tzdata/Africa/El_Aaiun.
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682215200 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927159200 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172103200 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417047200 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2661991200 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2906935200 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3151879200 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3396823200 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3549837600 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3641767200 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}







|















|















|















|















|















|















|















|









|





|





51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    {1587261600 0 1 +01}
    {1590890400 3600 0 +01}
    {1618106400 0 1 +01}
    {1621130400 3600 0 +01}
    {1648346400 0 1 +01}
    {1651975200 3600 0 +01}
    {1679191200 0 1 +01}
    {1682820000 3600 0 +01}
    {1710036000 0 1 +01}
    {1713060000 3600 0 +01}
    {1740276000 0 1 +01}
    {1743904800 3600 0 +01}
    {1771120800 0 1 +01}
    {1774144800 3600 0 +01}
    {1801965600 0 1 +01}
    {1804989600 3600 0 +01}
    {1832205600 0 1 +01}
    {1835834400 3600 0 +01}
    {1863050400 0 1 +01}
    {1866074400 3600 0 +01}
    {1893290400 0 1 +01}
    {1896919200 3600 0 +01}
    {1924135200 0 1 +01}
    {1927764000 3600 0 +01}
    {1954980000 0 1 +01}
    {1958004000 3600 0 +01}
    {1985220000 0 1 +01}
    {1988848800 3600 0 +01}
    {2016064800 0 1 +01}
    {2019088800 3600 0 +01}
    {2046304800 0 1 +01}
    {2049933600 3600 0 +01}
    {2077149600 0 1 +01}
    {2080778400 3600 0 +01}
    {2107994400 0 1 +01}
    {2111018400 3600 0 +01}
    {2138234400 0 1 +01}
    {2141863200 3600 0 +01}
    {2169079200 0 1 +01}
    {2172708000 3600 0 +01}
    {2199924000 0 1 +01}
    {2202948000 3600 0 +01}
    {2230164000 0 1 +01}
    {2233792800 3600 0 +01}
    {2261008800 0 1 +01}
    {2264032800 3600 0 +01}
    {2291248800 0 1 +01}
    {2294877600 3600 0 +01}
    {2322093600 0 1 +01}
    {2325722400 3600 0 +01}
    {2352938400 0 1 +01}
    {2355962400 3600 0 +01}
    {2383178400 0 1 +01}
    {2386807200 3600 0 +01}
    {2414023200 0 1 +01}
    {2417652000 3600 0 +01}
    {2444868000 0 1 +01}
    {2447892000 3600 0 +01}
    {2475108000 0 1 +01}
    {2478736800 3600 0 +01}
    {2505952800 0 1 +01}
    {2508976800 3600 0 +01}
    {2536192800 0 1 +01}
    {2539821600 3600 0 +01}
    {2567037600 0 1 +01}
    {2570666400 3600 0 +01}
    {2597882400 0 1 +01}
    {2600906400 3600 0 +01}
    {2628122400 0 1 +01}
    {2631751200 3600 0 +01}
    {2658967200 0 1 +01}
    {2662596000 3600 0 +01}
    {2689812000 0 1 +01}
    {2692836000 3600 0 +01}
    {2720052000 0 1 +01}
    {2723680800 3600 0 +01}
    {2750896800 0 1 +01}
    {2753920800 3600 0 +01}
    {2781136800 0 1 +01}
    {2784765600 3600 0 +01}
    {2811981600 0 1 +01}
    {2815610400 3600 0 +01}
    {2842826400 0 1 +01}
    {2845850400 3600 0 +01}
    {2873066400 0 1 +01}
    {2876695200 3600 0 +01}
    {2903911200 0 1 +01}
    {2907540000 3600 0 +01}
    {2934756000 0 1 +01}
    {2937780000 3600 0 +01}
    {2964996000 0 1 +01}
    {2968624800 3600 0 +01}
    {2995840800 0 1 +01}
    {2998864800 3600 0 +01}
    {3026080800 0 1 +01}
    {3029709600 3600 0 +01}
    {3056925600 0 1 +01}
    {3060554400 3600 0 +01}
    {3087770400 0 1 +01}
    {3090794400 3600 0 +01}
    {3118010400 0 1 +01}
    {3121639200 3600 0 +01}
    {3148855200 0 1 +01}
    {3152484000 3600 0 +01}
    {3179700000 0 1 +01}
    {3182724000 3600 0 +01}
    {3209940000 0 1 +01}
    {3213568800 3600 0 +01}
    {3240784800 0 1 +01}
    {3243808800 3600 0 +01}
    {3271024800 0 1 +01}
    {3274653600 3600 0 +01}
    {3301869600 0 1 +01}
    {3305498400 3600 0 +01}
    {3332714400 0 1 +01}
    {3335738400 3600 0 +01}
    {3362954400 0 1 +01}
    {3366583200 3600 0 +01}
    {3393799200 0 1 +01}
    {3397428000 3600 0 +01}
    {3424644000 0 1 +01}
    {3427668000 3600 0 +01}
    {3454884000 0 1 +01}
    {3458512800 3600 0 +01}
    {3485728800 0 1 +01}
    {3488752800 3600 0 +01}
    {3515968800 0 1 +01}
    {3519597600 3600 0 +01}
    {3546813600 0 1 +01}
    {3550442400 3600 0 +01}
    {3577658400 0 1 +01}
    {3580682400 3600 0 +01}
    {3607898400 0 1 +01}
    {3611527200 3600 0 +01}
    {3638743200 0 1 +01}
    {3642372000 3600 0 +01}
    {3669588000 0 1 +01}
    {3672612000 3600 0 +01}
    {3699828000 0 1 +01}
    {3703456800 3600 0 +01}
}
Changes to library/tzdata/America/Dawson.
89
90
91
92
93
94
95
96

97
    {1478422800 -28800 0 PST}
    {1489312800 -25200 1 PDT}
    {1509872400 -28800 0 PST}
    {1520762400 -25200 1 PDT}
    {1541322000 -28800 0 PST}
    {1552212000 -25200 1 PDT}
    {1572771600 -28800 0 PST}
    {1583661600 -25200 0 MST}

}







|
>

89
90
91
92
93
94
95
96
97
98
    {1478422800 -28800 0 PST}
    {1489312800 -25200 1 PDT}
    {1509872400 -28800 0 PST}
    {1520762400 -25200 1 PDT}
    {1541322000 -28800 0 PST}
    {1552212000 -25200 1 PDT}
    {1572771600 -28800 0 PST}
    {1583661600 -25200 1 PDT}
    {1604217600 -25200 0 MST}
}
Changes to library/tzdata/America/Whitehorse.
89
90
91
92
93
94
95
96

97
    {1478422800 -28800 0 PST}
    {1489312800 -25200 1 PDT}
    {1509872400 -28800 0 PST}
    {1520762400 -25200 1 PDT}
    {1541322000 -28800 0 PST}
    {1552212000 -25200 1 PDT}
    {1572771600 -28800 0 PST}
    {1583661600 -25200 0 MST}

}







|
>

89
90
91
92
93
94
95
96
97
98
    {1478422800 -28800 0 PST}
    {1489312800 -25200 1 PDT}
    {1509872400 -28800 0 PST}
    {1520762400 -25200 1 PDT}
    {1541322000 -28800 0 PST}
    {1552212000 -25200 1 PDT}
    {1572771600 -28800 0 PST}
    {1583661600 -25200 1 PDT}
    {1604217600 -25200 0 MST}
}
Changes to library/tzdata/Antarctica/Casey.
1
2
3
4
5
6
7
8
9
10
11





12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 -00}
    {-31536000 28800 0 +08}
    {1255802400 39600 0 +11}
    {1267714800 28800 0 +08}
    {1319738400 39600 0 +11}
    {1329843600 28800 0 +08}
    {1477065600 39600 0 +11}
    {1520701200 28800 0 +08}





}











>
>
>
>
>

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(:Antarctica/Casey) {
    {-9223372036854775808 0 0 -00}
    {-31536000 28800 0 +08}
    {1255802400 39600 0 +11}
    {1267714800 28800 0 +08}
    {1319738400 39600 0 +11}
    {1329843600 28800 0 +08}
    {1477065600 39600 0 +11}
    {1520701200 28800 0 +08}
    {1538856000 39600 0 +11}
    {1552752000 28800 0 +08}
    {1570129200 39600 0 +11}
    {1583596800 28800 0 +08}
    {1601740860 39600 0 +11}
}
Changes to library/tzdata/Antarctica/Macquarie.
89
90
91
92
93
94
95

96


















































































































































































97
    {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 39600 0 +11}


















































































































































































}







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

89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
    {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}
    {1262264400 39600 1 AEDT}
    {1293800400 39600 0 AEST}
    {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/Asia/Gaza.
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
    {1333058400 10800 1 EEST}
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1572040800 7200 0 EET}
    {1585260000 10800 1 EEST}
    {1604095200 7200 0 EET}
    {1616709600 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648159200 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1680213600 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711663200 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743112800 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774562400 10800 1 EEST}
    {1793397600 7200 0 EET}
    {1806012000 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1838066400 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1869516000 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1900965600 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932415200 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963864800 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995314400 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2027368800 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058818400 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090268000 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121717600 10800 1 EEST}
    {2140552800 7200 0 EET}
    {2153167200 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184616800 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216671200 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248120800 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279570400 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311020000 10800 1 EEST}
    {2329855200 7200 0 EET}
    {2342469600 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374524000 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2405973600 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437423200 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468872800 10800 1 EEST}
    {2487708000 7200 0 EET}
    {2500322400 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531772000 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563826400 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595276000 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626725600 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658175200 10800 1 EEST}
    {2677010400 7200 0 EET}
    {2689624800 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721679200 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2753128800 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784578400 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816028000 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847477600 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2878927200 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910981600 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2942431200 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973880800 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005330400 10800 1 EEST}
    {3024165600 7200 0 EET}
    {3036780000 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068229600 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3100284000 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131733600 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163183200 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194632800 10800 1 EEST}
    {3213468000 7200 0 EET}
    {3226082400 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3258136800 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289586400 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321036000 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352485600 10800 1 EEST}
    {3371320800 7200 0 EET}
    {3383935200 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415384800 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3447439200 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478888800 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510338400 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541788000 10800 1 EEST}
    {3560623200 7200 0 EET}
    {3573237600 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3605292000 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636741600 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668191200 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699640800 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731090400 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762540000 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794594400 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3826044000 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857493600 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3888943200 10800 1 EEST}
    {3907778400 7200 0 EET}
    {3920392800 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951842400 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983896800 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015346400 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046796000 10800 1 EEST}
    {4065026400 7200 0 EET}
    {4078245600 10800 1 EEST}
    {4097080800 7200 0 EET}
}







|







|
|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
    {1333058400 10800 1 EEST}
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445551200 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {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}
    {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}
    {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}
    {4078332000 10800 1 EEST}
    {4096476000 7200 0 EET}
}
Changes to library/tzdata/Asia/Hebron.
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
    {1333058400 10800 1 EEST}
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445547600 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1572040800 7200 0 EET}
    {1585260000 10800 1 EEST}
    {1604095200 7200 0 EET}
    {1616709600 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648159200 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1680213600 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711663200 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743112800 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774562400 10800 1 EEST}
    {1793397600 7200 0 EET}
    {1806012000 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1838066400 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1869516000 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1900965600 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932415200 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963864800 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995314400 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2027368800 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058818400 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090268000 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121717600 10800 1 EEST}
    {2140552800 7200 0 EET}
    {2153167200 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184616800 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216671200 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248120800 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279570400 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311020000 10800 1 EEST}
    {2329855200 7200 0 EET}
    {2342469600 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374524000 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2405973600 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437423200 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468872800 10800 1 EEST}
    {2487708000 7200 0 EET}
    {2500322400 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531772000 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563826400 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595276000 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626725600 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658175200 10800 1 EEST}
    {2677010400 7200 0 EET}
    {2689624800 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721679200 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2753128800 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784578400 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816028000 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847477600 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2878927200 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910981600 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2942431200 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973880800 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005330400 10800 1 EEST}
    {3024165600 7200 0 EET}
    {3036780000 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068229600 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3100284000 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131733600 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163183200 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194632800 10800 1 EEST}
    {3213468000 7200 0 EET}
    {3226082400 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3258136800 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289586400 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321036000 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352485600 10800 1 EEST}
    {3371320800 7200 0 EET}
    {3383935200 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415384800 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3447439200 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478888800 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510338400 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541788000 10800 1 EEST}
    {3560623200 7200 0 EET}
    {3573237600 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3605292000 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636741600 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668191200 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699640800 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731090400 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762540000 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794594400 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3826044000 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857493600 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3888943200 10800 1 EEST}
    {3907778400 7200 0 EET}
    {3920392800 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951842400 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983896800 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015346400 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046796000 10800 1 EEST}
    {4065026400 7200 0 EET}
    {4078245600 10800 1 EEST}
    {4097080800 7200 0 EET}
}







|







|
|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|
|
|

|

|

|

|

|
|
|

|

|

|

|

|

|

|

|

|

|
|
|

|

|

|

|

|
|

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
    {1333058400 10800 1 EEST}
    {1348178400 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1380229200 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414098000 7200 0 EET}
    {1427493600 10800 1 EEST}
    {1445551200 7200 0 EET}
    {1458946800 10800 1 EEST}
    {1477692000 7200 0 EET}
    {1490396400 10800 1 EEST}
    {1509141600 7200 0 EET}
    {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}
    {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}
    {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}
    {4078332000 10800 1 EEST}
    {4096476000 7200 0 EET}
}
Changes to library/tzdata/Europe/Budapest.
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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(:Europe/Budapest) {
    {-9223372036854775808 4580 0 LMT}
    {-2500938980 3600 0 CET}
    {-1693706400 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {-1663455600 7200 1 CEST}
    {-1650150000 3600 0 CET}
    {-1640998800 3600 0 CET}
    {-1633212000 7200 1 CEST}
    {-1618700400 3600 0 CET}


    {-1600466400 7200 1 CEST}
    {-1581202800 3600 0 CET}
    {-906771600 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-788922000 3600 0 CET}
    {-778471200 7200 1 CEST}
    {-762660000 3600 0 CET}
    {-749689200 7200 1 CEST}
    {-733359600 3600 0 CET}
    {-717634800 7200 1 CEST}
    {-701910000 3600 0 CET}
    {-686185200 7200 1 CEST}
    {-670460400 3600 0 CET}
    {-654130800 7200 1 CEST}
    {-639010800 3600 0 CET}
    {-621990000 7200 1 CEST}
    {-605660400 3600 0 CET}
    {-492656400 7200 1 CEST}
    {-481168800 3600 0 CET}
    {-461120400 7200 1 CEST}
    {-449632800 3600 0 CET}
    {-428547600 7200 1 CEST}
    {-418269600 3600 0 CET}
    {-397094400 7200 1 CEST}
    {-386809200 3600 0 CET}
    {323827200 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}




|





|

>
>
|
|
|







|

|






<
<


|
|
|
|
|

|
|
|
|
|
|
|
>
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33


34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Budapest) {
    {-9223372036854775808 4580 0 LMT}
    {-2498260580 3600 0 CET}
    {-1693706400 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {-1663455600 7200 1 CEST}
    {-1650150000 3600 0 CET}
    {-1640998800 3600 0 CET}
    {-1632006000 7200 1 CEST}
    {-1618700400 3600 0 CET}
    {-1600470000 7200 1 CEST}
    {-1587250800 3600 0 CET}
    {-1569711600 7200 1 CEST}
    {-1555196400 3600 0 CET}
    {-906775200 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-788922000 3600 0 CET}
    {-778471200 7200 1 CEST}
    {-762656400 3600 0 CET}
    {-749689200 7200 1 CEST}
    {-733276800 3600 0 CET}
    {-717634800 7200 1 CEST}
    {-701910000 3600 0 CET}
    {-686185200 7200 1 CEST}
    {-670460400 3600 0 CET}
    {-654130800 7200 1 CEST}
    {-639010800 3600 0 CET}


    {-492656400 7200 1 CEST}
    {-481168800 3600 0 CET}
    {-461199600 7200 1 CEST}
    {-449708400 3600 0 CET}
    {-428540400 7200 1 CEST}
    {-418258800 3600 0 CET}
    {-397090800 7200 1 CEST}
    {-386809200 3600 0 CET}
    {323823600 7200 1 CEST}
    {338943600 3600 0 CET}
    {354668400 7200 1 CEST}
    {370393200 3600 0 CET}
    {386118000 7200 1 CEST}
    {401842800 3600 0 CET}
    {417567600 7200 1 CEST}
    {433292400 3600 0 CET}
    {441759600 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}
Changes to library/tzdata/Europe/Monaco.
1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Monaco) {
    {-9223372036854775808 1772 0 LMT}
    {-2486680172 561 0 PMT}
    {-1855958961 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}




|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

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}
Changes to library/tzdata/Europe/Paris.
1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Paris) {
    {-9223372036854775808 561 0 LMT}
    {-2486678901 561 0 PMT}
    {-1855958901 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}




|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Paris) {
    {-9223372036854775808 561 0 LMT}
    {-2486592561 561 0 PMT}
    {-1855958961 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}
Changes to library/tzdata/Pacific/Fiji.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {1484402400 43200 0 +12}
    {1509804000 46800 1 +12}
    {1515852000 43200 0 +12}
    {1541253600 46800 1 +12}
    {1547301600 43200 0 +12}
    {1573308000 46800 1 +12}
    {1578751200 43200 0 +12}
    {1604757600 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}







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    {1484402400 43200 0 +12}
    {1509804000 46800 1 +12}
    {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}
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)
Changes to libtommath/tommath_private.h.
190
191
192
193
194
195
196



197
198
199
200
201
202
203
#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;







>
>
>







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
#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);

#ifdef __cplusplus
extern "C" {
#endif
/* 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;
244
245
246
247
248
249
250




251
252
253
254
255
256
257
      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) \







>
>
>
>







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
      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);

#ifdef __cplusplus
}
#endif

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#undef mp_sqr
#define mp_sqr TclBN_mp_sqr
#endif

#define MP_GET_ENDIANNESS(x) \
Changes to macosx/GNUmakefile.
27
28
29
30
31
32
33












34
35
36
37
38
39
40
PREFIX			?= /usr/local
BINDIR			?= ${PREFIX}/bin
LIBDIR			?= ${INSTALL_PATH}
MANDIR			?= ${PREFIX}/man

# set to non-empty value to install manpages in addition to html help:
INSTALL_MANPAGES	?=













#-------------------------------------------------------------------------------------------------------
# meta targets

meta			:= all install embedded install-embedded clean distclean test

styles			:= develop deploy







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







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
PREFIX			?= /usr/local
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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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-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}))







|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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 \
			   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}))
Changes to macosx/README.
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	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.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch i386 -arch x86_64 -arch ppc"
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").
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.

Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

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

- 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








|




















|

|







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
	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.
'../../tcl8.7', 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.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch i386 -arch x86_64 -arch ppc"
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").
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.

Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

- 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. '8.7').
Setup this shell variable as follows:
	ver="8.7"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).

- 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

161
162
163
164
165
166
167










(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.
For example, to build and install only the optimized versions:
	make -C tcl${ver}/macosx deploy
	sudo make -C tcl${ver}/macosx install-deploy

















>
>
>
>
>
>
>
>
>
>
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(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.
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.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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_VERSION = 4.2
GCC = gcc-$(GCC_VERSION)
WARNING_CFLAGS = -Wall -Wwrite-strings -Wextra -Wdeclaration-after-statement -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(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_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 9.0







|














|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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_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)
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_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 8.7
Changes to macosx/Tcl.xcode/project.pbxproj.
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,

				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,







>







1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
			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
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";









		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
			);







>
>
>
>
>
>
>
>
>







1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
			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 */,
			);
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,

				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,







>







1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
			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
			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";









		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
			);







>
>
>
>
>
>
>
>
>







1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
			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 */,
			);
Changes to macosx/tclMacOSXBundle.c.
142
143
144
145
146
147
148



































149
150
151
152
153
154
155
}

#endif /* HAVE_COREFOUNDATION */

/*
 *----------------------------------------------------------------------
 *



































 * Tcl_MacOSXOpenVersionedBundleResources --
 *
 *	Given the bundle and version name for a shared library (version name
 *	can be NULL to indicate latest version), 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.







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







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
}

#endif /* HAVE_COREFOUNDATION */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MacOSXOpenBundleResources --
 *
 *	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.
 *	TCL_ERROR otherwise.
 *
 * Side effects:
 *	libraryVariableName may be set, and the resource file opened.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
#undef Tcl_MacOSXOpenBundleResources
int
Tcl_MacOSXOpenBundleResources(
    Tcl_Interp *interp,
    const char *bundleName,
    int hasResourceFile,
    int maxPathLen,
    char *libraryPath)
{
    return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName, NULL,
	    hasResourceFile, maxPathLen, libraryPath);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MacOSXOpenVersionedBundleResources --
 *
 *	Given the bundle and version name for a shared library (version name
 *	can be NULL to indicate latest version), 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.
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

int
Tcl_MacOSXOpenVersionedBundleResources(
    TCL_UNUSED(Tcl_Interp *),
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    size_t maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;








|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215

int
Tcl_MacOSXOpenVersionedBundleResources(
    TCL_UNUSED(Tcl_Interp *),
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    int maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;

Changes to macosx/tclMacOSXFCmd.c.
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);







|



|







188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr,
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr, *rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    size_t length;

    string = TclGetStringFromObj(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);
	}







<

|
|







635
636
637
638
639
640
641

642
643
644
645
646
647
648
649
650
651
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");


    string = TclGetString(objPtr);
    Tcl_UtfToExternalDString(encoding, string, objPtr->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);
	}
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
 */

static void
UpdateStringOfOSType(
    Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * 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 src[5];

    TclOOM(dst, size);







|







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
 */

static void
UpdateStringOfOSType(
    Tcl_Obj *objPtr)	/* OSType object whose string rep to
				 * update. */
{
    const int 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 src[5];

    TclOOM(dst, size);
Changes to macosx/tclMacOSXNotify.c.
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
    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;







|







1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
    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;
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    Tcl_Free(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *







|







1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    ckfree(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480

	/*
	 * 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;
    }







|







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

	/*
	 * 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;
    }
Changes to tests/append.test.
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
test append-1.3 {append command} {
    set x "abcd"
    append x
} abcd

test append-2.1 {long appends} {
    set x ""
    for {set i 0} {$i < 1000} {set i [expr $i+1]} {
	append x "foobar "
    }
    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}







|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
test append-1.3 {append command} {
    set x "abcd"
    append x
} abcd

test append-2.1 {long appends} {
    set x ""
    for {set i 0} {$i < 1000} {incr i} {
	append x "foobar "
    }
    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}
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
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
    }







|







154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
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} {incr i} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
Changes to tests/appendComp.test.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    }
    foo
} abcd

test appendComp-2.1 {long appends} {
    proc foo {} {
	set x ""
	for {set i 0} {$i < 1000} {set i [expr $i+1]} {
	    append x "foobar "
	}
	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}







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    }
    foo
} abcd

test appendComp-2.1 {long appends} {
    proc foo {} {
	set x ""
	for {set i 0} {$i < 1000} {incr i} {
	    append x "foobar "
	}
	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}
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
    set x ""
    for {set i 0} {$i < 300} {set i [expr $i+1]} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
    unset -nocomplain x
    catch {rename check ""}
} -result ok







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
    set x ""
    for {set i 0} {$i < 300} {incr i} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
    unset -nocomplain x
    catch {rename check ""}
} -result ok
Changes to tests/apply.test.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
    return
}

testConstraint memory [llength [info commands memory]]

# Tests for wrong number of arguments

test apply-1.1 {too few arguments} -returnCodes error -body {
    apply
} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}

# Tests for malformed lambda

test apply-2.0 {malformed lambda} -returnCodes error -body {
    set lambda a







|







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
    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 ...?"}

# Tests for malformed lambda

test apply-2.0 {malformed lambda} -returnCodes error -body {
    set lambda a
Changes to tests/assemble.test.
527
528
529
530
531
532
533












534
535
536
537
538
539
540
		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







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







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
		push a; push 7; incrStk
	    }
	}
	x
    }
    -result 12
    -cleanup {rename x {}}
}
test assemble-7.17 {land/lor} {
    -body {
	proc x {a b} {
	    list \
		[assemble {load a; load b; land}] \
		[assemble {load a; load b; lor}]
	}
	list [x 0 0] [x 0 23] [x 35 0] [x 47 59]
    }
    -result {{0 0} {0 1} {0 1} {1 1}}
    -cleanup {rename x {}}
}
test assemble-7.18 {lappendArrayStk} {
    -body {
	proc x {} {
	    set able(baker) charlie
	    assemble {
		push able
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
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
	}
    }







|







777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
test assemble-7.43 {uplus} {
    -body {
	assemble {
	    push NaN; uplus
	}
    }
    -returnCodes error
    -result {can't use non-numeric floating-point value as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
    -body {
	assemble {
	    push NaN; tryCvtToNumeric
	}
    }
Changes to tests/async.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
    namespace import -force ::tcltest::*
}

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

testConstraint testasync [llength [info commands testasync]]
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"
}







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
    namespace import -force ::tcltest::*
}

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

testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]

proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
}
Changes to tests/autoMkindex.test.
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

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

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.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}







|
|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

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

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.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}
Changes to tests/basic.test.
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}








|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if {$noComp} {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

Changes to tests/binary.test.
755
756
757
758
759
760
761
762









763
764
765
766
767
768
769
    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}







|
>
>
>
>
>
>
>
>
>







755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
    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-21.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan "abc def \x00  " C* arg1] $arg1
} -result {1 {abc def }}
test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan "abc def \x00ghi" C* arg1] $arg1
} -result {1 {abc def }}
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}
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
90
91
92
93
94
# 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 {![llength [info commands case]]} {
    # No "case" command? So no need to test
    return
}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    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? ?pattern 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/chanio.test.
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    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 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







>
|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    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 notWinCI       [expr {
	$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
    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
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
    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 {
    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







|







1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
    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 notWinCI} -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
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
    variable x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 2000} {incr i} {
	    chan puts $s $l
	}
    }
} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
    proc accept {s a p} {
	variable x
	chan event $s readable [namespace code [list readit $s]]
	chan configure $s -blocking off
	set x accepted
    }
    proc readit {s} {







|







2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
    variable x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 2000} {incr i} {
	    chan puts $s $l
	}
    }
} -constraints {socket tempNotMac fileevent notWinCI} -body {
    proc accept {s a p} {
	variable x
	chan event $s readable [namespace code [list readit $s]]
	chan configure $s -blocking off
	set x accepted
    }
    proc readit {s} {
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
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr 700*15+1]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
    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]
} -cleanup {
    chan close $f
} -result [expr 700*15+1]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
    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







|
















|







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
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    string length [chan read $f]
} -cleanup {
    chan close $f
} -result [expr {700*15 + 1}]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
    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]
} -cleanup {
    chan close $f
} -result [expr {700*15 + 1}]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
    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
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
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    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 {
    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
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [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.2 {Tcl_Read, zero byte count} {







|



















|







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
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    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 {
    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
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [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.2 {Tcl_Read, zero byte count} {
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
    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    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]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    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 {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy







|













|







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
    chan close $f
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
    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}]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    chan close [open $path(test3) {WRONLY CREAT}]
    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 {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
test chan-io-52.6 {TclCopyChannel} -setup {
    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)} {
        lappend result ok







|







6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
test chan-io-52.6 {TclCopyChannel} -setup {
    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)} {
        lappend result ok
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
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    chan close $listen	;# This means the socket open never really succeeds
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    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 {
    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 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
} -result 0







|



















|







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
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    chan close $listen	;# This means the socket open never really succeeds
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    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 {
    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 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
} -result 0
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    # -1=error 0=script error N=number of bytes
    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 {







|







7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
7045
7046
7047
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    # -1=error 0=script error N=number of bytes
    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 {
Changes to tests/clock.test.
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
35458
35459
    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}
} {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 {}
} {}
test clock-33.4a {clock milliseconds} {
    expr { [clock milliseconds] + 1 }
    concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {







|












|







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
35458
35459
    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}
} {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 {}
} {}
test clock-33.4a {clock milliseconds} {
    expr { [clock milliseconds] + 1 }
    concat {}
} {}
test clock-33.5 {clock clicks tests, millisecond timing test} {
35901
35902
35903
35904
35905
35906
35907
35908
35909
35910
35911
35912
35913
35914
35915
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]







|







35901
35902
35903
35904
35905
35906
35907
35908
35909
35910
35911
35912
35913
35914
35915
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]
Changes to tests/cmdAH.test.
17
18
19
20
21
22
23




24
25
26
27
28

29
30
31
32
33
34
35

::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 linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]


global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough







>
>
>
>





>







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

::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 {![info exists ::env(CI_USING_WINE)]}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
54
55
56
57
58
59
60


61
62
63
64
65
66
67

test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
    break foo
} -returnCodes error -result {wrong # args: should be "break"}
test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
    list [catch {break} msg] $msg
} {3 {}}



test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
    catch
} -result {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}







>
>







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
    break foo
} -returnCodes error -result {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.2 {Tcl_CatchObjCmd, errors} {
    list [catch {catch foo bar baz} msg] $msg
} {0 1}
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
    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
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} -result {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







|







1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
    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
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type)
} -result {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
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
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 {
    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 {
    set filename [makeFile "" foo.text]
} -body {
    list [file mtime $filename 3155760000] [file mtime $filename]
} -cleanup {
    file delete -force $filename
} -result {3155760000 3155760000}








|






|







1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
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]} -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]} -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}

1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
    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 -body {
    if {[info exists env(SystemRoot)]} {
	file owned $env(SystemRoot)
    } else {
	file owned $env(windir)
    }
} -result 0
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {







|







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
    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
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
} -body {
    # Unlike [exec ln -s], [file link] requires an existing target
    file link -symbolic $linkfile $gorpfile
    file type $linkfile
} -cleanup {
    file delete $linkfile
} -result link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
    set tempdir [makeDirectory temp]
} -body {
    set linkdir [file join [temporaryDirectory] link.dir]
    file link -symbolic $linkdir $tempdir
    file type $linkdir
} -cleanup {
    file delete $linkdir







|







1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
} -body {
    # Unlike [exec ln -s], [file link] requires an existing target
    file link -symbolic $linkfile $gorpfile
    file type $linkfile
} -cleanup {
    file delete $linkfile
} -result link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory notWine} -setup {
    set tempdir [makeDirectory temp]
} -body {
    set linkdir [file join [temporaryDirectory] link.dir]
    file link -symbolic $linkdir $tempdir
    file type $linkdir
} -cleanup {
    file delete $linkdir
Changes to tests/cmdIL.test.
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
} {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}}
test cmdIL-5.5 {lsort with list style index and sharing} -body {
    proc test_lsort {l} {
	set n $l
	foreach e $l {lappend n [list [expr {rand()}] $e]}
	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}}







|







510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
} {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}}
test cmdIL-5.5 {lsort with list style index and sharing} -body {
    proc test_lsort {l} {
	set n $l
	foreach e $l {lappend n [list [expr {rand()}] $e]}
	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}}
Changes to tests/compExpr-old.test.
15
16
17
18
19
20
21

22
23
24
25
26
27
28
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


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







>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


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

# 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 {
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
    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 "^"}}
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 "^"}}

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 "&"}}
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 "&"}}

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







|


|




















|


|







276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
    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 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 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 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 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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
    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 ">>"}}
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 "<<"}}

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 "+"}}
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 "-"}}
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 {







|


|


















|


|







361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
    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 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 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 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 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
    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 "*"}}
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 "/"}}

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 "~"}}
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 "~"}}
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)







|


|

















|


|







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
    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 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 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 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 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
599
    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 {too few arguments for math function*
    while *ing
"expr sin()"}
test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -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-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 {}
    }







|


|


|





<







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

593
594
595
596
597
598
599
    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*
    while *ing
"expr sin()"}
test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -match glob -result {not enough 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-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.
10
11
12
13
14
15
16

17
18
19
20
21
22
23

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands


# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}

test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

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

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}

test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
    expr {0? 42 : $a}
} -result 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, too few arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {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*}







|




|

|

|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
    expr {0? 42 : $a}
} -result 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*}
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*}
366
367
368
369
370
371
372
373



































374
375
376

377
378
379
380
381
382
383
        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:







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



>







367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    unset end i tmp
    rename getbytes {}
} -result 0

proc extract {opcodes descriptor} {
    set instructions [dict values [dict get $descriptor instructions]]
    return [lmap i $instructions {
	if {[lindex $i 0] in $opcodes} {string cat $i} else continue
    }]
}

test compExpr-8.1 {TIP 582: expression comments} -setup {} -body {
    extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
        $abc
	# + $def
	+ $ghi
    }}]
} -result {loadStk loadStk add}
test compExpr-8.2 {TIP 582: expression comments} -setup {} -body {
    extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
        $abc
	# + $def
	# + $ghi }}]
} -result loadStk
test compExpr-8.3 {TIP 582: expression comments} -setup {} -body {
    extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
        $abc
	# + $def\
	+ $ghi
    }}]
} -result loadStk
test compExpr-8.4 {TIP 582: expression comments} -setup {} -body {
    extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
        $abc
	# + $def\\
	+ $ghi
    }}]
} -result {loadStk loadStk add}

# cleanup
catch {unset a}
catch {unset b}
catch {rename extract ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:
Changes to tests/compile.test.
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    -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]
	if {$j > 3} break
    }
    set j
} {4}

test compile-5.1 {TclCompileForeachCmd: exception stack} {







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    -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]
	if {$j > 3} break
    }
    set j
} {4}

test compile-5.1 {TclCompileForeachCmd: exception stack} {
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    list $::x $::test_ns_compile::arr(1)
} -result {hello 123}

test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    while [expr $i < 3] {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-8.1 {CollectArgInfo: binary data} {







|







274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    list $::x $::test_ns_compile::arr(1)
} -result {hello 123}

test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    while [expr {$i < 3}] {
	set j [incr i]
	if {$j > 3} break
    }
    set j
} {4}

test compile-8.1 {CollectArgInfo: binary data} {
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
    }}
} -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?}
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?"}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr !a }}
} -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} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg







|










|







322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
    }}
} -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?}
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 {*invalid octal number*}
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?"}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr [concat !a] }}
} -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} }}
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
    list [catch {p} msg] $msg
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
} ""

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}








|







562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
} ""

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {

if {$noComp} {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
}

Changes to tests/encoding.test.
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

}


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







<
|
<







|







725
726
727
728
729
730
731

732

733
734
735
736
737
738
739
740
741
742
743
744
745
746
747

}


test encoding-28.0 {all encodings load} -body {
	set string hello
	foreach name [encoding names] {

		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 [expr {[info exists ::tcl_precision] ? 86 : 85}]

runtests

}

# cleanup
namespace delete ::tcl::test::encoding
Changes to tests/env.test.
100
101
102
103
104
105
106

107

108
109
110
111
112
113
114
}

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 ProgramFiles CommonProgramW6432 ProgramW6432

}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]







>
|
>







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
}

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
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]
Changes to tests/exec.test.
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36
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] {







>
|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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]]
# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

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] {
669
670
671
672
673
674
675


676
677
678
679
680
681
682
683
} -constraints {exec tempNotWin} -cleanup {
    removeFile $path(fooblah)
} -result 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
# 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 \
	    {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile &
    exec /bin/sh -c \







>
>
|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
} -constraints {exec tempNotWin} -cleanup {
    removeFile $path(fooblah)
} -result 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
# that there is a POSIX shell...
#
# This test also fails in some cases when building with macOS
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosxCI} -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 \
Changes to tests/execute.test.
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
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 "+"}}
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}







|







175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
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 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
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 "+"}}

# 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} {







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
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 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
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 "-"}}
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}







|







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
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 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
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 "-"}}

# 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} {







|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
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 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
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 "*"}}
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}







|







279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
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 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
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 "*"}}

# 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} {







|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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 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
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 "/"}}
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}







|







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
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 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
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 "/"}}

# 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} {







|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
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 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
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 "+"}}

# 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} {







|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
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 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
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 "-"}}

# 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} {







|







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
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 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
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 "!"}}





# 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} {







|
>
>
>
>







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
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 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} {
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
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
test execute-7.11 {Wide int handling in INST_LSHIFT} {
    expr wide(42)<<30
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {
    expr 12345678901<<3
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {
    expr 0x543210febcda9876>>7
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {
    expr wide(0x9876543210febcda)>>7
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {
    expr wide(0x9876543210febcda) | 0x543210febcda9876
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {
    expr wide(0x9876543210febcda) ^ 0x543210febcda9876
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {
    expr wide(0x9876543210febcda) & 0x543210febcda9876
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+wide(0x7fffffff)
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {
    expr 0x7fffffff+wide(0x7fffffff)
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+0x7fffffff
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {
    expr double(0x7fffffff)+wide(0x7fffffff)
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {
    expr wide(0x7fffffff)+double(0x7fffffff)
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {
    expr 0x123456789a-0x20406080a
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {
    expr 0x123456789a*193
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {
    expr 0x123456789a/193
} 405116546
test execute-7.26 {Wide int handling in INST_UPLUS} {
    set x 0x123456871234568
    expr {+ $x}
} 81985533099853160
test execute-7.27 {Wide int handling in INST_UMINUS} {
    set x 0x123456871234568







|


|


|


|


|


|


|


|


|


|


|


|


|


|


|







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
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
test execute-7.11 {Wide int handling in INST_LSHIFT} {
    expr {wide(42) << 30}
} 45097156608
test execute-7.12 {Wide int handling in INST_LSHIFT} {
    expr {12345678901 << 3}
} 98765431208
test execute-7.13 {Wide int handling in INST_RSHIFT} {
    expr {0x543210febcda9876 >> 7}
} 47397893236700464
test execute-7.14 {Wide int handling in INST_RSHIFT} {
    expr {wide(0x9876543210febcda) >> 7}
} -58286587177206407
test execute-7.15 {Wide int handling in INST_BITOR} {
    expr {wide(0x9876543210febcda) | 0x543210febcda9876}
} -2560765885044310786
test execute-7.16 {Wide int handling in INST_BITXOR} {
    expr {wide(0x9876543210febcda) ^ 0x543210febcda9876}
} -3727778945703861076
test execute-7.17 {Wide int handling in INST_BITAND} {
    expr {wide(0x9876543210febcda) & 0x543210febcda9876}
} 1167013060659550290
test execute-7.18 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + wide(0x7fffffff)}
} 4294967294
test execute-7.19 {Wide int handling in INST_ADD} {
    expr {0x7fffffff + wide(0x7fffffff)}
} 4294967294
test execute-7.20 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + 0x7fffffff}
} 4294967294
test execute-7.21 {Wide int handling in INST_ADD} {
    expr {double(0x7fffffff) + wide(0x7fffffff)}
} 4294967294.0
test execute-7.22 {Wide int handling in INST_ADD} {
    expr {wide(0x7fffffff) + double(0x7fffffff)}
} 4294967294.0
test execute-7.23 {Wide int handling in INST_SUB} {
    expr {0x123456789a - 0x20406080a}
} 69530054800
test execute-7.24 {Wide int handling in INST_MULT} {
    expr {0x123456789a * 193}
} 15090186251290
test execute-7.25 {Wide int handling in INST_DIV} {
    expr {0x123456789a / 193}
} 405116546
test execute-7.26 {Wide int handling in INST_UPLUS} {
    set x 0x123456871234568
    expr {+ $x}
} 81985533099853160
test execute-7.27 {Wide int handling in INST_UMINUS} {
    set x 0x123456871234568
Changes to tests/expr-old.test.
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
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 "~"}}
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 "%"}}
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 "%"}}
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 "<<"}}
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 "<<"}}
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 ">>"}}
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 ">>"}}
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 "&"}}
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 "|"}}
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 "^"}}

# 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







|


|


|


|


|


|


|


|


|


|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
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 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 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 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 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 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 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 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 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 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 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
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 "-"}}
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 "+"}}
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 "~"}}
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 "!"}}
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 "*"}}
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 "/"}}
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 "%"}}
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 "+"}}
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 "-"}}
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 "<<"}}
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 ">>"}}
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 "&"}}
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 "^"}}
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 "|"}}
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} {







|


|


|


|


|


|


|


|


|


|


|


|


|


|







258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
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 as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
    list [catch {expr {+"a"}} msg] $msg
} {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 as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
    list [catch {expr {!"a"}} msg] $msg
} {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 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 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 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 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 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 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 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 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 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 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} {
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
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 "+"}}
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 "+"}}
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 "+"}}
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} {
    list [catch {expr 2%0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10b {error conditions} ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg
} {0 Inf}
test expr-old-26.11 {error conditions} -body {
    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 "/"}}
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} {







|













|


|
















|






|







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
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 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 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 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} {
    list [catch {expr 2%0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.10b {error conditions} ieeeFloatingPoint {
    list [catch {expr 2.0/0.0} msg] $msg
} {0 Inf}
test expr-old-26.11 {error conditions} -body {
    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 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} {
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
    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 {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} {







|







848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
    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*}}
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
    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 {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} {







|







905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
    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*}}
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
} -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-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 "+"}}
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}







<






|







939
940
941
942
943
944
945

946
947
948
949
950
951
952
953
954
955
956
957
958
959
} -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-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 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
    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 "+"}}
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 "+"}}
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 "+"}}
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







|



|







|







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
    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 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 "+"}}
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 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
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
    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 {too few arguments for 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 {







|







1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
    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"}
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 {
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
    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 {too few arguments for 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 {







|







1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
    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"}
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 {
Changes to tests/expr.test.
12
13
14
15
16
17
18

19
20
21
22
23
24
25

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands


# 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}]







>







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

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

# 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}]
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
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 "!"}}
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"}}








|







248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
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 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
    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 "^"}}
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 "^"}}

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 "&"}}
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 "&"}}
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







|


|




















|


|







295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
    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 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 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 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 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
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
    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 ">>"}}
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 "<<"}}

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 "+"}}
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 "-"}}
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 {







|


|


















|


|







464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
    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 as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {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 as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {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
    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 "*"}}
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 "/"}}

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 "~"}}
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 "~"}}
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)







|


|
















|


|







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    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 as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {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 as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
    list [catch {expr ~4.0} msg] $msg
} {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
    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 {too few arguments for math function*
    while *ing
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -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 *









|


|


|







681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
    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*
    while *ing
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: not enough arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -match glob -result {not enough arguments for math function*
    while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *


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
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 "!"}}
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 "!"}}
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 "!"}}
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 "!"}}
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 "!"}}

# 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 "+"}}
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 "+"}}
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 "/"}}
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}







|



|



|



















|



|




|






|












|







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
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 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 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 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 as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
    set v ""
    list [catch {expr {!$v}} err] $err
} {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 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 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 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
    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 "**"}}
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 "**"}}
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} {







|


|







910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
    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 as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
    list [catch {expr {"a"**2}} msg] $msg
} {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} {
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
		string match {*no string representation*} [
		::tcl::unsupported::representation $a]]
} {0 0 1 1}

foreach func {isfinite isinf isnan isnormal issubnormal} {
    test expr-53.1.$func {float classification: basic arg handling} -body {
	expr ${func}()
    } -returnCodes error -result "too few 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 {







|







7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261
		string match {*no string representation*} [
		::tcl::unsupported::representation $a]]
} {0 0 1 1}

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 {
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
} -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 {too few arguments for math function "isunordered"}
test expr-60.2 {float classification: basic arg handling} -body {
    expr isunordered(1)
} -returnCodes error -result {too few 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 {







|


|







7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
} -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 {
7379
7380
7381
7382
7383
7384
7385





























































7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
    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






























































# cleanup
unset -nocomplain a
unset -nocomplain min
unset -nocomplain max
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







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











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

test expr-62.1 {TIP 582: comments} -body {
    expr {1 # + 2}
} -result 1
test expr-62.2 {TIP 582: comments} -body {
    expr "1 #\n+ 2"
} -result 3
test expr-62.3 {TIP 582: comments} -setup {
    set ctr 0
} -body {
    expr {
	# This is a demonstration of a comment
	1 + 2 + 3
	# and another comment
	+ 4 + 5
	# + [incr ctr]
	+ [incr ctr]
    }
} -result 16
# Buggy because line breaks aren't tracked inside expressions at all
test expr-62.4 {TIP 582: comments don't hide line breaks} -setup {
    proc getline {} {
	dict get [info frame -1] line
    }
    set base [getline]
} -constraints knownBug -body {
    expr {
	0
	# a comment
	+ [getline] - $base
    }
} -cleanup {
    rename getline ""
} -result 5
test expr-62.5 {TIP 582: comments don't splice tokens} {
    set a False
    expr {$a#don't splice
ne#don't splice
false}
} 1
test expr-62.6 {TIP 582: comments don't splice tokens} {
    expr {0x2#don't splice
ne#don't splice
2}
} 1
test expr-62.7 {TIP 582: comments can go inside function calls} {
    expr {max(1,# comment
	      2)}
} 2
test expr-62.8 {TIP 582: comments can go inside function calls} {
    expr {max(1# comment
	      ,2)}
} 2
test expr-62.9 {TIP 582: comments can go inside function calls} {
    expr {max(# comment
	      1,2)}
} 2
test expr-62.10 {TIP 582: comments can go inside function calls} {
    expr {max# comment
	     (1,2)}
} 2

# cleanup
unset -nocomplain a
unset -nocomplain min
unset -nocomplain max
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Changes to tests/fCmd.test.
37
38
39
40
41
42
43

44
45
46
47
48
49
50
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}


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 {







>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	testConstraint reg 1
    }
}
testConstraint notCI [expr {![info exists ::env(CI)] || !$::env(CI)}]

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 {
74
75
76
77
78
79
80

81
82
83
84
85
86
87

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]


testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1

# Several tests require need to match results against the unix username







>







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

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
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
    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} -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 {







|







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
    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 {
    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 {
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
    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} -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} -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} -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 {







|








|




|







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
    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 {
    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 {
    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 {
    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 {
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
    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} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 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}







|







809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
    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 {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 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}
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
    testchmod 0o555 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} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1







|







839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
    testchmod 0o555 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 {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
    }
    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} -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
    }







|







900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
    }
    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 {
    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
    }
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [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} -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} -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







|






|







964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [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 {
    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 {
    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
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 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} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1







|







1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 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 {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
    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} -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} -body {
    file link abc.link abc.dir
    set orig [pwd]
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig







|







|







2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
    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 {
    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 {
    file link abc.link abc.dir
    set orig [pwd]
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
    } else {
	return "ok"
    }
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result ok
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







|







2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
    } else {
	return "ok"
    }
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result ok
test fCmd-28.13 {file link} -constraints {linkDirectory notWine} -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
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
} -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} -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} -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} -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 -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} -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 {







|




















|









|





|










|







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
} -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 {
    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 {
    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 {
    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 {
    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 {
    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 {
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582


2583
2584
2585
2586
2587
2588
2589
2590

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 {
    file writable $mydocsname
} -result 1
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}


test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -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
    }







|




>
>
|







2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594

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 {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -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 notCI} -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
    }
Changes to tests/fileName.test.
27
28
29
30
31
32
33

34
35
36
37
38
39
40
    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}]}]
}

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







>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    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 {![info exists ::env(CI_USING_WINE)]}]
# 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}
}}}
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
    lsort [glob -directory $globname *]
} [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} {
    lsort [glob -directory $globname *]
} [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 {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -join * b1]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [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 {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type d *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -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 {
    set dir [pwd]
} -constraints {notRoot linkDirectory} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type l *]
} -cleanup {
    cd $dir
    file delete [file join $globname link]
} -result [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]]
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 {
    set dir [pwd]
} -constraints {linkDirectory} -body {
    cd $globname
    file mkdir nonexistent
    file link -symbolic link nonexistent
    file delete nonexistent
    cd $dir
    lsort [glob -nocomplain -directory $globname -type l *]
} -cleanup {







|










|












|














|

















|







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
    lsort [glob -directory $globname *]
} [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 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 {
    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
    file delete [file join $globname link]
} -result [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 {
    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
    file delete [file join $globname link]
} -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 {
    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
    file delete [file join $globname link]
} -result [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]]
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 {
    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 {
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
    lsort [glob -path $globname/ *]
} [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} {
    lsort [glob -path $globname/ *]
} [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.19 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [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} {
    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 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} {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.21 {Tcl_GlobCmd} {
    lsort [glob -type d -path $globname *]
} [list $globname]







|
















|








|







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
    lsort [glob -path $globname/ *]
} [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 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 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [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 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 a2]\
	[file join $globname a3]]]
test filename-11.21 {Tcl_GlobCmd} {
    lsort [glob -type d -path $globname *]
} [list $globname]
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
    lsort [glob -dir $globname *]
} [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} {
    lsort [glob -dir $globname *]
} [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.23 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [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} {
    lsort [glob -path $globname/ *]
} [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.24 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [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} {
    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 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} {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.1 {Tcl_GlobCmd} {
    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} {
    lsort [glob -type {d r w} -dir $globname *]
} [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]







|
















|
















|








|




|




|







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
    lsort [glob -dir $globname *]
} [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 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 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [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 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 {Tcl_GlobCmd} {unix} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [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 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 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]]]
test filename-11.26 {Tcl_GlobCmd} {
    glob -type d -path $globname *
} [list $globname]
1080
1081
1082
1083
1084
1085
1086






1087
1088
1089
1090
1091
1092
1093
} -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}







file rename $horribleglobname globTest
file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname

test filename-12.1 {simple globbing} {unixOrWin} {







>
>
>
>
>
>







1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
} -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.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} {
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
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
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} {
    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} {
    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} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]







|


|








|







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
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
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} {
    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} {
    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} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
test filename-14.25 {type specific globbing} {unix} {
    lsort [glob -dir globTest -types f *]
} [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} {
    lsort [glob -dir globTest -types f *]
} [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]]]







|







1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
test filename-14.25 {type specific globbing} {unix} {
    lsort [glob -dir globTest -types f *]
} [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 "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
Changes to tests/fileSystem.test.
33
34
35
36
37
38
39


40
41
42
43
44
45
46
47
    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]








>
>
|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
    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]]
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv           [expr {![info exists ::env(CI)]}]

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]

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
} 1
test filesystem-1.37 {file normalisation with '/./'} -body {
    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 dir [pwd]
} -constraints {win moreThanOneDrive knownMsvcBug} -body {
    set path "[string range [lindex $drives 0] 0 1]foo"
    cd [lindex $drives 1]
    file norm $path
} -cleanup {
    cd $dir
} -result "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} -setup {







|







314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
} 1
test filesystem-1.37 {file normalisation with '/./'} -body {
    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 dir [pwd]
} -constraints {win moreThanOneDrive notInCIenv} -body {
    set path "[string range [lindex $drives 0] 0 1]foo"
    cd [lindex $drives 1]
    file norm $path
} -cleanup {
    cd $dir
} -result "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} -setup {
Changes to tests/for-old.test.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	set a [concat $a $i]
    }
    set a
} {1 2 3 4 5}
test for-old-1.2 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 continue
	set a [concat $a $i]
    }
    set a
} {1 2 3 5}
test for-old-1.3 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1
test for-old-1.5 {for tests} {
    catch {for 1 2 3} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
test for-old-1.7 {for tests} {
    catch {for 1 2 3 4 5} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.8 {for tests} {
    set a {xyz}
    for {set i 1} {$i<6} {set i [expr $i+1]} {}
    set a
} xyz
test for-old-1.9 {for tests} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]; if $i==4 break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return







|






|
|






|
|
















|




|








18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	set a [concat $a $i]
    }
    set a
} {1 2 3 4 5}
test for-old-1.2 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} continue
	set a [concat $a $i]
    }
    set a
} {1 2 3 5}
test for-old-1.3 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-old-1.4 {for tests} {catch {for 1 2 3} msg} 1
test for-old-1.5 {for tests} {
    catch {for 1 2 3} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.6 {for tests} {catch {for 1 2 3 4 5} msg} 1
test for-old-1.7 {for tests} {
    catch {for 1 2 3 4 5} msg
    set msg
} {wrong # args: should be "for start test next command"}
test for-old-1.8 {for tests} {
    set a {xyz}
    for {set i 1} {$i<6} {incr i} {}
    set a
} xyz
test for-old-1.9 {for tests} {
    set a {}
    for {set i 1} {$i<6} {incr i; if {$i==4} break} {
	set a [concat $a $i]
    }
    set a
} {1 2 3}

# cleanup
::tcltest::cleanupTests
return
Changes to tests/for.test.
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
catch {unset a}
test for-1.9 {TclCompileForCmd: simple command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-1.10 {TclCompileForCmd: command body in quotes} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
    set a
} {xxxxx}
test for-1.11 {TclCompileForCmd: computed command body} {
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
    set a
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
    catch {for {set i 0} {$i < 5} {set} {format $i}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test for-1.13 {TclCompileForCmd: long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|






|










|










|
|
|







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
catch {unset a}
test for-1.9 {TclCompileForCmd: simple command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-1.10 {TclCompileForCmd: command body in quotes} {
    set a {}
    for {set i 1} {$i<6} {incr i} "append a x"
    set a
} {xxxxx}
test for-1.11 {TclCompileForCmd: computed command body} {
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    for {set i 1} {$i<6} {incr i} $x1$bb$x2
    set a
} {x1}
test for-1.12 {TclCompileForCmd: error in "next" command} -body {
    catch {for {set i 0} {$i < 5} {set} {format $i}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test for-1.13 {TclCompileForCmd: long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
    set a
} {1 2 3}
test for-1.14 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {}]
    set a
} {}
test for-1.15 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {if $i==3 break}]
    set a
} {}

# Check "for" and "continue".

test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
    catch {continue foo} msg
    set msg
} {wrong # args: should be "continue"}
test for-2.2 {TclCompileContinueCmd: continue result} {
    catch continue
} 4
test for-2.3 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
	if {$i == 2} continue
	set a [concat $a $i]
    }
    set a
} {1 3 4}
test for-2.4 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {set i [expr $i+1]} {
	if {$i != 2} continue
	set a [concat $a $i]
    }
    set a
} {2}
test for-2.5 {continue tests, nested loops} {
    set msg {}
    for {set i 1} {$i <= 4} {incr i} {
	for {set a 1} {$a <= 2} {incr a} {
            if {$i>=2 && $a>=2} continue
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-2.6 {continue tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==2 continue
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|














|







|

















|
|
|
|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
    set a
} {1 2 3}
test for-1.14 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {}]
    set a
} {}
test for-1.15 {TclCompileForCmd: for command result} {
    set a [for {set i 0} {$i < 5} {incr i} {if {$i==3} break}]
    set a
} {}

# Check "for" and "continue".

test for-2.1 {TclCompileContinueCmd: arguments after "continue"} {
    catch {continue foo} msg
    set msg
} {wrong # args: should be "continue"}
test for-2.2 {TclCompileContinueCmd: continue result} {
    catch continue
} 4
test for-2.3 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {incr i} {
	if {$i == 2} continue
	set a [concat $a $i]
    }
    set a
} {1 3 4}
test for-2.4 {continue tests} {
    set a {}
    for {set i 1} {$i <= 4} {incr i} {
	if {$i != 2} continue
	set a [concat $a $i]
    }
    set a
} {2}
test for-2.5 {continue tests, nested loops} {
    set msg {}
    for {set i 1} {$i <= 4} {incr i} {
	for {set a 1} {$a <= 2} {incr a} {
            if {$i>=2 && $a>=2} continue
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-2.6 {continue tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==2} continue
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-3.5 {break tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==2 continue
	if $i==5 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|
|
|















|







242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
            set msg [concat $msg "$i.$a"]
        }
    }
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test for-3.5 {break tests, long command body} {
    set a {}
    for {set i 1} {$i<6} {incr i} {
	if {$i==2} continue
	if {$i==5} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
	    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







|







382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
	    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
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
		append result $line $NL
		if {[string length $F1] == 0} {
		    set F1 -1
		}
		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]]
	    if {! $continuation} {
		append result $newline $NL







|




|










|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
		append result $line $NL
		if {[string length $F1] == 0} {
		    set F1 -1
		}
		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]]
	    if {! $continuation} {
		append result $newline $NL
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
}

# Check that "break" resets the interpreter's result

test for-4.1 {break must reset the interp result} {
    catch {
        set z GLOBTESTDIR/dir2/file2.c
        if [string match GLOBTESTDIR/dir2/* $z] {
            break
        }
    } j
    set j
} {}

# Test for incorrect "double evaluation" semantics







|







581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
}

# Check that "break" resets the interpreter's result

test for-4.1 {break must reset the interp result} {
    catch {
        set z GLOBTESTDIR/dir2/file2.c
        if {[string match GLOBTESTDIR/dir2/* $z]} {
            break
        }
    } j
    set j
} {}

# Test for incorrect "double evaluation" semantics
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
"set"
    ("for" body line 1)
    invoked from within
"$z {set i 0} {$i < 5} {incr i} {set}"}
test for-6.10 {Tcl_ForObjCmd: simple command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} "append a x"
    set a
} {xxxxx}
test for-6.12 {Tcl_ForObjCmd: computed command body} {
    set z for
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} $x1$bb$x2
    set a
} {x1}
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
    set z for
    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"
    ("for" loop-end command)
    invoked from within
"$z {set i 0} {$i < 5} {set} {set j 4}"}
test for-6.14 {Tcl_ForObjCmd: long command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {set i [expr $i+1]} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|







|











|















|
|
|







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
"set"
    ("for" body line 1)
    invoked from within
"$z {set i 0} {$i < 5} {incr i} {set}"}
test for-6.10 {Tcl_ForObjCmd: simple command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	set a [concat $a $i]
    }
    set a
} {1 2 3}
test for-6.11 {Tcl_ForObjCmd: command body in quotes} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} "append a x"
    set a
} {xxxxx}
test for-6.12 {Tcl_ForObjCmd: computed command body} {
    set z for
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2}
    set a {}
    $z {set i 1} {$i<6} {incr i} $x1$bb$x2
    set a
} {x1}
test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
    set z for
    catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"
    ("for" loop-end command)
    invoked from within
"$z {set i 0} {$i < 5} {set} {set j 4}"}
test for-6.14 {Tcl_ForObjCmd: long command body} {
    set z for
    set a {}
    $z {set i 1} {$i<6} {incr i} {
	if {$i==4} break
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
Changes to tests/format.test.
16
17
18
19
20
21
22



23
24
25
26
27
28
29
30
}

# %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)]}]

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}







>
>
>
|







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

# %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}]
# 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 knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]

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}
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 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}


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







|


|


|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 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 0d6 0d34 0d16923 -0d12}
test format-1.14 {integer formatting} {
    format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1
} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}
test format-1.15 {integer formatting} {
    format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1
} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}


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
Changes to tests/get.test.
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
    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"}}








|



|

|



|







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
    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 " " 007 " " 0o10 " " 0b10 "} {
	catch {testgetint 44 $x} x
	set x
    }
} {44 44 44 44 54 51 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
    lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
	catch {testdoubleobj set 1 $x} x
	set x
    }
} {0.0 0.0 0.0 0.0 0.0 7.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"}}

Changes to tests/history.test.
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

# "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]} \
	{Another test}
test history-1.4 {event option} history {history event set} \
	{set b [format {A test %s} string]}
test history-1.5 {event option} history {history e "* a*"} \
	{set a 12345}
test history-1.6 {event option} history {catch {history event *gorp} msg} 1
test history-1.7 {event option} history {







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

# "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}]} \
	{Another test}
test history-1.4 {event option} history {history event set} \
	{set b [format {A test %s} string]}
test history-1.5 {event option} history {history e "* a*"} \
	{set a 12345}
test history-1.6 {event option} history {catch {history event *gorp} msg} 1
test history-1.7 {event option} history {
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177


178
179
180
181
182
183
184
    history add set\ c\ {a\nb\nc}
}
test history-5.1 {info option} history {history info} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr $num+1] [expr $num+2]]
test history-5.2 {info option} history {history i 2} [format {%6d  set b 1234
%6d  set c {a
	b
	c}} [expr $num+1] [expr $num+2]]
test history-5.3 {info option} history {catch {history i 2 3}} 1
test history-5.4 {info option} history {
    catch {history i 2 3} msg
    set msg
} {wrong # args: should be "history info ?count?"}
test history-5.5 {info option} history {history} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr $num+1] [expr $num+2]]

# "history keep"

if {[testConstraint history]} {
    history add "foo1"
    history add "foo2"
    history add "foo3"
    history keep 2
}
test history-6.1 {keep option} history {history event [expr [history n]-1]} foo3


test history-6.2 {keep option} history {history event -1} foo2
test history-6.3 {keep option} history {catch {history event -3}} 1
test history-6.4 {keep option} history {
    catch {history event -3} msg
    set msg
} {event "-3" is too far in the past}
if {[testConstraint history]} {







|



|










|









|
>
>







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    history add set\ c\ {a\nb\nc}
}
test history-5.1 {info option} history {history info} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr {$num+1}] [expr {$num+2}]]
test history-5.2 {info option} history {history i 2} [format {%6d  set b 1234
%6d  set c {a
	b
	c}} [expr {$num+1}] [expr {$num+2}]]
test history-5.3 {info option} history {catch {history i 2 3}} 1
test history-5.4 {info option} history {
    catch {history i 2 3} msg
    set msg
} {wrong # args: should be "history info ?count?"}
test history-5.5 {info option} history {history} [format {%6d  set a {b
	c d e}
%6d  set b 1234
%6d  set c {a
	b
	c}} $num [expr {$num+1}] [expr {$num+2}]]

# "history keep"

if {[testConstraint history]} {
    history add "foo1"
    history add "foo2"
    history add "foo3"
    history keep 2
}
test history-6.1 {keep option} history {
    history event [expr {[history n]-1}]
} foo3
test history-6.2 {keep option} history {history event -1} foo2
test history-6.3 {keep option} history {catch {history event -3}} 1
test history-6.4 {keep option} history {
    catch {history event -3} msg
    set msg
} {event "-3" is too far in the past}
if {[testConstraint history]} {
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

if {[testConstraint history]} {
    set num [history n]
    history add "Testing"
    history add "Testing2"
}
test history-7.1 {nextid option} history {history event} "Testing"
test history-7.2 {nextid option} history {history next} [expr $num+2]
test history-7.3 {nextid option} history {catch {history nextid garbage}} 1
test history-7.4 {nextid option} history {
    catch {history nextid garbage} msg
    set msg
} {wrong # args: should be "history nextid"}

# "history clear"







|







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

if {[testConstraint history]} {
    set num [history n]
    history add "Testing"
    history add "Testing2"
}
test history-7.1 {nextid option} history {history event} "Testing"
test history-7.2 {nextid option} history {history next} [expr {$num+2}]
test history-7.3 {nextid option} history {catch {history nextid garbage}} 1
test history-7.4 {nextid option} history {
    catch {history nextid garbage} msg
    set msg
} {wrong # args: should be "history nextid"}

# "history clear"
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
	    # 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]
    }







|







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
	    # 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]
    }
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
	    # 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]
    }







|







286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
	    # 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]
    }
Changes to tests/http.test.
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
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 {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>







|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
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 {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
440
441
442
443
444
445
446



447
448
449
450
451
452
453
# Bug 838e99a76d
test http-3.33 {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-4.1 {http::Event} -body {
    set token [http::geturl $url -keepalive 0]
    upvar #0 $token data
    array set meta $data(meta)
    expr {($data(totalsize) == $meta(Content-Length))}
} -cleanup {







>
>
>







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
# Bug 838e99a76d
test http-3.33 {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 {
    set token [http::geturl $url -keepalive 0]
    upvar #0 $token data
    array set meta $data(meta)
    expr {($data(totalsize) == $meta(Content-Length))}
} -cleanup {
Changes to tests/httpcookie.test.
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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







|
<
<
<
|







12
13
14
15
16
17
18
19



20
21
22
23
24
25
26
27
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands

testConstraint notMacCI [expr {![info exists ::env(MAC_CI)]}]



testConstraint sqlite3 [expr {[testConstraint notMacCI] && ![catch {
    package require sqlite3
}]}]
testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch {
    package require cookiejar
}]}]

set COOKIEJAR_VERSION 0.2.0
Changes to tests/if.test.
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a







|







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;







|







456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {







|







481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a







|







504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
		    set i $i
		    set i [lindex $s $i]
		}
		if {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z







|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1<2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 2
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;







|







994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 3
    } elseif 1==2 then { #; this if arm should be taken
	set a 4
	while {$a != "xxx"} {
	    break;
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 5
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;







|







1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 6
    } else {
	set a 7
	while {$a != "xxx"} {
	    break;
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {







|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 8
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z







|







1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
		    set i $i
		    set i [lindex $s $i]
		}
		$z {[string compare $a "bar"] < 0} {
		    set i $i
		    set i [lindex $s $i]
		}
		incr i -1
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z
Changes to tests/info.test.
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
        set y [info level 1]
        list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
        t2 [expr $a*2] $b
    }
    proc t2 {x y} {
        list [info level] [info level 1] [info level 2] [info level -1] \
                [info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}







|







321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
        set y [info level 1]
        list $x $y
    }
    t1 146 testString
} {1 {t1 146 testString}}
test info-9.3 {info level option} {
    proc t1 {a b} {
        t2 [expr {$a*2}] $b
    }
    proc t2 {x y} {
        list [info level] [info level 1] [info level 2] [info level -1] \
                [info level 0]
    }
    t1 146 {a {b c} {{{c}}}}
} {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
Changes to tests/interp.test.
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# 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
} -match glob -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.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-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
} -match glob -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
} -match glob -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
} -match glob -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"}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a







|

















|


|


|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# 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.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-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"}

# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create 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
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
    expr $anothernum > $thenum
} 1
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    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] {
    interp delete $i







|








|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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
    expr {$anothernum > $thenum}
} 1
test interp-2.12 {anonymous interps vs existing procs} {
    set x [interp create -safe]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create -safe]
    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] {
    interp delete $i
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
} 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.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"}








|





|


|





|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
} 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.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"}

742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
} ""
test interp-16.5 {testing deletion order, bgerror} {
    catch {interp delete xxx}
    interp create xxx
    xxx eval {proc bgerror {args} {exit}}
    xxx alias exit kill xxx
    proc kill {i} {interp delete $i}
    xxx eval after 100 expr a + b
    after 200
    update
    interp exists xxx
} 0

#
# Alias loop prevention testing.







|







742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
} ""
test interp-16.5 {testing deletion order, bgerror} {
    catch {interp delete xxx}
    interp create xxx
    xxx eval {proc bgerror {args} {exit}}
    xxx alias exit kill xxx
    proc kill {i} {interp delete $i}
    xxx eval after 100 expr {a + b}
    after 200
    update
    interp exists xxx
} 0

#
# Alias loop prevention testing.
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    set l
} {foo {}}
test interp-19.9 {alias deletion, renaming} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr 34 * 34}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156

test interp-20.1 {interp hide, interp expose and interp invokehidden} {







|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    set l
} {foo {}}
test interp-19.9 {alias deletion, renaming} {
    catch {interp delete a}
    interp create a
    interp alias a foo a bar
    interp eval a rename foo blotz
    interp eval a {proc foo {} {expr {34 * 34}}}
    interp alias a foo {}
    set l [interp eval a foo]
    interp delete a
    set l
} 1156

test interp-20.1 {interp hide, interp expose and interp invokehidden} {
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
    }
    # We use a time limit here; command limits don't trap this case
    $i limit time -seconds [expr {[clock seconds]+2}]
    $i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
    interp delete $i
}
test interp-34.4 {limits with callbacks: extending limits} -setup {
    set i [interp create]
    set a 0







|







3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
    }
    # We use a time limit here; command limits don't trap this case
    $i limit time -seconds [expr {[clock seconds] + 2}]
    $i eval foobar
} -returnCodes error -result {time limit exceeded} -cleanup {
    interp delete $i
}
test interp-34.4 {limits with callbacks: extending limits} -setup {
    set i [interp create]
    set a 0
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 [expr $curlim+100]" \
	    -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}







|
|







3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 [expr {$curlim + 100}]" \
	    -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 {}" -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}







|







3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
	global c i
	set c b
	$i limit command -value $newlimit
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command "cb2 {}" -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
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
	global c i
	set c b
	$i limit command -value {} -command {}
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command cb2 -value [expr {$curlim+10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
    set i [interp create]
    $i eval {
	set i [interp create]
	proc cb1 {} {
	    global c
	    incr ::$c
	}
	proc cb2 {args} {
	    global c i curlim
	    set c b
	    $i limit command -value [expr {$curlim+1000}]
	    trapToParent
	}
    }
    proc cb3 {} {
	global i subi
	interp alias [list $i $subi] foo {} cb4
	interp delete $i







|


















|







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
	global c i
	set c b
	$i limit command -value {} -command {}
    }
} -body {
    interp alias $i foo {} cb1
    set curlim [$i eval info cmdcount]
    $i limit command -command cb2 -value [expr {$curlim + 10}]
    $i eval {for {set i 0} {$i<10} {incr i} {foo}}
    list $a $b $c
} -result {6 4 b} -cleanup {
    interp delete $i
    rename cb1 {}
    rename cb2 {}
}
test interp-34.7 {limits with callbacks: deleting the handler interp} -setup {
    set i [interp create]
    $i eval {
	set i [interp create]
	proc cb1 {} {
	    global c
	    incr ::$c
	}
	proc cb2 {args} {
	    global c i curlim
	    set c b
	    $i limit command -value [expr {$curlim + 1000}]
	    trapToParent
	}
    }
    proc cb3 {} {
	global i subi
	interp alias [list $i $subi] foo {} cb4
	interp delete $i
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
    set n 0
    $i eval {
	set a 0
	set b 0
	set c a
	interp alias $i foo {} cb1
	set curlim [$i eval info cmdcount]
	$i limit command -command cb2 -value [expr {$curlim+10}]
    }
    $i eval {
	$i eval {
	    for {set i 0} {$i<10} {incr i} {foo}
	}
    }
    list $n [interp exists $i]
} -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
    $i eval {
	set x {}
	vwait x
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {limit exceeded}







|














|







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
    set n 0
    $i eval {
	set a 0
	set b 0
	set c a
	interp alias $i foo {} cb1
	set curlim [$i eval info cmdcount]
	$i limit command -command cb2 -value [expr {$curlim + 10}]
    }
    $i eval {
	$i eval {
	    for {set i 0} {$i<10} {incr i} {foo}
	}
    }
    list $n [interp exists $i]
} -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
    $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
    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}]"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}







|
|







3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
    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}]"
    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
	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 ::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
	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 ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626

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
    interp delete a
} -result {26 26}

test interp-38.1 {interp debug one-way switch} -setup {
    catch {interp delete a}







|
|







3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626

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
    interp delete a
} -result {26 26}

test interp-38.1 {interp debug one-way switch} -setup {
    catch {interp delete a}
Changes to tests/io.test.
39
40
41
42
43
44
45



46
47
48
49
50
51
52
53
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
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







>
>
>
|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]
testConstraint testservicemode  [llength [info commands testservicemode]]
# Some things fail under Windows in Continuous Integration systems for subtle
# reasons such as CI often running with elevated privileges in a container.
testConstraint notWinCI [expr {
    $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
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
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
    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} {
    # 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 {







|







2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
    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 notWinCI} {
    # 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 {
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
    # allow a little time for the background process to close.
    # 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} {
    # 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}







|







2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
    # allow a little time for the background process to close.
    # 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 notWinCI} {
    # 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}
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
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    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} {
    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
    set in [open "|[list [interpreter] $path(pipe)]" r+]
    set out [open $path(test1) w]
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    set fcopyTestDone	;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {







|


















|







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
    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
    set in [open $thisScript]	;# 126 K
    set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
    catch {unset fcopyTestDone}
    close $listen	;# This means the socket open never really succeeds
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    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} {
    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
    set in [open "|[list [interpreter] $path(pipe)]" r+]
    set out [open $path(test1) w]
    fcopy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    set fcopyTestDone	;# 0 for plain end of file
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
	exit 0
    }
    close $f1
    set in [open "|[list [interpreter] $path(pipe) &]" r+]
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    # -1=error 0=script error N=number of bytes
    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}







|







7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
	exit 0
    }
    close $f1
    set in [open "|[list [interpreter] $path(pipe) &]" r+]
    set out [open $path(test1) w]
    doFcopy $in $out
    variable fcopyTestDone
    if {![info exists fcopyTestDone]} {
	vwait [namespace which -variable fcopyTestDone]
    }
    catch {close $in}
    close $out
    # -1=error 0=script error N=number of bytes
    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} {3450}
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
    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
	fconfigure $s -translation lf
	puts $s "line 1\nline2\nline3"







|







8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
8143
8144
8145
    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 notWinCI} {
    # 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
	fconfigure $s -translation lf
	puts $s "line 1\nline2\nline3"
Changes to tests/lindex.test.
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
test lindex-3.4 {integer 3} -constraints testevalex -body {
    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 {*}}
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 {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {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 {}]







|



|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
test lindex-3.4 {integer 3} -constraints testevalex -body {
    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 {*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 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} -body {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {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 {}]
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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 {*}}
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 {*}}
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}]







|



|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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 {*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 {*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}]
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
	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 {*}}
test lindex-11.6 {bad octal} -body {
    set x -0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}

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







|



|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
	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 {*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 {*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
	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 {*}}
test lindex-12.7 {bad octal} -body {
    set x end--0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
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 {







|



|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
	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 {*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 {*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 {
Changes to tests/list.test.
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
concat {}

# Check that tclListObj.c's SetListFromAny handles possible overlarge
# string rep lengths in the source object.

proc slowsort list {
    set result {}
    set last [expr [llength $list] - 1]
    while {$last > 0} {
	set minIndex [expr [llength $list] - 1]
	set min [lindex $list $last]
	set i [expr $minIndex-1]
	while {$i >= 0} {
	    if {[string compare [lindex $list $i] $min] < 0} {
		set minIndex $i
		set min [lindex $list $i]
	    }
	    set i [expr $i-1]
	}
	set result [concat $result [list $min]]
	if {$minIndex == 0} {
	    set list [lrange $list 1 end]
	} else {
	    set list [concat [lrange $list 0 [expr $minIndex-1]] \
			  [lrange $list [expr $minIndex+1] end]]
	}
	set last [expr $last-1]
    }
    return [concat $result $list]
}
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}








|

|

|





|





|
|

|







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
concat {}

# Check that tclListObj.c's SetListFromAny handles possible overlarge
# string rep lengths in the source object.

proc slowsort list {
    set result {}
    set last [expr {[llength $list] - 1}]
    while {$last > 0} {
	set minIndex [expr {[llength $list] - 1}]
	set min [lindex $list $last]
	set i [expr {$minIndex - 1}]
	while {$i >= 0} {
	    if {[string compare [lindex $list $i] $min] < 0} {
		set minIndex $i
		set min [lindex $list $i]
	    }
	    incr i -1
	}
	set result [concat $result [list $min]]
	if {$minIndex == 0} {
	    set list [lrange $list 1 end]
	} else {
	    set list [concat [lrange $list 0 [expr {$minIndex - 1}]] \
			  [lrange $list [expr {$minIndex + 1}] end]]
	}
	set last [expr {$last - 1}]
    }
    return [concat $result $list]
}
test list-3.1 {SetListFromAny and lrange/concat results} {
    slowsort {fred julie alex carol bill annie}
} {alex annie bill carol fred julie}

Changes to tests/load.test.
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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?\"}"
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?\"}"
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
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load -lazy {} {}} 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_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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} -returnCodes error -body {
    load
} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
test load-1.2 {basic errors} -returnCodes error -body {
    load a b c d
} -result {wrong # args: should be "load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?"}
test load-1.3 {basic errors} -returnCodes error -body {
    load a b foobar
} -result {could not find interpreter "foobar"}
test load-1.4 {basic errors} -returnCodes error -body {
    load -global {}
} -result {must specify either file name or package name}
test load-1.5 {basic errors} -returnCodes error -body {
    load -lazy {} {}
} -result {must specify either file name or package name}
test load-1.6 {basic errors} -returnCodes error -body {
    load {} Unknown
} -result {package "Unknown" isn't loaded statically}
test load-1.7 {basic errors} -returnCodes error -body {
    load -abc foo
} -result {bad option "-abc": must be -global, -lazy, or --}
test load-1.8 {basic errors} -returnCodes error -body {
    load -global
} -result {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_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
126
127
128
129
130
131
132
133
134
135
136

137
138
139

140
141
142
143
144
145
146
147
148
149
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -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\""

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 {} 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
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {







|
<


>


|
>

<
|







126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141

142
143
144
145
146
147
148
149
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -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\""

test load-5.1 {file name not specified and no static package: pick default} -setup {

    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    info loaded x
} -cleanup {
    interp delete x

} -result [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
181
182
183
184
185
186
187
188
189

190
191
192
193
194
195
196
197


198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231


232
233
234
235



236
237
238
239
240



241
242
243
244
245
246
247
    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]

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.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}]
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}}} \
    -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}








|
|
>




|
<
<
<
>
>



















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

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







181
182
183
184
185
186
187
188
189
190
191
192
193
194
195



196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217


218
219
220
221

222
223
224

225
226
227
228
229
230

231
232
233
234
235
236

237
238
239
240
241
242
243
244
245
246
247
248
249
    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]

testConstraint teststaticpkg_8.x 0
if {[testConstraint teststaticpkg]} {
    catch {
	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	testConstraint teststaticpkg_8.x 1



    }
}

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.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}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup {


    interp create child1
    interp create child2
    load {} Tcltest child1
    load {} Tcltest child2

} -constraints {teststaticpkg} -body {
    child1 eval { teststaticpkg Loadninepointone 0 1 }
    child2 eval { teststaticpkg Loadninepointone 0 1 }

    list [child1 eval { info loaded {} }] \
	[child2 eval { info loaded {} }]
} -match glob -cleanup {
    interp delete child1
    interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}


test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -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}

Changes to tests/lsearch.test.
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {3 5}
test lsearch-14.8 {combinations: -start, -inline and -not} {
    lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4}

test lsearch-15.1 {make sure no shimmering occurs} {
    set x [expr int(sin(0))]
    lsearch -start $x $x $x
} 0

test lsearch-16.1 {lsearch -regexp shared object} {
    set str a
    lsearch -regexp $str $str
} 0







|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
    lsearch -start 2 -all -not -glob {a1 b2 a3 c4 a5 d6} a*
} {3 5}
test lsearch-14.8 {combinations: -start, -inline and -not} {
    lsearch -start 2 -inline -not -glob {a1 b2 a3 c4 a5 d6} a*
} {c4}

test lsearch-15.1 {make sure no shimmering occurs} {
    set x [expr {int(sin(0))}]
    lsearch -start $x $x $x
} 0

test lsearch-16.1 {lsearch -regexp shared object} {
    set str a
    lsearch -regexp $str $str
} 0
Changes to tests/mathop.test.
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    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 "+"}
    test mathop-1.12 {compiled +: errors} -returnCodes error -body {
	+ nan 0
    } -result {can't use non-numeric floating-point value "nan" 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 "+"}
    test mathop-1.14 {compiled +: errors} -returnCodes error -body {
	+ 0 nan
    } -result {can't use non-numeric floating-point value "nan" 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 "+"}
    test mathop-1.16 {compiled +: errors} -returnCodes error -body {
	+ 0 0o8
    } -result {can't use non-numeric string "0o8" 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]







|


|


|


|


|


|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    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 as operand of "+"}
    test mathop-1.12 {compiled +: errors} -returnCodes error -body {
	+ nan 0
    } -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 as operand of "+"}
    test mathop-1.14 {compiled +: errors} -returnCodes error -body {
	+ 0 nan
    } -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 invalid octal number as operand of "+"}
    test mathop-1.16 {compiled +: errors} -returnCodes error -body {
	+ 0 0o8
    } -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
    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 "+"}
    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 "+"}
    test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" 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 "+"}
    test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" 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 "+"}
    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







|


|


|


|


|


|







148
149
150
151
152
153
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 as operand of "+"}
    test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
	$op nan 0
    } -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 as operand of "+"}
    test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
	$op 0 nan
    } -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 invalid octal number as operand of "+"}
    test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
	$op 0 0o8
    } -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
    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 "*"}
    test mathop-2.12 {compiled *: errors} -returnCodes error -body {
	* nan 0
    } -result {can't use non-numeric floating-point value "nan" 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 "*"}
    test mathop-2.14 {compiled *: errors} -returnCodes error -body {
	* 0 nan
    } -result {can't use non-numeric floating-point value "nan" 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 "*"}
    test mathop-2.16 {compiled *: errors} -returnCodes error -body {
	* 0 0o8
    } -result {can't use non-numeric string "0o8" 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]







|


|


|


|


|


|







185
186
187
188
189
190
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 as operand of "*"}
    test mathop-2.12 {compiled *: errors} -returnCodes error -body {
	* nan 0
    } -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 as operand of "*"}
    test mathop-2.14 {compiled *: errors} -returnCodes error -body {
	* 0 nan
    } -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 invalid octal number as operand of "*"}
    test mathop-2.16 {compiled *: errors} -returnCodes error -body {
	* 0 0o8
    } -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
    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 "*"}
    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 "*"}
    test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" 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 "*"}
    test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" 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 "*"}
    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 "!"}
    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 "!"}
    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 "!"}
    test mathop-3.22 {interpreted !: error} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" 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 "~"}
    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 "~"}
    test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
	~ NaN
    } -result {can't use non-numeric floating-point value "NaN" 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 "~"}
    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 "~"}
    test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" 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







|


|


|


|


|


|


















|
















|








|


|










|








|


|










|








|


|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
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 as operand of "*"}
    test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
	$op nan 0
    } -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 as operand of "*"}
    test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
	$op 0 nan
    } -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 invalid octal number as operand of "*"}
    test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
	$op 0 0o8
    } -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 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 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 as operand of "!"}
    test mathop-3.22 {interpreted !: error} -returnCodes error -body {
	$op NaN
    } -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 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 as operand of "~"}
    test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
	~ NaN
    } -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 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 as operand of "~"}
    test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
	$op NaN
    } -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

    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 "&"}
    test mathop-6.6 {compiled &} -returnCodes error -body {
	& 1 2 3.0
    } -result {can't use floating-point value "3.0" 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 "&"}
    test mathop-6.12 {compiled &: errors} -returnCodes error -body {
	& nan 0
    } -result {can't use non-numeric floating-point value "nan" 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 "&"}
    test mathop-6.14 {compiled &: errors} -returnCodes error -body {
	& 0 nan
    } -result {can't use non-numeric floating-point value "nan" 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 "&"}
    test mathop-6.16 {compiled &: errors} -returnCodes error -body {
	& 0 0o8
    } -result {can't use non-numeric string "0o8" 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 "&"}
    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 "&"}
    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 "&"}
    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 "&"}
    test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" 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 "&"}
    test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" 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 "&"}
    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







|


|






|


|


|


|


|


|
















|


|






|


|


|


|


|


|







373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
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 as operand of "&"}
    test mathop-6.6 {compiled &} -returnCodes error -body {
	& 1 2 3.0
    } -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 as operand of "&"}
    test mathop-6.12 {compiled &: errors} -returnCodes error -body {
	& nan 0
    } -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 as operand of "&"}
    test mathop-6.14 {compiled &: errors} -returnCodes error -body {
	& 0 nan
    } -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 invalid octal number as operand of "&"}
    test mathop-6.16 {compiled &: errors} -returnCodes error -body {
	& 0 0o8
    } -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 as operand of "&"}
    test mathop-6.24 {interpreted &} -returnCodes error -body {
	$op 1 2 3.0
    } -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 as operand of "&"}
    test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
	$op nan 0
    } -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 as operand of "&"}
    test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
	$op 0 nan
    } -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 invalid octal number as operand of "&"}
    test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
	$op 0 0o8
    } -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

    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 "|"}
    test mathop-7.6 {compiled |} -returnCodes error -body {
	| 1 2 3.0
    } -result {can't use floating-point value "3.0" 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 "|"}
    test mathop-7.12 {compiled |: errors} -returnCodes error -body {
	| nan 0
    } -result {can't use non-numeric floating-point value "nan" 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 "|"}
    test mathop-7.14 {compiled |: errors} -returnCodes error -body {
	| 0 nan
    } -result {can't use non-numeric floating-point value "nan" 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 "|"}
    test mathop-7.16 {compiled |: errors} -returnCodes error -body {
	| 0 0o8
    } -result {can't use non-numeric string "0o8" 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 "|"}
    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 "|"}
    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 "|"}
    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 "|"}
    test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" 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 "|"}
    test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" 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 "|"}
    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







|


|






|


|


|


|


|


|
















|


|






|


|


|


|


|


|







483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
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 as operand of "|"}
    test mathop-7.6 {compiled |} -returnCodes error -body {
	| 1 2 3.0
    } -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 as operand of "|"}
    test mathop-7.12 {compiled |: errors} -returnCodes error -body {
	| nan 0
    } -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 as operand of "|"}
    test mathop-7.14 {compiled |: errors} -returnCodes error -body {
	| 0 nan
    } -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 invalid octal number as operand of "|"}
    test mathop-7.16 {compiled |: errors} -returnCodes error -body {
	| 0 0o8
    } -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 as operand of "|"}
    test mathop-7.24 {interpreted |} -returnCodes error -body {
	$op 1 2 3.0
    } -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 as operand of "|"}
    test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
	$op nan 0
    } -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 as operand of "|"}
    test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
	$op 0 nan
    } -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 invalid octal number as operand of "|"}
    test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
	$op 0 0o8
    } -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

    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 "^"}
    test mathop-8.6 {compiled ^} -returnCodes error -body {
	^ 1 2 3.0
    } -result {can't use floating-point value "3.0" 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 "^"}
    test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
	^ nan 0
    } -result {can't use non-numeric floating-point value "nan" 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 "^"}
    test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
	^ 0 nan
    } -result {can't use non-numeric floating-point value "nan" 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 "^"}
    test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
	^ 0 0o8
    } -result {can't use non-numeric string "0o8" 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 "^"}
    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 "^"}
    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 "^"}
    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 "^"}
    test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" 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 "^"}
    test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" 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 "^"}
    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







|


|






|


|


|


|


|


|
















|


|






|


|


|


|


|


|







593
594
595
596
597
598
599
600
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 as operand of "^"}
    test mathop-8.6 {compiled ^} -returnCodes error -body {
	^ 1 2 3.0
    } -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 as operand of "^"}
    test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
	^ nan 0
    } -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 as operand of "^"}
    test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
	^ 0 nan
    } -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 invalid octal number as operand of "^"}
    test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
	^ 0 0o8
    } -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 as operand of "^"}
    test mathop-8.24 {interpreted ^} -returnCodes error -body {
	$op 1 2 3.0
    } -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 as operand of "^"}
    test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
	$op nan 0
    } -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 as operand of "^"}
    test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
	$op 0 nan
    } -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 invalid octal number as operand of "^"}
    test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
	$op 0 0o8
    } -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
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
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\"\
		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\"\
	    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}} {







|





|







771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
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 as operand of \"$op\"\
		ARITH DOMAIN {non-numeric string}"
        }
    }
    foreach op {+ * / & | ^ **} {
	lappend res [TestOp $op NaN 1]
	lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
	    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}} {
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
    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 res [TestOp - x]
    lappend exp "can't use non-numeric string \"x\" 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 res [TestOp ! x]
    lappend exp "can't use non-numeric string \"x\" 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}"
    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]} {







|

|

|

|

|







846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
    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 as operand of \"/\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp - x]
    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 as operand of \"~\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ! x]
    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 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]} {
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
        foreach op {& | ^} {
            lappend res [TestOp $op {*}$vals]
        }
    }
    set exp {}
    foreach d {5 7 2  1 D C  1 F E  0 -D -D  8 -9 -1  -0 -E E} {
        if {[string match "-*" $d]} {
            set d [format %X [expr 15-0x[string range $d 1 end]]]
            set val [expr -0x[string repeat $d $dig]-1]
        } else {
            set val [expr 0x[string repeat $d $dig]]
        }
        lappend exp $val
    }
    expr {$exp eq $res ? 1 : "($res != $exp"}
} 1
test mathop-22.3 { bitwise ops } {
    set big1      12135435435354435435342423948763867876







|
|

|







897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
        foreach op {& | ^} {
            lappend res [TestOp $op {*}$vals]
        }
    }
    set exp {}
    foreach d {5 7 2  1 D C  1 F E  0 -D -D  8 -9 -1  -0 -E E} {
        if {[string match "-*" $d]} {
            set d [format %X [expr {15-"0x[string range $d 1 end]"}]]
            set val [expr {-"0x[string repeat $d $dig]"-1}]
        } else {
            set val [expr {"0x[string repeat $d $dig]"}]
        }
        lappend exp $val
    }
    expr {$exp eq $res ? 1 : "($res != $exp"}
} 1
test mathop-22.3 { bitwise ops } {
    set big1      12135435435354435435342423948763867876
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
           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 res [TestOp $op 5 x]
        lappend exp "can't use non-numeric string \"x\" 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}}







|

|







961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
           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 as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 5 x]
        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
                                              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 res [TestOp $op 1 x]
        lappend exp "can't use non-numeric string \"x\" 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 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}"
    }
    foreach op {in ni} {
        lappend res [TestOp $op 5 "a b \{ c"]
        lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
    }
    lappend res [TestOp % 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"







|

|



|

|







1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
                                              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 as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 1 x]
        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 as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend res [TestOp $op 1 5.0]
        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 res [TestOp % 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
    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 res [TestOp ** foo 2]
    lappend exp "can't use non-numeric string \"foo\" 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







|

|







1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
    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 as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ** foo 2]
    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
Changes to tests/namespace-old.test.
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
        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}] \
         [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 {test_ns_cmd_global}]
} {{} {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]







<

|

|

|







289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308
        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.4 {nested namespaces can access global namespace} {
    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 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var 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]
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
}
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}
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"
    }
    list [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
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}
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"} {







<



|
|








<






|
|
<





|
|
|







464
465
466
467
468
469
470

471
472
473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
}
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}}

test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    namespace eval test_ns_cache1 $trigger
} {global version}
    set trigger {set test_ns_cache_var}
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"

test namespace-old-6.14 {deleting variables changes variable epoch} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    list [namespace eval test_ns_cache1 $trigger] \
	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
	[namespace eval test_ns_cache1 $trigger]
} {{cache1 version} {} {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}
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}
set trigger2 {set test_ns_cache2::test_ns_cache_var}
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"} {
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
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?







|





|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
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?
Changes to tests/namespace.test.
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    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]
        namespace eval foo {
            lappend ::l [namespace current]
        }
    }
    lappend l [namespace current]
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }







|

|







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    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]
        namespace eval foo {
            lappend l [namespace current]
        }
    }
    lappend l [namespace current]
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
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
    }
} -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"}}

# TIP 278: secondary lookup disabled, results changed from {10 20}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
    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 [catch {set v} msg] $msg  [catch {set test_ns_2::v} msg] $msg
    }
} -result {1 {can't read "v": no such variable} 0 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







<
<











|
<

|
<







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


test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
    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

    }
} -result {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
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
    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}}

# TIP 278: secondary lookup disabled, added catch, result changed from y
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        catch {set test_ns_1::(x) y} ::msg
    }
    list $::msg [catch {set test_ns_1::(x)} msg] $msg
} -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 {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
	proc {} {} {}
	namespace eval {} {}
	{}







<
<





|

|
|







718
719
720
721
722
723
724


725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
    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}}


test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        set test_ns_1::(x) y
    }
    set test_ns_1::(x)
} -result y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
	proc {} {} {}
	namespace eval {} {}
	{}
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
        variable x 777
    }
} -body {
    namespace eval test_ns_1 {
        set x
    }
} -result {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
    }
} {1 {can't read "x": no such variable}}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
    namespace eval test_ns_1 {
        set wuzzat
    }
} -returnCodes error -result {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 {
    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
catch {unset a}
catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}







<
<




|

|











<
<













|







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
        variable x 777
    }
} -body {
    namespace eval test_ns_1 {
        set x
    }
} -result {777}


test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
	variable x 777
        unset x
        set x  ;# must be global x now
    }
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
    namespace eval test_ns_1 {
        set wuzzat
    }
} -returnCodes error -result {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}


test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
    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 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 {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
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
    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}

# TIP 278: secondary lookup disabled, catch added, result changed
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
    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 \
             [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 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]







<
<



















|




|







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


test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
    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 [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 {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
Changes to tests/oo.test.
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
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







|











|







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







|













|







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
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]
Changes to tests/opt.test.
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38


#### functions tests #####

set n $::tcl::OptDescN

test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}]
} "$n [expr $n+1] [expr $n+2]"

test opt-2.1 {OptKeyDelete} {
    list [::tcl::OptKeyRegister {} testkey] \
	    [info exists ::tcl::OptDesc(testkey)] \
	    [::tcl::OptKeyDelete testkey] \
	    [info exists ::tcl::OptDesc(testkey)]
} {testkey 1 {} 0}







|
|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38


#### functions tests #####

set n $::tcl::OptDescN

test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr {$n+1}]] [::tcl::OptKeyRegister {}]
} "$n [expr {$n+1}] [expr {$n+2}]"

test opt-2.1 {OptKeyDelete} {
    list [::tcl::OptKeyRegister {} testkey] \
	    [info exists ::tcl::OptDesc(testkey)] \
	    [::tcl::OptKeyDelete testkey] \
	    [info exists ::tcl::OptDesc(testkey)]
} {testkey 1 {} 0}
Changes to tests/parse.test.
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
	variable ::aresult
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set ::aresult xxx
    set ::acode yyy
} -cleanup {
    testasync delete
} -body {
    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]}







|
|



|







372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
	variable ::aresult
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set aresult xxx
    set acode yyy
} -cleanup {
    testasync delete
} -body {
    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]}
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
test parse-10.1 {Tcl_EvalTokens, simple text} testevalex {
    testevalex {concat test}
} {test}
test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex {
    testevalex {concat test\063\062test}
} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
    testevalex {concat [expr 2 + 6]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
    set a hello
    testevalex {concat $a}
} {hello}
test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(1[expr 3 - 1])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a







|

















|







477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
test parse-10.1 {Tcl_EvalTokens, simple text} testevalex {
    testevalex {concat test}
} {test}
test parse-10.2 {Tcl_EvalTokens, backslash sequences} testevalex {
    testevalex {concat test\063\062test}
} {test32test}
test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
    testevalex {concat [expr {2 + 6}]}
} {8}
test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
    set a hello
    testevalex {concat $a}
} {hello}
test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(12)}
} {46}
test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    set a(12) 46
    testevalex {concat $a(1[expr {3 - 1}])}
} {46}
test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
    list [catch {testevalex {concat $x($a)}} msg] $msg
} {1 {can't read "a": no such variable}}
test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
    unset -nocomplain a
Changes to tests/parseExpr.test.
1070
1071
1072
1073
1074
1075
1076








1077
1078
1079
1080
} -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*}
test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser in\u0433(0) -1
} -returnCodes error -match glob -result {missing operand*}









# cleanup
cleanupTests
return







>
>
>
>
>
>
>
>




1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
} -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*}
test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser in\u0433(0) -1
} -returnCodes error -match glob -result {missing operand*}

test parseExpr-23.1 {TIP 582: comments} -constraints testexprparser -body {
    testexprparser "7 # * 8 " -1
} -result {- {} 0 subexpr 7 1 text 7 0 {}}
test parseExpr-23.2 {TIP 582: comments} -constraints testexprparser -body {
    testexprparser "7 #\n* 8 " -1
} -result {- {} 0 subexpr {7 #
*} 5 operator # 0 subexpr 7 1 text 7 0 subexpr * 1 text * 0 {}}

# cleanup
cleanupTests
return
Changes to tests/parseOld.test.
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
format %s $b

]b
    set a
} a22b
test parseOld-4.4 {command substitution} {
    set a 7.7
    if [catch {expr int($a)}] {set a foo}
    set a
} 7.7

# Variable substitution.

test parseOld-5.1 {variable substitution} {
    set a 123







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
format %s $b

]b
    set a
} a22b
test parseOld-4.4 {command substitution} {
    set a 7.7
    if {[catch {expr {int($a)}}]} {set a foo}
    set a
} 7.7

# Variable substitution.

test parseOld-5.1 {variable substitution} {
    set a 123
Changes to tests/pkgMkIndex.test.
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
#  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.
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}}}}}








|












|







311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
#  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.
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}}}}}

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422

makeFile {
package provide pkg3 1.0
namespace eval pkg3 {
    namespace export p3-1 p3-2
}
proc pkg3::p3-1 { num } {
    return {[expr $num * 2]}
}
proc pkg3::p3-2 { num } {
    return {[expr $num * 3]}
}
} [file join pkg pkg3.tcl]

test pkgMkIndex-6.1 {pkg1 requires pkg3} {
    pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}








|


|







405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422

makeFile {
package provide pkg3 1.0
namespace eval pkg3 {
    namespace export p3-1 p3-2
}
proc pkg3::p3-1 { num } {
    return {[expr {$num * 2}]}
}
proc pkg3::p3-2 { num } {
    return {[expr {$num * 3}]}
}
} [file join pkg pkg3.tcl]

test pkgMkIndex-6.1 {pkg1 requires pkg3} {
    pkgtest::runIndex -lazy $fullPkgPath pkg1.tcl pkg3.tcl
} {0 {{pkg1:1.0 {tclPkgSetup {pkg1.tcl source {::pkg1::p1-1 ::pkg1::p1-2}}}} {pkg3:1.0 {tclPkgSetup {pkg3.tcl source {::pkg3::p3-1 ::pkg3::p3-2}}}}}}

516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
#  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.
package require circ1 1.0







|


|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
#  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.
package require circ1 1.0
Changes to tests/proc-old.test.
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

catch {rename t1 ""}
catch {rename foo ""}

proc tproc {} {return a; return b}
test proc-old-1.1 {simple procedure call and return} {tproc} a
proc tproc x {
    set x [expr $x+1]
    return $x
}
test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
test proc-old-1.3 {simple procedure call and return} {
    proc tproc {} {return foo}
} {}
test proc-old-1.4 {simple procedure call and return} {







|







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

catch {rename t1 ""}
catch {rename foo ""}

proc tproc {} {return a; return b}
test proc-old-1.1 {simple procedure call and return} {tproc} a
proc tproc x {
    set x [expr {$x + 1}]
    return $x
}
test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
test proc-old-1.3 {simple procedure call and return} {
    proc tproc {} {return foo}
} {}
test proc-old-1.4 {simple procedure call and return} {
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    set x {}
    proc tproc {} {}   ;# body is shared with x
    list [tproc] [append x foo]
} {{} foo}

test proc-old-2.1 {local and global variables} {
    proc tproc x {
	set x [expr $x+1]
	return $x
    }
    set x 42
    list [tproc 6] $x
} {7 42}
test proc-old-2.2 {local and global variables} {
    proc tproc x {
	set y [expr $x+1]
	return $y
    }
    set y 18
    list [tproc 6] $y
} {7 18}
test proc-old-2.3 {local and global variables} {
    proc tproc x {
	global y
	set y [expr $x+1]
	return $y
    }
    set y 189
    list [tproc 6] $y
} {7 7}
test proc-old-2.4 {local and global variables} {
    proc tproc x {
	global y
	return [expr $x+$y]
    }
    set y 189
    list [tproc 6] $y
} {195 189}
catch {unset _undefined_}
test proc-old-2.5 {local and global variables} {
    proc tproc x {







|







|








|








|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    set x {}
    proc tproc {} {}   ;# body is shared with x
    list [tproc] [append x foo]
} {{} foo}

test proc-old-2.1 {local and global variables} {
    proc tproc x {
	set x [expr {$x + 1}]
	return $x
    }
    set x 42
    list [tproc 6] $x
} {7 42}
test proc-old-2.2 {local and global variables} {
    proc tproc x {
	set y [expr {$x + 1}]
	return $y
    }
    set y 18
    list [tproc 6] $y
} {7 18}
test proc-old-2.3 {local and global variables} {
    proc tproc x {
	global y
	set y [expr {$x + 1}]
	return $y
    }
    set y 189
    list [tproc 6] $y
} {7 7}
test proc-old-2.4 {local and global variables} {
    proc tproc x {
	global y
	return [expr {$x + $y}]
    }
    set y 189
    list [tproc 6] $y
} {195 189}
catch {unset _undefined_}
test proc-old-2.5 {local and global variables} {
    proc tproc x {
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
} 1

test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
    proc t1 x {
        set y 20
        rename expr expr.old
        rename expr.old expr
        if $x then {t1 0} ;# recursive call after foo's code is invalidated
        return 20
    }
    t1 1
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::tcltest::cleanupTests
return







|










500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
} 1

test proc-old-10.1 {ByteCode epoch change during recursive proc execution} {
    proc t1 x {
        set y 20
        rename expr expr.old
        rename expr.old expr
        if {$x} then {t1 0} ;# recursive call after foo's code is invalidated
        return 20
    }
    t1 1
} 20

# cleanup
catch {rename t1 ""}
catch {rename foo ""}
::tcltest::cleanupTests
return
Changes to tests/proc.test.
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
         [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 {
    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 {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {







|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
         [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 {
    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 {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
Changes to tests/pwd.test.
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0
test pwd-1.2 {simple pwd} {
    expr [string length pwd]>0
} 1

test pwd-1.3 {pwd takes no args} -body {
    pwd foobar
} -returnCodes error -result "wrong \# args: should be \"pwd\""

# cleanup
::tcltest::cleanupTests
return







|

>
|






16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0
test pwd-1.2 {simple pwd} {
    expr {[string length [pwd]]>0}
} 1

test pwd-2.1 {pwd takes no args} -body {
    pwd foobar
} -returnCodes error -result "wrong \# args: should be \"pwd\""

# cleanup
::tcltest::cleanupTests
return
Changes to tests/registry.test.
20
21
22
23
24
25
26

27
28
29
30
31
32
33
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}


# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]








>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

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} -body {
    registry broadcast {Environment}
} -result {1 0}
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:







|


|












670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
} -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 {
    registry broadcast {Environment}
} -result {1 0}
test registry-12.5 {BroadcastValue} -constraints {win reg notWine} -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.
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
    if {[info exists env(serverPort)]} {
	set serverPort $env(serverPort)
    }
}
if {![info exists serverPort]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -port [lindex $argv $i]] == 0} {
	    if {$i < [expr $argc - 1]} {
		set serverPort [lindex $argv [expr $i + 1]]
	    }
	    break
	}
    }
}
if {![info exists serverPort]} {
    set serverPort 2048
}

if {![info exists serverAddress]} {
    if {[info exists env(serverAddress)]} {
	set serverAddress $env(serverAddress)
    }
}
if {![info exists serverAddress]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -address [lindex $argv $i]] == 0} {
	    if {$i < [expr $argc - 1]} {
		set serverAddress [lindex $argv [expr $i + 1]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0







|
|

















|
|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
    if {[info exists env(serverPort)]} {
	set serverPort $env(serverPort)
    }
}
if {![info exists serverPort]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -port [lindex $argv $i]] == 0} {
	    if {$i < $argc - 1} {
		set serverPort [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverPort]} {
    set serverPort 2048
}

if {![info exists serverAddress]} {
    if {[info exists env(serverAddress)]} {
	set serverAddress $env(serverAddress)
    }
}
if {![info exists serverAddress]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[string compare -address [lindex $argv $i]] == 0} {
	    if {$i < $argc - 1} {
		set serverAddress [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0
Changes to tests/result.test.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
    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}
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}
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








|











|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
    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 presentOrFreed}
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 presentOrFreed}
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

Changes to tests/safe.test.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# - 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-stock87.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.








|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# - 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.

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
test safe-4.6 {safe::interpDelete, indirectly} -setup {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    a eval exit
} -result ""

# The old test "safe-5.1" has been moved to "safe-stock87-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.

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 {







|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
test safe-4.6 {safe::interpDelete, indirectly} -setup {
    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.

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 {
Changes to tests/socket.test.
65
66
67
68
69
70
71


72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
    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
}


# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
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 {} {
    # firstly try dynamic port via server-socket(0):
    set port 0x7fffffff
    catch {







>
>
|


>




|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    namespace import -force ::tcltest::*
}

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

# A bad interaction between socket creation, macOS, and unattended CI
# environments make this whole file impractical to run; too many weird hangs.
if {[info exists ::env(MAC_CI)]} {
    return
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint exec [llength [info commands exec]]
testConstraint knownMsvcBug [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]

# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} {
    # firstly try dynamic port via server-socket(0):
    set port 0x7fffffff
    catch {
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
    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} {
    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







|







733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
    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} {
    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
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
    puts $f [list set localhost $localhost]
    puts $f {
	gets stdin port
	socket $localhost $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]
    puts $f [lindex [fconfigure $s -sockname] 2]
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s







|







967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
    puts $f [list set localhost $localhost]
    puts $f {
	gets stdin port
	socket $localhost $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]
    puts $f [lindex [fconfigure $s -sockname] 2]
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
    fileevent $c readable "readlittle $c"
    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] -setup {
    set counter 0
    set done 0
    set port [sendCommand {
	set server [socket -server accept 0]
	proc accept {s a p} {
	    after idle close $s
	}







|







1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
    fileevent $c readable "readlittle $c"
    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 {
    set counter 0
    set done 0
    set port [sendCommand {
	set server [socket -server accept 0]
	proc accept {s a p} {
	    after idle close $s
	}
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
        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} \
    -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} \







|







2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
        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} \
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
        set x
    } -cleanup {
        close $s
        unset x s
    } -result {connection refused}

test socket-14.13 {testing writable event when quick failure} \
    -constraints {socket win supported_inet} \
    -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







|







2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
        set x
    } -cleanup {
        close $s
        unset x s
    } -result {connection refused}

test socket-14.13 {testing writable event when quick failure} \
    -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
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
} -cleanup {
        catch {close $ssock}
        catch {close $csock1}
        catch {close $csock2}
    } -result {}

test socket-14.19 {tip 456 -- introduce the -reuseport option} \
    -constraints {socket} \
    -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 {







|







2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
} -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 {
Changes to tests/string.test.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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 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
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        set lines [split [memory info] \n]







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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 testevalex [expr {[info commands testevalex] ne {}}]
testConstraint utf16 [expr {[string length \U010000] == 2}]
testConstraint testbytestring   [llength [info commands testbytestring]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        set lines [split [memory info] \n]
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
    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, too few 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







|







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
    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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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 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 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}
} -1
test string-2.13.1.$noComp {string compare -nocase} {







|



|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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
    # 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
    # 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}
} -1
test string-2.13.1.$noComp {string compare -nocase} {
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
} 1
test string-3.7.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abcde}
} 1
test string-3.8.$noComp {string equal with length, unequal strings} {
    run {string equal -length 2 abc abde}
} 1
test string-3.9.$noComp {string equal, too few 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







|







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
} 1
test string-3.7.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abcde}
} 1
test string-3.8.$noComp {string equal with length, unequal strings} {
    run {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
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
    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, too few 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







|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
    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
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
test string-5.16.$noComp {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}
} 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.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, too few args} {
    list [catch {run {string is}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2.$noComp {string is, too few args} {
    list [catch {run {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
} {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







|


|
|

|



|

|











|


|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
test string-5.16.$noComp {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}
} 0
test string-5.17.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.18.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.19.$noComp {string index, bytearray object out of bounds} {
    run {string index [binary format I* {0x50515253 0x52}] -1}
} {}
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.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints utf16 -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
} {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
} {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
} {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
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
} {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.$noComp {string last, too few 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
} {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







|







969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
} {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.$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
} {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
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
test string-9.6.$noComp {string length, bytearray object} {
    run {string length [binary format a5 foo]}
} 5
test string-9.7.$noComp {string length, bytearray object} {
    run {string length [binary format I* {0x50515253 0x52}]}
} 8

test string-10.1.$noComp {string map, too few args} {
    list [catch {run {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
} {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







|







1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
test string-9.6.$noComp {string length, bytearray object} {
    run {string length [binary format a5 foo]}
} 5
test string-9.7.$noComp {string length, bytearray object} {
    run {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
} {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
} {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
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
    run {string map {lon foob longstring bar} longlon}
} foobgfoob
test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} {
    set a {a b}
    run {string map $a $a}
} {b b}

test string-11.1.$noComp {string match, too few args} {
    list [catch {run {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
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.3.$noComp {string match} {
    run {string match abc abc}







|







1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
    run {string map {lon foob longstring bar} longlon}
} foobgfoob
test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} {
    set a {a b}
    run {string map $a $a}
} {b b}

test string-11.1.$noComp {string match, not enough args} {
    list [catch {run {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
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.3.$noComp {string match} {
    run {string match abc abc}
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22.$noComp {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    run {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







|

|







1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22.$noComp {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    run {string range $s $s end}
} 000000001
test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} utf16 {
    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
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
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.$noComp {string tolower too few args} {
    list [catch {run {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
} {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







|







1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
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.$noComp {string tolower not enough args} {
    list [catch {run {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
} {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
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
} "Abcabc\xE7\xE7"
test string-17.7.$noComp {string totitle, unicode} {
    run {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
} {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
} {1 {wrong # args: should be "string trim string ?chars?"}}







|


|







1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
} "Abcabc\xE7\xE7"
test string-17.7.$noComp {string totitle, unicode} {
    run {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]} utf16 {
    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
} {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
} {1 {wrong # args: should be "string trim string ?chars?"}}
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
} -result 3
test string-21.14.$noComp {string wordend, unicode} -body {
    run {string wordend "\uC700\uC700 abc" 8}
} -result 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"}}







|

|







1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
} -result 3
test string-21.14.$noComp {string wordend, unicode} -body {
    run {string wordend "\uC700\uC700 abc" 8}
} -result 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 utf16 -body {
    run {string wordend "\U1D7CA\U1D7CA abc" 10}
} -result 8

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"}}
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    # See Bug c61818e4c9
    set demo [testbytestring "abc def\xE0\xA9ghi"]
    run {string index $demo [string wordstart $demo 10]}
} -result 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 {
    set x 5
    catch {testindexobj $x foo bar soom}
    run {string is boolean $x}
} 0
test string-23.1.$noComp {string is command with empty string} {







|

|







1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
    # See Bug c61818e4c9
    set demo [testbytestring "abc def\xE0\xA9ghi"]
    run {string index $demo [string wordstart $demo 10]}
} -result 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 utf16 -body {
    run {string wordstart "\U1D7CA\U1D7CA abc" 10}
} -result 5

test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj {
    set x 5
    catch {testindexobj $x foo bar soom}
    run {string is boolean $x}
} 0
test string-23.1.$noComp {string is command with empty string} {
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
    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}

test string-26.1.$noComp {tcl::prefix, too few 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







|







2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
    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}

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
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
        # Use the same objects in all places
        catch {
            tcl::prefix match -error $error $table $item
        }
    }
} -constraints memory -result {0}

test string-27.1.$noComp {tcl::prefix all, too few 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







|







2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
        # Use the same objects in all places
        catch {
            tcl::prefix match -error $error $table $item
        }
    }
} -constraints memory -result {0}

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
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
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, too few 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







|







2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
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
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
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 UTF8 handling
    tcl::prefix longest {ax\x90 bep ax\x91} a
} ax

test string-29.1.$noComp {string cat, no arg} {
    run {string cat}
} ""
test string-29.2.$noComp {string cat, single arg} {







|







2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
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-29.1.$noComp {string cat, no arg} {
    run {string cat}
} ""
test string-29.2.$noComp {string cat, single arg} {
2473
2474
2475
2476
2477
2478
2479







2480
2481
2482
2483
2484
2485
2486
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-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







>
>
>
>
>
>
>







2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
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
Changes to tests/stringObj.test.
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33

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








|
>







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

::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 tip389 [expr {[string length \U010000] == 2}]
testConstraint nodep [info exists tcl_precision]

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1

461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
    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} {
    teststringobj set 1 foo
    teststringobj appendself2 1 0
} foofoo
test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
    teststringobj set 1 foo
    teststringobj appendself2 1 1
} foooo
test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
    teststringobj set 1 foo
    teststringobj appendself2 1 2
} fooo
test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
    teststringobj set 1 foo
    teststringobj appendself2 1 3
} foo

if {[testConstraint testobj]} {
    testobj freeallvars
}







|



|



|



|







462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
    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 tip389 nodep} {
    teststringobj set 1 foo
    teststringobj appendself2 1 0
} foofoo
test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
    teststringobj set 1 foo
    teststringobj appendself2 1 1
} foooo
test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
    teststringobj set 1 foo
    teststringobj appendself2 1 2
} fooo
test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 nodep} {
    teststringobj set 1 foo
    teststringobj appendself2 1 3
} foo

if {[testConstraint testobj]} {
    testobj freeallvars
}
Changes to tests/subst.test.
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    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.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}
} {abc 123 [expr 1+2] \A}
test subst-7.6 {switches} {
    set x 123
    subst -novariables {abc $x [expr 1+2] \\\x41}
} {abc $x 3 \A}
test subst-7.7 {switches} {
    set x 123
    subst -nov -nob -noc {abc $x [expr 1+2] \\\x41}
} {abc $x [expr 1+2] \\\x41}

test subst-8.1 {return in a subst} {
    subst {foo [return {x}; bogus code] bar}
} {foo x bar}
test subst-8.2 {return in a subst} {
    subst {foo [return x ; bogus code] bar}
} {foo x bar}







|



|
|


|



|
|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    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.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}
} {abc 123 [expr {1 + 2}] \A}
test subst-7.6 {switches} {
    set x 123
    subst -novariables {abc $x [expr {1 + 2}] \\\x41}
} {abc $x 3 \A}
test subst-7.7 {switches} {
    set x 123
    subst -nov -nob -noc {abc $x [expr {1 + 2}] \\\x41}
} {abc $x [expr {1 + 2}] \\\x41}

test subst-8.1 {return in a subst} {
    subst {foo [return {x}; bogus code] bar}
} {foo x bar}
test subst-8.2 {return in a subst} {
    subst {foo [return x ; bogus code] bar}
} {foo x bar}
Changes to tests/tcltest.test.
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    -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...







<







540
541
542
543
544
545
546

547
548
549
550
551
552
553
    -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...
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
}
test tcltest-23.2 {removeFile} {
    -setup {
	set mfdir [file join [temporaryDirectory] mfdir]
	file mkdir $mfdir
	makeFile {} t1.tmp
	makeFile {} et1.tmp $mfdir
	if  {![file exists [file join [temporaryDirectory] t1.tmp]] || \
		![file exists [file join $mfdir et1.tmp]]} {
	    error "file creation didn't work"
	}
    }
    -body {
	removeFile t1.tmp
	removeFile et1.tmp $mfdir







|







1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
}
test tcltest-23.2 {removeFile} {
    -setup {
	set mfdir [file join [temporaryDirectory] mfdir]
	file mkdir $mfdir
	makeFile {} t1.tmp
	makeFile {} et1.tmp $mfdir
	if {![file exists [file join [temporaryDirectory] t1.tmp]] || \
		![file exists [file join $mfdir et1.tmp]]} {
	    error "file creation didn't work"
	}
    }
    -body {
	removeFile t1.tmp
	removeFile et1.tmp $mfdir
Changes to tests/trace.test.
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
} {1 {unknown command "thisdoesntexist"}}

test trace-28.10 {exec trace info nonsense} {
    list [catch {trace remove execution} res] $res
} {1 {wrong # args: should be "trace remove execution name opList command"}}

test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [expr 14 + 16]}
} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [info tclversion]}
} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]
test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {







|
|







2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
} {1 {unknown command "thisdoesntexist"}}

test trace-28.10 {exec trace info nonsense} {
    list [catch {trace remove execution} res] $res
} {1 {wrong # args: should be "trace remove execution name opList command"}}

test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [expr {14 + 16}]}
} {{expr {14 + 16}} {expr {14 + 16}} {set stuff [expr {14 + 16}]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace tracetest {set stuff [info tclversion]}
} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
    testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]
test trace-29.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults} {testcmdtrace} {
Changes to tests/unload.test.
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
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}]







<
<
<







34
35
36
37
38
39
40



41
42
43
44
45
46
47
# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]
testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]

set alreadyTotalLoaded [info loaded]




# 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}]
Changes to tests/uplevel.test.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    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}}
}








|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    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}}
}

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    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 {







|







305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    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 {
Changes to tests/utf.test.
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
    string range \uD83D\uDE00G 0 0
} \U1F600
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \uD83D\uDE00G 0 0
} \U1F600
test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \U1F600G 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
} {}
test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \uD83D\uDE00G 2 2
} G







|


|







897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
    string range \uD83D\uDE00G 0 0
} \U1F600
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \uD83D\uDE00G 0 0
} \U1F600
test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \uD83D\uDE00G 1 1
} \uDE00
test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
    string range \uD83D\uDE00G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 1 1
} {}
test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \uD83D\uDE00G 2 2
} G
Changes to tests/util.test.
17
18
19
20
21
22
23



24
25
26
27
28
29
30

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 {







>
>
>







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

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

testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}]


# 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 {
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
    # 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 {
    # 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]
} 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} {







|







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    # 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 {
    # 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]
} 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
    Wrapper_Tcl_StringMatch "" ""
} 1
test util-5.52 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch \[a\u0000 a\x80
} 0


































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}













































# This test always succeeded in the C locale anyway...
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 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 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 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 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 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}







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







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

|













|









|






|







|





|







388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
    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} -constraints 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} -constraints 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} -constraints 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} -constraints 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} -constraints precision -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} -constraints precision  -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} -constraints precision -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} -constraints precision -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} {
    # 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 {
    # 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 {
    # 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 {
    # 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 {
    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 {
    testdstring free
    testdstring append {\\ } -1
    testdstring append \{ -1
    testdstring element foo
    testdstring append \} -1
    list [llength [testdstring get]] [string length [testdstring get]]
} {2 8}
2146
2147
2148
2149
2150
2151
2152












































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































2153
2154
2155
2156
2157
2158
2159
	format %#lx $x
    }
    -result 0x8010000000000000
    -cleanup {
	unset x
    }
}













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    set r {}
    foreach {input} {
	0x1ffffffffffffc000
	0x1ffffffffffffc800
	0x1ffffffffffffd000







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







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
	format %#lx $x
    }
    -result 0x8010000000000000
    -cleanup {
	unset x
    }
}

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} precision \
	"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} precision \
    {expr 1e-300} \
    1e-300
test util-16.1.17.-299 {8.4 compatible formatting of doubles} precision \
    {expr 1e-299} \
    9.9999999999999999e-300
test util-16.1.17.-298 {8.4 compatible formatting of doubles} precision \
    {expr 1e-298} \
    9.9999999999999991e-299
test util-16.1.17.-297 {8.4 compatible formatting of doubles} precision \
    {expr 1e-297} \
    1e-297
test util-16.1.17.-296 {8.4 compatible formatting of doubles} precision \
    {expr 1e-296} \
    1e-296
test util-16.1.17.-295 {8.4 compatible formatting of doubles} precision \
    {expr 1e-295} \
    1.0000000000000001e-295
test util-16.1.17.-294 {8.4 compatible formatting of doubles} precision \
    {expr 1e-294} \
    1e-294
test util-16.1.17.-293 {8.4 compatible formatting of doubles} precision \
    {expr 1e-293} \
    1.0000000000000001e-293
test util-16.1.17.-292 {8.4 compatible formatting of doubles} precision \
    {expr 1e-292} \
    1.0000000000000001e-292
test util-16.1.17.-291 {8.4 compatible formatting of doubles} precision \
    {expr 1e-291} \
    9.9999999999999996e-292
test util-16.1.17.-290 {8.4 compatible formatting of doubles} precision \
    {expr 1e-290} \
    1.0000000000000001e-290
test util-16.1.17.-289 {8.4 compatible formatting of doubles} precision \
    {expr 1e-289} \
    1e-289
test util-16.1.17.-288 {8.4 compatible formatting of doubles} precision \
    {expr 1e-288} \
    1.0000000000000001e-288
test util-16.1.17.-287 {8.4 compatible formatting of doubles} precision \
    {expr 1e-287} \
    1e-287
test util-16.1.17.-286 {8.4 compatible formatting of doubles} precision \
    {expr 1e-286} \
    1.0000000000000001e-286
test util-16.1.17.-285 {8.4 compatible formatting of doubles} precision \
    {expr 1e-285} \
    1.0000000000000001e-285
test util-16.1.17.-284 {8.4 compatible formatting of doubles} precision \
    {expr 1e-284} \
    1e-284
test util-16.1.17.-283 {8.4 compatible formatting of doubles} precision \
    {expr 1e-283} \
    9.9999999999999995e-284
test util-16.1.17.-282 {8.4 compatible formatting of doubles} precision \
    {expr 1e-282} \
    1e-282
test util-16.1.17.-281 {8.4 compatible formatting of doubles} precision \
    {expr 1e-281} \
    1e-281
test util-16.1.17.-280 {8.4 compatible formatting of doubles} precision \
    {expr 1e-280} \
    9.9999999999999996e-281
test util-16.1.17.-279 {8.4 compatible formatting of doubles} precision \
    {expr 1e-279} \
    1.0000000000000001e-279
test util-16.1.17.-278 {8.4 compatible formatting of doubles} precision \
    {expr 1e-278} \
    9.9999999999999994e-279
test util-16.1.17.-277 {8.4 compatible formatting of doubles} precision \
    {expr 1e-277} \
    9.9999999999999997e-278
test util-16.1.17.-276 {8.4 compatible formatting of doubles} precision \
    {expr 1e-276} \
    1.0000000000000001e-276
test util-16.1.17.-275 {8.4 compatible formatting of doubles} precision \
    {expr 1e-275} \
    9.9999999999999993e-276
test util-16.1.17.-274 {8.4 compatible formatting of doubles} precision \
    {expr 1e-274} \
    9.9999999999999997e-275
test util-16.1.17.-273 {8.4 compatible formatting of doubles} precision \
    {expr 1e-273} \
    1.0000000000000001e-273
test util-16.1.17.-272 {8.4 compatible formatting of doubles} precision \
    {expr 1e-272} \
    9.9999999999999993e-273
test util-16.1.17.-271 {8.4 compatible formatting of doubles} precision \
    {expr 1e-271} \
    9.9999999999999996e-272
test util-16.1.17.-270 {8.4 compatible formatting of doubles} precision \
    {expr 1e-270} \
    1e-270
test util-16.1.17.-269 {8.4 compatible formatting of doubles} precision \
    {expr 1e-269} \
    9.9999999999999996e-270
test util-16.1.17.-268 {8.4 compatible formatting of doubles} precision \
    {expr 1e-268} \
    9.9999999999999996e-269
test util-16.1.17.-267 {8.4 compatible formatting of doubles} precision \
    {expr 1e-267} \
    9.9999999999999998e-268
test util-16.1.17.-266 {8.4 compatible formatting of doubles} precision \
    {expr 1e-266} \
    9.9999999999999998e-267
test util-16.1.17.-265 {8.4 compatible formatting of doubles} precision \
    {expr 1e-265} \
    9.9999999999999998e-266
test util-16.1.17.-264 {8.4 compatible formatting of doubles} precision \
    {expr 1e-264} \
    1e-264
test util-16.1.17.-263 {8.4 compatible formatting of doubles} precision \
    {expr 1e-263} \
    1e-263
test util-16.1.17.-262 {8.4 compatible formatting of doubles} precision \
    {expr 1e-262} \
    1e-262
test util-16.1.17.-261 {8.4 compatible formatting of doubles} precision \
    {expr 1e-261} \
    9.9999999999999998e-262
test util-16.1.17.-260 {8.4 compatible formatting of doubles} precision \
    {expr 1e-260} \
    9.9999999999999996e-261
test util-16.1.17.-259 {8.4 compatible formatting of doubles} precision \
    {expr 1e-259} \
    1.0000000000000001e-259
test util-16.1.17.-258 {8.4 compatible formatting of doubles} precision \
    {expr 1e-258} \
    9.9999999999999995e-259
test util-16.1.17.-257 {8.4 compatible formatting of doubles} precision \
    {expr 1e-257} \
    9.9999999999999998e-258
test util-16.1.17.-256 {8.4 compatible formatting of doubles} precision \
    {expr 1e-256} \
    9.9999999999999998e-257
test util-16.1.17.-255 {8.4 compatible formatting of doubles} precision \
    {expr 1e-255} \
    1e-255
test util-16.1.17.-254 {8.4 compatible formatting of doubles} precision \
    {expr 1e-254} \
    9.9999999999999991e-255
test util-16.1.17.-253 {8.4 compatible formatting of doubles} precision \
    {expr 1e-253} \
    1.0000000000000001e-253
test util-16.1.17.-252 {8.4 compatible formatting of doubles} precision \
    {expr 1e-252} \
    9.9999999999999994e-253
test util-16.1.17.-251 {8.4 compatible formatting of doubles} precision \
    {expr 1e-251} \
    1e-251
test util-16.1.17.-250 {8.4 compatible formatting of doubles} precision \
    {expr 1e-250} \
    1.0000000000000001e-250
test util-16.1.17.-249 {8.4 compatible formatting of doubles} precision \
    {expr 1e-249} \
    1.0000000000000001e-249
test util-16.1.17.-248 {8.4 compatible formatting of doubles} precision \
    {expr 1e-248} \
    9.9999999999999998e-249
test util-16.1.17.-247 {8.4 compatible formatting of doubles} precision \
    {expr 1e-247} \
    1e-247
test util-16.1.17.-246 {8.4 compatible formatting of doubles} precision \
    {expr 1e-246} \
    9.9999999999999996e-247
test util-16.1.17.-245 {8.4 compatible formatting of doubles} precision \
    {expr 1e-245} \
    9.9999999999999993e-246
test util-16.1.17.-244 {8.4 compatible formatting of doubles} precision \
    {expr 1e-244} \
    9.9999999999999993e-245
test util-16.1.17.-243 {8.4 compatible formatting of doubles} precision \
    {expr 1e-243} \
    1e-243
test util-16.1.17.-242 {8.4 compatible formatting of doubles} precision \
    {expr 1e-242} \
    9.9999999999999997e-243
test util-16.1.17.-241 {8.4 compatible formatting of doubles} precision \
    {expr 1e-241} \
    9.9999999999999997e-242
test util-16.1.17.-240 {8.4 compatible formatting of doubles} precision \
    {expr 1e-240} \
    9.9999999999999997e-241
test util-16.1.17.-239 {8.4 compatible formatting of doubles} precision \
    {expr 1e-239} \
    1.0000000000000001e-239
test util-16.1.17.-238 {8.4 compatible formatting of doubles} precision \
    {expr 1e-238} \
    9.9999999999999999e-239
test util-16.1.17.-237 {8.4 compatible formatting of doubles} precision \
    {expr 1e-237} \
    9.9999999999999999e-238
test util-16.1.17.-236 {8.4 compatible formatting of doubles} precision \
    {expr 1e-236} \
    1e-236
test util-16.1.17.-235 {8.4 compatible formatting of doubles} precision \
    {expr 1e-235} \
    9.9999999999999996e-236
test util-16.1.17.-234 {8.4 compatible formatting of doubles} precision \
    {expr 1e-234} \
    9.9999999999999996e-235
test util-16.1.17.-233 {8.4 compatible formatting of doubles} precision \
    {expr 1e-233} \
    9.9999999999999996e-234
test util-16.1.17.-232 {8.4 compatible formatting of doubles} precision \
    {expr 1e-232} \
    1e-232
test util-16.1.17.-231 {8.4 compatible formatting of doubles} precision \
    {expr 1e-231} \
    9.9999999999999999e-232
test util-16.1.17.-230 {8.4 compatible formatting of doubles} precision \
    {expr 1e-230} \
    1e-230
test util-16.1.17.-229 {8.4 compatible formatting of doubles} precision \
    {expr 1e-229} \
    1.0000000000000001e-229
test util-16.1.17.-228 {8.4 compatible formatting of doubles} precision \
    {expr 1e-228} \
    1e-228
test util-16.1.17.-227 {8.4 compatible formatting of doubles} precision \
    {expr 1e-227} \
    9.9999999999999994e-228
test util-16.1.17.-226 {8.4 compatible formatting of doubles} precision \
    {expr 1e-226} \
    9.9999999999999992e-227
test util-16.1.17.-225 {8.4 compatible formatting of doubles} precision \
    {expr 1e-225} \
    9.9999999999999996e-226
test util-16.1.17.-224 {8.4 compatible formatting of doubles} precision \
    {expr 1e-224} \
    1e-224
test util-16.1.17.-223 {8.4 compatible formatting of doubles} precision \
    {expr 1e-223} \
    9.9999999999999997e-224
test util-16.1.17.-222 {8.4 compatible formatting of doubles} precision \
    {expr 1e-222} \
    1e-222
test util-16.1.17.-221 {8.4 compatible formatting of doubles} precision \
    {expr 1e-221} \
    1e-221
test util-16.1.17.-220 {8.4 compatible formatting of doubles} precision \
    {expr 1e-220} \
    9.9999999999999999e-221
test util-16.1.17.-219 {8.4 compatible formatting of doubles} precision \
    {expr 1e-219} \
    1e-219
test util-16.1.17.-218 {8.4 compatible formatting of doubles} precision \
    {expr 1e-218} \
    1e-218
test util-16.1.17.-217 {8.4 compatible formatting of doubles} precision \
    {expr 1e-217} \
    1.0000000000000001e-217
test util-16.1.17.-216 {8.4 compatible formatting of doubles} precision \
    {expr 1e-216} \
    1e-216
test util-16.1.17.-215 {8.4 compatible formatting of doubles} precision \
    {expr 1e-215} \
    1e-215
test util-16.1.17.-214 {8.4 compatible formatting of doubles} precision \
    {expr 1e-214} \
    9.9999999999999991e-215
test util-16.1.17.-213 {8.4 compatible formatting of doubles} precision \
    {expr 1e-213} \
    9.9999999999999995e-214
test util-16.1.17.-212 {8.4 compatible formatting of doubles} precision \
    {expr 1e-212} \
    9.9999999999999995e-213
test util-16.1.17.-211 {8.4 compatible formatting of doubles} precision \
    {expr 1e-211} \
    1.0000000000000001e-211
test util-16.1.17.-210 {8.4 compatible formatting of doubles} precision \
    {expr 1e-210} \
    1e-210
test util-16.1.17.-209 {8.4 compatible formatting of doubles} precision \
    {expr 1e-209} \
    1e-209
test util-16.1.17.-208 {8.4 compatible formatting of doubles} precision \
    {expr 1e-208} \
    1.0000000000000001e-208
test util-16.1.17.-207 {8.4 compatible formatting of doubles} precision \
    {expr 1e-207} \
    9.9999999999999993e-208
test util-16.1.17.-206 {8.4 compatible formatting of doubles} precision \
    {expr 1e-206} \
    1e-206
test util-16.1.17.-205 {8.4 compatible formatting of doubles} precision \
    {expr 1e-205} \
    1e-205
test util-16.1.17.-204 {8.4 compatible formatting of doubles} precision \
    {expr 1e-204} \
    1e-204
test util-16.1.17.-203 {8.4 compatible formatting of doubles} precision \
    {expr 1e-203} \
    1e-203
test util-16.1.17.-202 {8.4 compatible formatting of doubles} precision \
    {expr 1e-202} \
    1e-202
test util-16.1.17.-201 {8.4 compatible formatting of doubles} precision \
    {expr 1e-201} \
    9.9999999999999995e-202
test util-16.1.17.-200 {8.4 compatible formatting of doubles} precision \
    {expr 1e-200} \
    9.9999999999999998e-201
test util-16.1.17.-199 {8.4 compatible formatting of doubles} precision \
    {expr 1e-199} \
    9.9999999999999998e-200
test util-16.1.17.-198 {8.4 compatible formatting of doubles} precision \
    {expr 1e-198} \
    9.9999999999999991e-199
test util-16.1.17.-197 {8.4 compatible formatting of doubles} precision \
    {expr 1e-197} \
    9.9999999999999999e-198
test util-16.1.17.-196 {8.4 compatible formatting of doubles} precision \
    {expr 1e-196} \
    1e-196
test util-16.1.17.-195 {8.4 compatible formatting of doubles} precision \
    {expr 1e-195} \
    1.0000000000000001e-195
test util-16.1.17.-194 {8.4 compatible formatting of doubles} precision \
    {expr 1e-194} \
    1e-194
test util-16.1.17.-193 {8.4 compatible formatting of doubles} precision \
    {expr 1e-193} \
    1e-193
test util-16.1.17.-192 {8.4 compatible formatting of doubles} precision \
    {expr 1e-192} \
    1.0000000000000001e-192
test util-16.1.17.-191 {8.4 compatible formatting of doubles} precision \
    {expr 1e-191} \
    1e-191
test util-16.1.17.-190 {8.4 compatible formatting of doubles} precision \
    {expr 1e-190} \
    1e-190
test util-16.1.17.-189 {8.4 compatible formatting of doubles} precision \
    {expr 1e-189} \
    1.0000000000000001e-189
test util-16.1.17.-188 {8.4 compatible formatting of doubles} precision \
    {expr 1e-188} \
    9.9999999999999995e-189
test util-16.1.17.-187 {8.4 compatible formatting of doubles} precision \
    {expr 1e-187} \
    1e-187
test util-16.1.17.-186 {8.4 compatible formatting of doubles} precision \
    {expr 1e-186} \
    9.9999999999999991e-187
test util-16.1.17.-185 {8.4 compatible formatting of doubles} precision \
    {expr 1e-185} \
    9.9999999999999999e-186
test util-16.1.17.-184 {8.4 compatible formatting of doubles} precision \
    {expr 1e-184} \
    1.0000000000000001e-184
test util-16.1.17.-183 {8.4 compatible formatting of doubles} precision \
    {expr 1e-183} \
    1e-183
test util-16.1.17.-182 {8.4 compatible formatting of doubles} precision \
    {expr 1e-182} \
    1e-182
test util-16.1.17.-181 {8.4 compatible formatting of doubles} precision \
    {expr 1e-181} \
    1e-181
test util-16.1.17.-180 {8.4 compatible formatting of doubles} precision \
    {expr 1e-180} \
    1e-180
test util-16.1.17.-179 {8.4 compatible formatting of doubles} precision \
    {expr 1e-179} \
    1e-179
test util-16.1.17.-178 {8.4 compatible formatting of doubles} precision \
    {expr 1e-178} \
    9.9999999999999995e-179
test util-16.1.17.-177 {8.4 compatible formatting of doubles} precision \
    {expr 1e-177} \
    9.9999999999999995e-178
test util-16.1.17.-176 {8.4 compatible formatting of doubles} precision \
    {expr 1e-176} \
    1e-176
test util-16.1.17.-175 {8.4 compatible formatting of doubles} precision \
    {expr 1e-175} \
    1e-175
test util-16.1.17.-174 {8.4 compatible formatting of doubles} precision \
    {expr 1e-174} \
    1e-174
test util-16.1.17.-173 {8.4 compatible formatting of doubles} precision \
    {expr 1e-173} \
    1e-173
test util-16.1.17.-172 {8.4 compatible formatting of doubles} precision \
    {expr 1e-172} \
    1e-172
test util-16.1.17.-171 {8.4 compatible formatting of doubles} precision \
    {expr 1e-171} \
    9.9999999999999998e-172
test util-16.1.17.-170 {8.4 compatible formatting of doubles} precision \
    {expr 1e-170} \
    9.9999999999999998e-171
test util-16.1.17.-169 {8.4 compatible formatting of doubles} precision \
    {expr 1e-169} \
    1e-169
test util-16.1.17.-168 {8.4 compatible formatting of doubles} precision \
    {expr 1e-168} \
    1e-168
test util-16.1.17.-167 {8.4 compatible formatting of doubles} precision \
    {expr 1e-167} \
    1e-167
test util-16.1.17.-166 {8.4 compatible formatting of doubles} precision \
    {expr 1e-166} \
    1e-166
test util-16.1.17.-165 {8.4 compatible formatting of doubles} precision \
    {expr 1e-165} \
    1e-165
test util-16.1.17.-164 {8.4 compatible formatting of doubles} precision \
    {expr 1e-164} \
    9.9999999999999996e-165
test util-16.1.17.-163 {8.4 compatible formatting of doubles} precision \
    {expr 1e-163} \
    9.9999999999999992e-164
test util-16.1.17.-162 {8.4 compatible formatting of doubles} precision \
    {expr 1e-162} \
    9.9999999999999995e-163
test util-16.1.17.-161 {8.4 compatible formatting of doubles} precision \
    {expr 1e-161} \
    1e-161
test util-16.1.17.-160 {8.4 compatible formatting of doubles} precision \
    {expr 1e-160} \
    9.9999999999999999e-161
test util-16.1.17.-159 {8.4 compatible formatting of doubles} precision \
    {expr 1e-159} \
    9.9999999999999999e-160
test util-16.1.17.-158 {8.4 compatible formatting of doubles} precision \
    {expr 1e-158} \
    1.0000000000000001e-158
test util-16.1.17.-157 {8.4 compatible formatting of doubles} precision \
    {expr 1e-157} \
    9.9999999999999994e-158
test util-16.1.17.-156 {8.4 compatible formatting of doubles} precision \
    {expr 1e-156} \
    1e-156
test util-16.1.17.-155 {8.4 compatible formatting of doubles} precision \
    {expr 1e-155} \
    1e-155
test util-16.1.17.-154 {8.4 compatible formatting of doubles} precision \
    {expr 1e-154} \
    9.9999999999999997e-155
test util-16.1.17.-153 {8.4 compatible formatting of doubles} precision \
    {expr 1e-153} \
    1e-153
test util-16.1.17.-152 {8.4 compatible formatting of doubles} precision \
    {expr 1e-152} \
    1.0000000000000001e-152
test util-16.1.17.-151 {8.4 compatible formatting of doubles} precision \
    {expr 1e-151} \
    9.9999999999999994e-152
test util-16.1.17.-150 {8.4 compatible formatting of doubles} precision \
    {expr 1e-150} \
    1e-150
test util-16.1.17.-149 {8.4 compatible formatting of doubles} precision \
    {expr 1e-149} \
    9.9999999999999998e-150
test util-16.1.17.-148 {8.4 compatible formatting of doubles} precision \
    {expr 1e-148} \
    9.9999999999999994e-149
test util-16.1.17.-147 {8.4 compatible formatting of doubles} precision \
    {expr 1e-147} \
    9.9999999999999997e-148
test util-16.1.17.-146 {8.4 compatible formatting of doubles} precision \
    {expr 1e-146} \
    1e-146
test util-16.1.17.-145 {8.4 compatible formatting of doubles} precision \
    {expr 1e-145} \
    9.9999999999999991e-146
test util-16.1.17.-144 {8.4 compatible formatting of doubles} precision \
    {expr 1e-144} \
    9.9999999999999995e-145
test util-16.1.17.-143 {8.4 compatible formatting of doubles} precision \
    {expr 1e-143} \
    9.9999999999999995e-144
test util-16.1.17.-142 {8.4 compatible formatting of doubles} precision \
    {expr 1e-142} \
    1e-142
test util-16.1.17.-141 {8.4 compatible formatting of doubles} precision \
    {expr 1e-141} \
    1e-141
test util-16.1.17.-140 {8.4 compatible formatting of doubles} precision \
    {expr 1e-140} \
    9.9999999999999998e-141
test util-16.1.17.-139 {8.4 compatible formatting of doubles} precision \
    {expr 1e-139} \
    1e-139
test util-16.1.17.-138 {8.4 compatible formatting of doubles} precision \
    {expr 1e-138} \
    1.0000000000000001e-138
test util-16.1.17.-137 {8.4 compatible formatting of doubles} precision \
    {expr 1e-137} \
    9.9999999999999998e-138
test util-16.1.17.-136 {8.4 compatible formatting of doubles} precision \
    {expr 1e-136} \
    1e-136
test util-16.1.17.-135 {8.4 compatible formatting of doubles} precision \
    {expr 1e-135} \
    1e-135
test util-16.1.17.-134 {8.4 compatible formatting of doubles} precision \
    {expr 1e-134} \
    1e-134
test util-16.1.17.-133 {8.4 compatible formatting of doubles} precision \
    {expr 1e-133} \
    1.0000000000000001e-133
test util-16.1.17.-132 {8.4 compatible formatting of doubles} precision \
    {expr 1e-132} \
    9.9999999999999999e-133
test util-16.1.17.-131 {8.4 compatible formatting of doubles} precision \
    {expr 1e-131} \
    9.9999999999999999e-132
test util-16.1.17.-130 {8.4 compatible formatting of doubles} precision \
    {expr 1e-130} \
    1.0000000000000001e-130
test util-16.1.17.-129 {8.4 compatible formatting of doubles} precision \
    {expr 1e-129} \
    9.9999999999999993e-130
test util-16.1.17.-128 {8.4 compatible formatting of doubles} precision \
    {expr 1e-128} \
    1.0000000000000001e-128
test util-16.1.17.-127 {8.4 compatible formatting of doubles} precision \
    {expr 1e-127} \
    1e-127
test util-16.1.17.-126 {8.4 compatible formatting of doubles} precision \
    {expr 1e-126} \
    9.9999999999999995e-127
test util-16.1.17.-125 {8.4 compatible formatting of doubles} precision \
    {expr 1e-125} \
    1e-125
test util-16.1.17.-124 {8.4 compatible formatting of doubles} precision \
    {expr 1e-124} \
    9.9999999999999993e-125
test util-16.1.17.-123 {8.4 compatible formatting of doubles} precision \
    {expr 1e-123} \
    1.0000000000000001e-123
test util-16.1.17.-122 {8.4 compatible formatting of doubles} precision \
    {expr 1e-122} \
    1.0000000000000001e-122
test util-16.1.17.-121 {8.4 compatible formatting of doubles} precision \
    {expr 1e-121} \
    9.9999999999999998e-122
test util-16.1.17.-120 {8.4 compatible formatting of doubles} precision \
    {expr 1e-120} \
    9.9999999999999998e-121
test util-16.1.17.-119 {8.4 compatible formatting of doubles} precision \
    {expr 1e-119} \
    1e-119
test util-16.1.17.-118 {8.4 compatible formatting of doubles} precision \
    {expr 1e-118} \
    9.9999999999999999e-119
test util-16.1.17.-117 {8.4 compatible formatting of doubles} precision \
    {expr 1e-117} \
    1e-117
test util-16.1.17.-116 {8.4 compatible formatting of doubles} precision \
    {expr 1e-116} \
    9.9999999999999999e-117
test util-16.1.17.-115 {8.4 compatible formatting of doubles} precision \
    {expr 1e-115} \
    1.0000000000000001e-115
test util-16.1.17.-114 {8.4 compatible formatting of doubles} precision \
    {expr 1e-114} \
    1.0000000000000001e-114
test util-16.1.17.-113 {8.4 compatible formatting of doubles} precision \
    {expr 1e-113} \
    9.9999999999999998e-114
test util-16.1.17.-112 {8.4 compatible formatting of doubles} precision \
    {expr 1e-112} \
    9.9999999999999995e-113
test util-16.1.17.-111 {8.4 compatible formatting of doubles} precision \
    {expr 1e-111} \
    1.0000000000000001e-111
test util-16.1.17.-110 {8.4 compatible formatting of doubles} precision \
    {expr 1e-110} \
    1.0000000000000001e-110
test util-16.1.17.-109 {8.4 compatible formatting of doubles} precision \
    {expr 1e-109} \
    9.9999999999999999e-110
test util-16.1.17.-108 {8.4 compatible formatting of doubles} precision \
    {expr 1e-108} \
    1e-108
test util-16.1.17.-107 {8.4 compatible formatting of doubles} precision \
    {expr 1e-107} \
    1e-107
test util-16.1.17.-106 {8.4 compatible formatting of doubles} precision \
    {expr 1e-106} \
    9.9999999999999994e-107
test util-16.1.17.-105 {8.4 compatible formatting of doubles} precision \
    {expr 1e-105} \
    9.9999999999999997e-106
test util-16.1.17.-104 {8.4 compatible formatting of doubles} precision \
    {expr 1e-104} \
    9.9999999999999993e-105
test util-16.1.17.-103 {8.4 compatible formatting of doubles} precision \
    {expr 1e-103} \
    9.9999999999999996e-104
test util-16.1.17.-102 {8.4 compatible formatting of doubles} precision \
    {expr 1e-102} \
    9.9999999999999993e-103
test util-16.1.17.-101 {8.4 compatible formatting of doubles} precision \
    {expr 1e-101} \
    1.0000000000000001e-101
test util-16.1.17.-100 {8.4 compatible formatting of doubles} precision \
    {expr 1e-100} \
    1e-100
test util-16.1.17.-99 {8.4 compatible formatting of doubles} precision \
    {expr 1e-99} \
    1e-99
test util-16.1.17.-98 {8.4 compatible formatting of doubles} precision \
    {expr 1e-98} \
    9.9999999999999994e-99
test util-16.1.17.-97 {8.4 compatible formatting of doubles} precision \
    {expr 1e-97} \
    1e-97
test util-16.1.17.-96 {8.4 compatible formatting of doubles} precision \
    {expr 1e-96} \
    9.9999999999999991e-97
test util-16.1.17.-95 {8.4 compatible formatting of doubles} precision \
    {expr 1e-95} \
    9.9999999999999999e-96
test util-16.1.17.-94 {8.4 compatible formatting of doubles} precision \
    {expr 1e-94} \
    9.9999999999999996e-95
test util-16.1.17.-93 {8.4 compatible formatting of doubles} precision \
    {expr 1e-93} \
    9.999999999999999e-94
test util-16.1.17.-92 {8.4 compatible formatting of doubles} precision \
    {expr 1e-92} \
    9.9999999999999999e-93
test util-16.1.17.-91 {8.4 compatible formatting of doubles} precision \
    {expr 1e-91} \
    1e-91
test util-16.1.17.-90 {8.4 compatible formatting of doubles} precision \
    {expr 1e-90} \
    9.9999999999999999e-91
test util-16.1.17.-89 {8.4 compatible formatting of doubles} precision \
    {expr 1e-89} \
    1e-89
test util-16.1.17.-88 {8.4 compatible formatting of doubles} precision \
    {expr 1e-88} \
    9.9999999999999993e-89
test util-16.1.17.-87 {8.4 compatible formatting of doubles} precision \
    {expr 1e-87} \
    1e-87
test util-16.1.17.-86 {8.4 compatible formatting of doubles} precision \
    {expr 1e-86} \
    1.0000000000000001e-86
test util-16.1.17.-85 {8.4 compatible formatting of doubles} precision \
    {expr 1e-85} \
    9.9999999999999998e-86
test util-16.1.17.-84 {8.4 compatible formatting of doubles} precision \
    {expr 1e-84} \
    1e-84
test util-16.1.17.-83 {8.4 compatible formatting of doubles} precision \
    {expr 1e-83} \
    1e-83
test util-16.1.17.-82 {8.4 compatible formatting of doubles} precision \
    {expr 1e-82} \
    9.9999999999999996e-83
test util-16.1.17.-81 {8.4 compatible formatting of doubles} precision \
    {expr 1e-81} \
    9.9999999999999996e-82
test util-16.1.17.-80 {8.4 compatible formatting of doubles} precision \
    {expr 1e-80} \
    9.9999999999999996e-81
test util-16.1.17.-79 {8.4 compatible formatting of doubles} precision \
    {expr 1e-79} \
    1e-79
test util-16.1.17.-78 {8.4 compatible formatting of doubles} precision \
    {expr 1e-78} \
    1e-78
test util-16.1.17.-77 {8.4 compatible formatting of doubles} precision \
    {expr 1e-77} \
    9.9999999999999993e-78
test util-16.1.17.-76 {8.4 compatible formatting of doubles} precision \
    {expr 1e-76} \
    9.9999999999999993e-77
test util-16.1.17.-75 {8.4 compatible formatting of doubles} precision \
    {expr 1e-75} \
    9.9999999999999996e-76
test util-16.1.17.-74 {8.4 compatible formatting of doubles} precision \
    {expr 1e-74} \
    9.9999999999999996e-75
test util-16.1.17.-73 {8.4 compatible formatting of doubles} precision \
    {expr 1e-73} \
    1e-73
test util-16.1.17.-72 {8.4 compatible formatting of doubles} precision \
    {expr 1e-72} \
    9.9999999999999997e-73
test util-16.1.17.-71 {8.4 compatible formatting of doubles} precision \
    {expr 1e-71} \
    9.9999999999999992e-72
test util-16.1.17.-70 {8.4 compatible formatting of doubles} precision \
    {expr 1e-70} \
    1e-70
test util-16.1.17.-69 {8.4 compatible formatting of doubles} precision \
    {expr 1e-69} \
    9.9999999999999996e-70
test util-16.1.17.-68 {8.4 compatible formatting of doubles} precision \
    {expr 1e-68} \
    1.0000000000000001e-68
test util-16.1.17.-67 {8.4 compatible formatting of doubles} precision \
    {expr 1e-67} \
    9.9999999999999994e-68
test util-16.1.17.-66 {8.4 compatible formatting of doubles} precision \
    {expr 1e-66} \
    9.9999999999999998e-67
test util-16.1.17.-65 {8.4 compatible formatting of doubles} precision \
    {expr 1e-65} \
    9.9999999999999992e-66
test util-16.1.17.-64 {8.4 compatible formatting of doubles} precision \
    {expr 1e-64} \
    9.9999999999999997e-65
test util-16.1.17.-63 {8.4 compatible formatting of doubles} precision \
    {expr 1e-63} \
    1.0000000000000001e-63
test util-16.1.17.-62 {8.4 compatible formatting of doubles} precision \
    {expr 1e-62} \
    1e-62
test util-16.1.17.-61 {8.4 compatible formatting of doubles} precision \
    {expr 1e-61} \
    1e-61
test util-16.1.17.-60 {8.4 compatible formatting of doubles} precision \
    {expr 1e-60} \
    9.9999999999999997e-61
test util-16.1.17.-59 {8.4 compatible formatting of doubles} precision \
    {expr 1e-59} \
    1e-59
test util-16.1.17.-58 {8.4 compatible formatting of doubles} precision \
    {expr 1e-58} \
    1e-58
test util-16.1.17.-57 {8.4 compatible formatting of doubles} precision \
    {expr 1e-57} \
    9.9999999999999995e-58
test util-16.1.17.-56 {8.4 compatible formatting of doubles} precision \
    {expr 1e-56} \
    1e-56
test util-16.1.17.-55 {8.4 compatible formatting of doubles} precision \
    {expr 1e-55} \
    9.9999999999999999e-56
test util-16.1.17.-54 {8.4 compatible formatting of doubles} precision \
    {expr 1e-54} \
    1e-54
test util-16.1.17.-53 {8.4 compatible formatting of doubles} precision \
    {expr 1e-53} \
    1e-53
test util-16.1.17.-52 {8.4 compatible formatting of doubles} precision \
    {expr 1e-52} \
    1e-52
test util-16.1.17.-51 {8.4 compatible formatting of doubles} precision \
    {expr 1e-51} \
    1e-51
test util-16.1.17.-50 {8.4 compatible formatting of doubles} precision \
    {expr 1e-50} \
    1e-50
test util-16.1.17.-49 {8.4 compatible formatting of doubles} precision \
    {expr 1e-49} \
    9.9999999999999994e-50
test util-16.1.17.-48 {8.4 compatible formatting of doubles} precision \
    {expr 1e-48} \
    9.9999999999999997e-49
test util-16.1.17.-47 {8.4 compatible formatting of doubles} precision \
    {expr 1e-47} \
    9.9999999999999997e-48
test util-16.1.17.-46 {8.4 compatible formatting of doubles} precision \
    {expr 1e-46} \
    1e-46
test util-16.1.17.-45 {8.4 compatible formatting of doubles} precision \
    {expr 1e-45} \
    9.9999999999999998e-46
test util-16.1.17.-44 {8.4 compatible formatting of doubles} precision \
    {expr 1e-44} \
    9.9999999999999995e-45
test util-16.1.17.-43 {8.4 compatible formatting of doubles} precision \
    {expr 1e-43} \
    1.0000000000000001e-43
test util-16.1.17.-42 {8.4 compatible formatting of doubles} precision \
    {expr 1e-42} \
    1e-42
test util-16.1.17.-41 {8.4 compatible formatting of doubles} precision \
    {expr 1e-41} \
    1e-41
test util-16.1.17.-40 {8.4 compatible formatting of doubles} precision \
    {expr 1e-40} \
    9.9999999999999993e-41
test util-16.1.17.-39 {8.4 compatible formatting of doubles} precision \
    {expr 1e-39} \
    9.9999999999999993e-40
test util-16.1.17.-38 {8.4 compatible formatting of doubles} precision \
    {expr 1e-38} \
    9.9999999999999996e-39
test util-16.1.17.-37 {8.4 compatible formatting of doubles} precision \
    {expr 1e-37} \
    1.0000000000000001e-37
test util-16.1.17.-36 {8.4 compatible formatting of doubles} precision \
    {expr 1e-36} \
    9.9999999999999994e-37
test util-16.1.17.-35 {8.4 compatible formatting of doubles} precision \
    {expr 1e-35} \
    1e-35
test util-16.1.17.-34 {8.4 compatible formatting of doubles} precision \
    {expr 1e-34} \
    9.9999999999999993e-35
test util-16.1.17.-33 {8.4 compatible formatting of doubles} precision \
    {expr 1e-33} \
    1.0000000000000001e-33
test util-16.1.17.-32 {8.4 compatible formatting of doubles} precision \
    {expr 1e-32} \
    1.0000000000000001e-32
test util-16.1.17.-31 {8.4 compatible formatting of doubles} precision \
    {expr 1e-31} \
    1.0000000000000001e-31
test util-16.1.17.-30 {8.4 compatible formatting of doubles} precision \
    {expr 1e-30} \
    1.0000000000000001e-30
test util-16.1.17.-29 {8.4 compatible formatting of doubles} precision \
    {expr 1e-29} \
    9.9999999999999994e-30
test util-16.1.17.-28 {8.4 compatible formatting of doubles} precision \
    {expr 1e-28} \
    9.9999999999999997e-29
test util-16.1.17.-27 {8.4 compatible formatting of doubles} precision \
    {expr 1e-27} \
    1e-27
test util-16.1.17.-26 {8.4 compatible formatting of doubles} precision \
    {expr 1e-26} \
    1e-26
test util-16.1.17.-25 {8.4 compatible formatting of doubles} precision \
    {expr 1e-25} \
    1e-25
test util-16.1.17.-24 {8.4 compatible formatting of doubles} precision \
    {expr 1e-24} \
    9.9999999999999992e-25
test util-16.1.17.-23 {8.4 compatible formatting of doubles} precision \
    {expr 1e-23} \
    9.9999999999999996e-24
test util-16.1.17.-22 {8.4 compatible formatting of doubles} precision \
    {expr 1e-22} \
    1e-22
test util-16.1.17.-21 {8.4 compatible formatting of doubles} precision \
    {expr 1e-21} \
    9.9999999999999991e-22
test util-16.1.17.-20 {8.4 compatible formatting of doubles} precision \
    {expr 1e-20} \
    9.9999999999999995e-21
test util-16.1.17.-19 {8.4 compatible formatting of doubles} precision \
    {expr 1e-19} \
    9.9999999999999998e-20
test util-16.1.17.-18 {8.4 compatible formatting of doubles} precision \
    {expr 1e-18} \
    1.0000000000000001e-18
test util-16.1.17.-17 {8.4 compatible formatting of doubles} precision \
    {expr 1e-17} \
    1.0000000000000001e-17
test util-16.1.17.-16 {8.4 compatible formatting of doubles} precision \
    {expr 1e-16} \
    9.9999999999999998e-17
test util-16.1.17.-15 {8.4 compatible formatting of doubles} precision \
    {expr 1e-15} \
    1.0000000000000001e-15
test util-16.1.17.-14 {8.4 compatible formatting of doubles} precision \
    {expr 1e-14} \
    1e-14
test util-16.1.17.-13 {8.4 compatible formatting of doubles} precision \
    {expr 1e-13} \
    1e-13
test util-16.1.17.-12 {8.4 compatible formatting of doubles} precision \
    {expr 1e-12} \
    9.9999999999999998e-13
test util-16.1.17.-11 {8.4 compatible formatting of doubles} precision \
    {expr 1e-11} \
    9.9999999999999994e-12
test util-16.1.17.-10 {8.4 compatible formatting of doubles} precision \
    {expr 1e-10} \
    1e-10
test util-16.1.17.-9 {8.4 compatible formatting of doubles} precision \
    {expr 1e-9} \
    1.0000000000000001e-09
test util-16.1.17.-8 {8.4 compatible formatting of doubles} precision \
    {expr 1e-8} \
    1e-08
test util-16.1.17.-7 {8.4 compatible formatting of doubles} precision \
    {expr 1e-7} \
    9.9999999999999995e-08
test util-16.1.17.-6 {8.4 compatible formatting of doubles} precision \
    {expr 1e-6} \
    9.9999999999999995e-07
test util-16.1.17.-5 {8.4 compatible formatting of doubles} precision \
    {expr 1e-5} \
    1.0000000000000001e-05
test util-16.1.17.-4 {8.4 compatible formatting of doubles} precision \
    {expr 1e-4} \
    0.0001
test util-16.1.17.-3 {8.4 compatible formatting of doubles} precision \
    {expr 1e-3} \
    0.001
test util-16.1.17.-2 {8.4 compatible formatting of doubles} precision \
    {expr 1e-2} \
    0.01
test util-16.1.17.-1 {8.4 compatible formatting of doubles} precision \
    {expr 1e-1} \
    0.10000000000000001
test util-16.1.17.0 {8.4 compatible formatting of doubles} precision \
    {expr 1e0} \
    1.0
test util-16.1.17.1 {8.4 compatible formatting of doubles} precision \
    {expr 1e1} \
    10.0
test util-16.1.17.2 {8.4 compatible formatting of doubles} precision \
    {expr 1e2} \
    100.0
test util-16.1.17.3 {8.4 compatible formatting of doubles} precision \
    {expr 1e3} \
    1000.0
test util-16.1.17.4 {8.4 compatible formatting of doubles} precision \
    {expr 1e4} \
    10000.0
test util-16.1.17.5 {8.4 compatible formatting of doubles} precision \
    {expr 1e5} \
    100000.0
test util-16.1.17.6 {8.4 compatible formatting of doubles} precision \
    {expr 1e6} \
    1000000.0
test util-16.1.17.7 {8.4 compatible formatting of doubles} precision \
    {expr 1e7} \
    10000000.0
test util-16.1.17.8 {8.4 compatible formatting of doubles} precision \
    {expr 1e8} \
    100000000.0
test util-16.1.17.9 {8.4 compatible formatting of doubles} precision \
    {expr 1e9} \
    1000000000.0
test util-16.1.17.10 {8.4 compatible formatting of doubles} precision \
    {expr 1e10} \
    10000000000.0
test util-16.1.17.11 {8.4 compatible formatting of doubles} precision \
    {expr 1e11} \
    100000000000.0
test util-16.1.17.12 {8.4 compatible formatting of doubles} precision \
    {expr 1e12} \
    1000000000000.0
test util-16.1.17.13 {8.4 compatible formatting of doubles} precision \
    {expr 1e13} \
    10000000000000.0
test util-16.1.17.14 {8.4 compatible formatting of doubles} precision \
    {expr 1e14} \
    100000000000000.0
test util-16.1.17.15 {8.4 compatible formatting of doubles} precision \
    {expr 1e15} \
    1000000000000000.0
test util-16.1.17.16 {8.4 compatible formatting of doubles} precision \
    {expr 1e16} \
    10000000000000000.0
test util-16.1.17.17 {8.4 compatible formatting of doubles} precision \
    {expr 1e17} \
    1e+17
test util-16.1.17.18 {8.4 compatible formatting of doubles} precision \
    {expr 1e18} \
    1e+18
test util-16.1.17.19 {8.4 compatible formatting of doubles} precision \
    {expr 1e19} \
    1e+19
test util-16.1.17.20 {8.4 compatible formatting of doubles} precision \
    {expr 1e20} \
    1e+20
test util-16.1.17.21 {8.4 compatible formatting of doubles} precision \
    {expr 1e21} \
    1e+21
test util-16.1.17.22 {8.4 compatible formatting of doubles} precision \
    {expr 1e22} \
    1e+22
test util-16.1.17.23 {8.4 compatible formatting of doubles} precision \
    {expr 1e23} \
    9.9999999999999992e+22
test util-16.1.17.24 {8.4 compatible formatting of doubles} precision \
    {expr 1e24} \
    9.9999999999999998e+23
test util-16.1.17.25 {8.4 compatible formatting of doubles} precision \
    {expr 1e25} \
    1.0000000000000001e+25
test util-16.1.17.26 {8.4 compatible formatting of doubles} precision \
    {expr 1e26} \
    1e+26
test util-16.1.17.27 {8.4 compatible formatting of doubles} precision \
    {expr 1e27} \
    1e+27
test util-16.1.17.28 {8.4 compatible formatting of doubles} precision \
    {expr 1e28} \
    9.9999999999999996e+27
test util-16.1.17.29 {8.4 compatible formatting of doubles} precision \
    {expr 1e29} \
    9.9999999999999991e+28
test util-16.1.17.30 {8.4 compatible formatting of doubles} precision \
    {expr 1e30} \
    1e+30
test util-16.1.17.31 {8.4 compatible formatting of doubles} precision \
    {expr 1e31} \
    9.9999999999999996e+30
test util-16.1.17.32 {8.4 compatible formatting of doubles} precision \
    {expr 1e32} \
    1.0000000000000001e+32
test util-16.1.17.33 {8.4 compatible formatting of doubles} precision \
    {expr 1e33} \
    9.9999999999999995e+32
test util-16.1.17.34 {8.4 compatible formatting of doubles} precision \
    {expr 1e34} \
    9.9999999999999995e+33
test util-16.1.17.35 {8.4 compatible formatting of doubles} precision \
    {expr 1e35} \
    9.9999999999999997e+34
test util-16.1.17.36 {8.4 compatible formatting of doubles} precision \
    {expr 1e36} \
    1e+36
test util-16.1.17.37 {8.4 compatible formatting of doubles} precision \
    {expr 1e37} \
    9.9999999999999995e+36
test util-16.1.17.38 {8.4 compatible formatting of doubles} precision \
    {expr 1e38} \
    9.9999999999999998e+37
test util-16.1.17.39 {8.4 compatible formatting of doubles} precision \
    {expr 1e39} \
    9.9999999999999994e+38
test util-16.1.17.40 {8.4 compatible formatting of doubles} precision \
    {expr 1e40} \
    1e+40
test util-16.1.17.41 {8.4 compatible formatting of doubles} precision \
    {expr 1e41} \
    1e+41
test util-16.1.17.42 {8.4 compatible formatting of doubles} precision \
    {expr 1e42} \
    1e+42
test util-16.1.17.43 {8.4 compatible formatting of doubles} precision \
    {expr 1e43} \
    1e+43
test util-16.1.17.44 {8.4 compatible formatting of doubles} precision \
    {expr 1e44} \
    1.0000000000000001e+44
test util-16.1.17.45 {8.4 compatible formatting of doubles} precision \
    {expr 1e45} \
    9.9999999999999993e+44
test util-16.1.17.46 {8.4 compatible formatting of doubles} precision \
    {expr 1e46} \
    9.9999999999999999e+45
test util-16.1.17.47 {8.4 compatible formatting of doubles} precision \
    {expr 1e47} \
    1e+47
test util-16.1.17.48 {8.4 compatible formatting of doubles} precision \
    {expr 1e48} \
    1e+48
test util-16.1.17.49 {8.4 compatible formatting of doubles} precision \
    {expr 1e49} \
    9.9999999999999995e+48
test util-16.1.17.50 {8.4 compatible formatting of doubles} precision \
    {expr 1e50} \
    1.0000000000000001e+50
test util-16.1.17.51 {8.4 compatible formatting of doubles} precision \
    {expr 1e51} \
    9.9999999999999999e+50
test util-16.1.17.52 {8.4 compatible formatting of doubles} precision \
    {expr 1e52} \
    9.9999999999999999e+51
test util-16.1.17.53 {8.4 compatible formatting of doubles} precision \
    {expr 1e53} \
    9.9999999999999999e+52
test util-16.1.17.54 {8.4 compatible formatting of doubles} precision \
    {expr 1e54} \
    1.0000000000000001e+54
test util-16.1.17.55 {8.4 compatible formatting of doubles} precision \
    {expr 1e55} \
    1e+55
test util-16.1.17.56 {8.4 compatible formatting of doubles} precision \
    {expr 1e56} \
    1.0000000000000001e+56
test util-16.1.17.57 {8.4 compatible formatting of doubles} precision \
    {expr 1e57} \
    1e+57
test util-16.1.17.58 {8.4 compatible formatting of doubles} precision \
    {expr 1e58} \
    9.9999999999999994e+57
test util-16.1.17.59 {8.4 compatible formatting of doubles} precision \
    {expr 1e59} \
    9.9999999999999997e+58
test util-16.1.17.60 {8.4 compatible formatting of doubles} precision \
    {expr 1e60} \
    9.9999999999999995e+59
test util-16.1.17.61 {8.4 compatible formatting of doubles} precision \
    {expr 1e61} \
    9.9999999999999995e+60
test util-16.1.17.62 {8.4 compatible formatting of doubles} precision \
    {expr 1e62} \
    1e+62
test util-16.1.17.63 {8.4 compatible formatting of doubles} precision \
    {expr 1e63} \
    1.0000000000000001e+63
test util-16.1.17.64 {8.4 compatible formatting of doubles} precision \
    {expr 1e64} \
    1e+64
test util-16.1.17.65 {8.4 compatible formatting of doubles} precision \
    {expr 1e65} \
    9.9999999999999999e+64
test util-16.1.17.66 {8.4 compatible formatting of doubles} precision \
    {expr 1e66} \
    9.9999999999999995e+65
test util-16.1.17.67 {8.4 compatible formatting of doubles} precision \
    {expr 1e67} \
    9.9999999999999998e+66
test util-16.1.17.68 {8.4 compatible formatting of doubles} precision \
    {expr 1e68} \
    9.9999999999999995e+67
test util-16.1.17.69 {8.4 compatible formatting of doubles} precision \
    {expr 1e69} \
    1.0000000000000001e+69
test util-16.1.17.70 {8.4 compatible formatting of doubles} precision \
    {expr 1e70} \
    1.0000000000000001e+70
test util-16.1.17.71 {8.4 compatible formatting of doubles} precision \
    {expr 1e71} \
    1e+71
test util-16.1.17.72 {8.4 compatible formatting of doubles} precision \
    {expr 1e72} \
    9.9999999999999994e+71
test util-16.1.17.73 {8.4 compatible formatting of doubles} precision \
    {expr 1e73} \
    9.9999999999999998e+72
test util-16.1.17.74 {8.4 compatible formatting of doubles} precision \
    {expr 1e74} \
    9.9999999999999995e+73
test util-16.1.17.75 {8.4 compatible formatting of doubles} precision \
    {expr 1e75} \
    9.9999999999999993e+74
test util-16.1.17.76 {8.4 compatible formatting of doubles} precision \
    {expr 1e76} \
    1e+76
test util-16.1.17.77 {8.4 compatible formatting of doubles} precision \
    {expr 1e77} \
    9.9999999999999998e+76
test util-16.1.17.78 {8.4 compatible formatting of doubles} precision \
    {expr 1e78} \
    1e+78
test util-16.1.17.79 {8.4 compatible formatting of doubles} precision \
    {expr 1e79} \
    9.9999999999999997e+78
test util-16.1.17.80 {8.4 compatible formatting of doubles} precision \
    {expr 1e80} \
    1e+80
test util-16.1.17.81 {8.4 compatible formatting of doubles} precision \
    {expr 1e81} \
    9.9999999999999992e+80
test util-16.1.17.82 {8.4 compatible formatting of doubles} precision \
    {expr 1e82} \
    9.9999999999999996e+81
test util-16.1.17.83 {8.4 compatible formatting of doubles} precision \
    {expr 1e83} \
    1e+83
test util-16.1.17.84 {8.4 compatible formatting of doubles} precision \
    {expr 1e84} \
    1.0000000000000001e+84
test util-16.1.17.85 {8.4 compatible formatting of doubles} precision \
    {expr 1e85} \
    1e+85
test util-16.1.17.86 {8.4 compatible formatting of doubles} precision \
    {expr 1e86} \
    1e+86
test util-16.1.17.87 {8.4 compatible formatting of doubles} precision \
    {expr 1e87} \
    9.9999999999999996e+86
test util-16.1.17.88 {8.4 compatible formatting of doubles} precision \
    {expr 1e88} \
    9.9999999999999996e+87
test util-16.1.17.89 {8.4 compatible formatting of doubles} precision \
    {expr 1e89} \
    9.9999999999999999e+88
test util-16.1.17.90 {8.4 compatible formatting of doubles} precision \
    {expr 1e90} \
    9.9999999999999997e+89
test util-16.1.17.91 {8.4 compatible formatting of doubles} precision \
    {expr 1e91} \
    1.0000000000000001e+91
test util-16.1.17.92 {8.4 compatible formatting of doubles} precision \
    {expr 1e92} \
    1e+92
test util-16.1.17.93 {8.4 compatible formatting of doubles} precision \
    {expr 1e93} \
    1e+93
test util-16.1.17.94 {8.4 compatible formatting of doubles} precision \
    {expr 1e94} \
    1e+94
test util-16.1.17.95 {8.4 compatible formatting of doubles} precision \
    {expr 1e95} \
    1e+95
test util-16.1.17.96 {8.4 compatible formatting of doubles} precision \
    {expr 1e96} \
    1e+96
test util-16.1.17.97 {8.4 compatible formatting of doubles} precision \
    {expr 1e97} \
    1.0000000000000001e+97
test util-16.1.17.98 {8.4 compatible formatting of doubles} precision \
    {expr 1e98} \
    1e+98
test util-16.1.17.99 {8.4 compatible formatting of doubles} precision \
    {expr 1e99} \
    9.9999999999999997e+98
test util-16.1.17.100 {8.4 compatible formatting of doubles} precision \
    {expr 1e100} \
    1e+100
test util-16.1.17.101 {8.4 compatible formatting of doubles} precision \
    {expr 1e101} \
    9.9999999999999998e+100
test util-16.1.17.102 {8.4 compatible formatting of doubles} precision \
    {expr 1e102} \
    9.9999999999999998e+101
test util-16.1.17.103 {8.4 compatible formatting of doubles} precision \
    {expr 1e103} \
    1e+103
test util-16.1.17.104 {8.4 compatible formatting of doubles} precision \
    {expr 1e104} \
    1e+104
test util-16.1.17.105 {8.4 compatible formatting of doubles} precision \
    {expr 1e105} \
    9.9999999999999994e+104
test util-16.1.17.106 {8.4 compatible formatting of doubles} precision \
    {expr 1e106} \
    1.0000000000000001e+106
test util-16.1.17.107 {8.4 compatible formatting of doubles} precision \
    {expr 1e107} \
    9.9999999999999997e+106
test util-16.1.17.108 {8.4 compatible formatting of doubles} precision \
    {expr 1e108} \
    1e+108
test util-16.1.17.109 {8.4 compatible formatting of doubles} precision \
    {expr 1e109} \
    9.9999999999999998e+108
test util-16.1.17.110 {8.4 compatible formatting of doubles} precision \
    {expr 1e110} \
    1e+110
test util-16.1.17.111 {8.4 compatible formatting of doubles} precision \
    {expr 1e111} \
    9.9999999999999996e+110
test util-16.1.17.112 {8.4 compatible formatting of doubles} precision \
    {expr 1e112} \
    9.9999999999999993e+111
test util-16.1.17.113 {8.4 compatible formatting of doubles} precision \
    {expr 1e113} \
    1e+113
test util-16.1.17.114 {8.4 compatible formatting of doubles} precision \
    {expr 1e114} \
    1e+114
test util-16.1.17.115 {8.4 compatible formatting of doubles} precision \
    {expr 1e115} \
    1e+115
test util-16.1.17.116 {8.4 compatible formatting of doubles} precision \
    {expr 1e116} \
    1e+116
test util-16.1.17.117 {8.4 compatible formatting of doubles} precision \
    {expr 1e117} \
    1.0000000000000001e+117
test util-16.1.17.118 {8.4 compatible formatting of doubles} precision \
    {expr 1e118} \
    9.9999999999999997e+117
test util-16.1.17.119 {8.4 compatible formatting of doubles} precision \
    {expr 1e119} \
    9.9999999999999994e+118
test util-16.1.17.120 {8.4 compatible formatting of doubles} precision \
    {expr 1e120} \
    9.9999999999999998e+119
test util-16.1.17.121 {8.4 compatible formatting of doubles} precision \
    {expr 1e121} \
    1e+121
test util-16.1.17.122 {8.4 compatible formatting of doubles} precision \
    {expr 1e122} \
    1e+122
test util-16.1.17.123 {8.4 compatible formatting of doubles} precision \
    {expr 1e123} \
    9.9999999999999998e+122
test util-16.1.17.124 {8.4 compatible formatting of doubles} precision \
    {expr 1e124} \
    9.9999999999999995e+123
test util-16.1.17.125 {8.4 compatible formatting of doubles} precision \
    {expr 1e125} \
    9.9999999999999992e+124
test util-16.1.17.126 {8.4 compatible formatting of doubles} precision \
    {expr 1e126} \
    9.9999999999999992e+125
test util-16.1.17.127 {8.4 compatible formatting of doubles} precision \
    {expr 1e127} \
    9.9999999999999995e+126
test util-16.1.17.128 {8.4 compatible formatting of doubles} precision \
    {expr 1e128} \
    1.0000000000000001e+128
test util-16.1.17.129 {8.4 compatible formatting of doubles} precision \
    {expr 1e129} \
    1e+129
test util-16.1.17.130 {8.4 compatible formatting of doubles} precision \
    {expr 1e130} \
    1.0000000000000001e+130
test util-16.1.17.131 {8.4 compatible formatting of doubles} precision \
    {expr 1e131} \
    9.9999999999999991e+130
test util-16.1.17.132 {8.4 compatible formatting of doubles} precision \
    {expr 1e132} \
    9.9999999999999999e+131
test util-16.1.17.133 {8.4 compatible formatting of doubles} precision \
    {expr 1e133} \
    1e+133
test util-16.1.17.134 {8.4 compatible formatting of doubles} precision \
    {expr 1e134} \
    9.9999999999999992e+133
test util-16.1.17.135 {8.4 compatible formatting of doubles} precision \
    {expr 1e135} \
    9.9999999999999996e+134
test util-16.1.17.136 {8.4 compatible formatting of doubles} precision \
    {expr 1e136} \
    1.0000000000000001e+136
test util-16.1.17.137 {8.4 compatible formatting of doubles} precision \
    {expr 1e137} \
    1e+137
test util-16.1.17.138 {8.4 compatible formatting of doubles} precision \
    {expr 1e138} \
    1e+138
test util-16.1.17.139 {8.4 compatible formatting of doubles} precision \
    {expr 1e139} \
    1e+139
test util-16.1.17.140 {8.4 compatible formatting of doubles} precision \
    {expr 1e140} \
    1.0000000000000001e+140
test util-16.1.17.141 {8.4 compatible formatting of doubles} precision \
    {expr 1e141} \
    1e+141
test util-16.1.17.142 {8.4 compatible formatting of doubles} precision \
    {expr 1e142} \
    1.0000000000000001e+142
test util-16.1.17.143 {8.4 compatible formatting of doubles} precision \
    {expr 1e143} \
    1e+143
test util-16.1.17.144 {8.4 compatible formatting of doubles} precision \
    {expr 1e144} \
    1e+144
test util-16.1.17.145 {8.4 compatible formatting of doubles} precision \
    {expr 1e145} \
    9.9999999999999999e+144
test util-16.1.17.146 {8.4 compatible formatting of doubles} precision \
    {expr 1e146} \
    9.9999999999999993e+145
test util-16.1.17.147 {8.4 compatible formatting of doubles} precision \
    {expr 1e147} \
    9.9999999999999998e+146
test util-16.1.17.148 {8.4 compatible formatting of doubles} precision \
    {expr 1e148} \
    1e+148
test util-16.1.17.149 {8.4 compatible formatting of doubles} precision \
    {expr 1e149} \
    1e+149
test util-16.1.17.150 {8.4 compatible formatting of doubles} precision \
    {expr 1e150} \
    9.9999999999999998e+149
test util-16.1.17.151 {8.4 compatible formatting of doubles} precision \
    {expr 1e151} \
    1e+151
test util-16.1.17.152 {8.4 compatible formatting of doubles} precision \
    {expr 1e152} \
    1e+152
test util-16.1.17.153 {8.4 compatible formatting of doubles} precision \
    {expr 1e153} \
    1e+153
test util-16.1.17.154 {8.4 compatible formatting of doubles} precision \
    {expr 1e154} \
    1e+154
test util-16.1.17.155 {8.4 compatible formatting of doubles} precision \
    {expr 1e155} \
    1e+155
test util-16.1.17.156 {8.4 compatible formatting of doubles} precision \
    {expr 1e156} \
    9.9999999999999998e+155
test util-16.1.17.157 {8.4 compatible formatting of doubles} precision \
    {expr 1e157} \
    9.9999999999999998e+156
test util-16.1.17.158 {8.4 compatible formatting of doubles} precision \
    {expr 1e158} \
    9.9999999999999995e+157
test util-16.1.17.159 {8.4 compatible formatting of doubles} precision \
    {expr 1e159} \
    9.9999999999999993e+158
test util-16.1.17.160 {8.4 compatible formatting of doubles} precision \
    {expr 1e160} \
    1e+160
test util-16.1.17.161 {8.4 compatible formatting of doubles} precision \
    {expr 1e161} \
    1e+161
test util-16.1.17.162 {8.4 compatible formatting of doubles} precision \
    {expr 1e162} \
    9.9999999999999994e+161
test util-16.1.17.163 {8.4 compatible formatting of doubles} precision \
    {expr 1e163} \
    9.9999999999999994e+162
test util-16.1.17.164 {8.4 compatible formatting of doubles} precision \
    {expr 1e164} \
    1e+164
test util-16.1.17.165 {8.4 compatible formatting of doubles} precision \
    {expr 1e165} \
    9.999999999999999e+164
test util-16.1.17.166 {8.4 compatible formatting of doubles} precision \
    {expr 1e166} \
    9.9999999999999994e+165
test util-16.1.17.167 {8.4 compatible formatting of doubles} precision \
    {expr 1e167} \
    1e+167
test util-16.1.17.168 {8.4 compatible formatting of doubles} precision \
    {expr 1e168} \
    9.9999999999999993e+167
test util-16.1.17.169 {8.4 compatible formatting of doubles} precision \
    {expr 1e169} \
    9.9999999999999993e+168
test util-16.1.17.170 {8.4 compatible formatting of doubles} precision \
    {expr 1e170} \
    1e+170
test util-16.1.17.171 {8.4 compatible formatting of doubles} precision \
    {expr 1e171} \
    9.9999999999999995e+170
test util-16.1.17.172 {8.4 compatible formatting of doubles} precision \
    {expr 1e172} \
    1.0000000000000001e+172
test util-16.1.17.173 {8.4 compatible formatting of doubles} precision \
    {expr 1e173} \
    1e+173
test util-16.1.17.174 {8.4 compatible formatting of doubles} precision \
    {expr 1e174} \
    1.0000000000000001e+174
test util-16.1.17.175 {8.4 compatible formatting of doubles} precision \
    {expr 1e175} \
    9.9999999999999994e+174
test util-16.1.17.176 {8.4 compatible formatting of doubles} precision \
    {expr 1e176} \
    1e+176
test util-16.1.17.177 {8.4 compatible formatting of doubles} precision \
    {expr 1e177} \
    1e+177
test util-16.1.17.178 {8.4 compatible formatting of doubles} precision \
    {expr 1e178} \
    1.0000000000000001e+178
test util-16.1.17.179 {8.4 compatible formatting of doubles} precision \
    {expr 1e179} \
    9.9999999999999998e+178
test util-16.1.17.180 {8.4 compatible formatting of doubles} precision \
    {expr 1e180} \
    1e+180
test util-16.1.17.181 {8.4 compatible formatting of doubles} precision \
    {expr 1e181} \
    9.9999999999999992e+180
test util-16.1.17.182 {8.4 compatible formatting of doubles} precision \
    {expr 1e182} \
    1.0000000000000001e+182
test util-16.1.17.183 {8.4 compatible formatting of doubles} precision \
    {expr 1e183} \
    9.9999999999999995e+182
test util-16.1.17.184 {8.4 compatible formatting of doubles} precision \
    {expr 1e184} \
    1e+184
test util-16.1.17.185 {8.4 compatible formatting of doubles} precision \
    {expr 1e185} \
    9.9999999999999998e+184
test util-16.1.17.186 {8.4 compatible formatting of doubles} precision \
    {expr 1e186} \
    9.9999999999999998e+185
test util-16.1.17.187 {8.4 compatible formatting of doubles} precision \
    {expr 1e187} \
    9.9999999999999991e+186
test util-16.1.17.188 {8.4 compatible formatting of doubles} precision \
    {expr 1e188} \
    1e+188
test util-16.1.17.189 {8.4 compatible formatting of doubles} precision \
    {expr 1e189} \
    1e+189
test util-16.1.17.190 {8.4 compatible formatting of doubles} precision \
    {expr 1e190} \
    1.0000000000000001e+190
test util-16.1.17.191 {8.4 compatible formatting of doubles} precision \
    {expr 1e191} \
    1.0000000000000001e+191
test util-16.1.17.192 {8.4 compatible formatting of doubles} precision \
    {expr 1e192} \
    1e+192
test util-16.1.17.193 {8.4 compatible formatting of doubles} precision \
    {expr 1e193} \
    1.0000000000000001e+193
test util-16.1.17.194 {8.4 compatible formatting of doubles} precision \
    {expr 1e194} \
    9.9999999999999994e+193
test util-16.1.17.195 {8.4 compatible formatting of doubles} precision \
    {expr 1e195} \
    9.9999999999999998e+194
test util-16.1.17.196 {8.4 compatible formatting of doubles} precision \
    {expr 1e196} \
    9.9999999999999995e+195
test util-16.1.17.197 {8.4 compatible formatting of doubles} precision \
    {expr 1e197} \
    9.9999999999999995e+196
test util-16.1.17.198 {8.4 compatible formatting of doubles} precision \
    {expr 1e198} \
    1e+198
test util-16.1.17.199 {8.4 compatible formatting of doubles} precision \
    {expr 1e199} \
    1.0000000000000001e+199
test util-16.1.17.200 {8.4 compatible formatting of doubles} precision \
    {expr 1e200} \
    9.9999999999999997e+199
test util-16.1.17.201 {8.4 compatible formatting of doubles} precision \
    {expr 1e201} \
    1e+201
test util-16.1.17.202 {8.4 compatible formatting of doubles} precision \
    {expr 1e202} \
    9.999999999999999e+201
test util-16.1.17.203 {8.4 compatible formatting of doubles} precision \
    {expr 1e203} \
    9.9999999999999999e+202
test util-16.1.17.204 {8.4 compatible formatting of doubles} precision \
    {expr 1e204} \
    9.9999999999999999e+203
test util-16.1.17.205 {8.4 compatible formatting of doubles} precision \
    {expr 1e205} \
    1e+205
test util-16.1.17.206 {8.4 compatible formatting of doubles} precision \
    {expr 1e206} \
    1e+206
test util-16.1.17.207 {8.4 compatible formatting of doubles} precision \
    {expr 1e207} \
    1e+207
test util-16.1.17.208 {8.4 compatible formatting of doubles} precision \
    {expr 1e208} \
    9.9999999999999998e+207
test util-16.1.17.209 {8.4 compatible formatting of doubles} precision \
    {expr 1e209} \
    1.0000000000000001e+209
test util-16.1.17.210 {8.4 compatible formatting of doubles} precision \
    {expr 1e210} \
    9.9999999999999993e+209
test util-16.1.17.211 {8.4 compatible formatting of doubles} precision \
    {expr 1e211} \
    9.9999999999999996e+210
test util-16.1.17.212 {8.4 compatible formatting of doubles} precision \
    {expr 1e212} \
    9.9999999999999991e+211
test util-16.1.17.213 {8.4 compatible formatting of doubles} precision \
    {expr 1e213} \
    9.9999999999999998e+212
test util-16.1.17.214 {8.4 compatible formatting of doubles} precision \
    {expr 1e214} \
    9.9999999999999995e+213
test util-16.1.17.215 {8.4 compatible formatting of doubles} precision \
    {expr 1e215} \
    9.9999999999999991e+214
test util-16.1.17.216 {8.4 compatible formatting of doubles} precision \
    {expr 1e216} \
    1e+216
test util-16.1.17.217 {8.4 compatible formatting of doubles} precision \
    {expr 1e217} \
    9.9999999999999996e+216
test util-16.1.17.218 {8.4 compatible formatting of doubles} precision \
    {expr 1e218} \
    1.0000000000000001e+218
test util-16.1.17.219 {8.4 compatible formatting of doubles} precision \
    {expr 1e219} \
    9.9999999999999997e+218
test util-16.1.17.220 {8.4 compatible formatting of doubles} precision \
    {expr 1e220} \
    1e+220
test util-16.1.17.221 {8.4 compatible formatting of doubles} precision \
    {expr 1e221} \
    1e+221
test util-16.1.17.222 {8.4 compatible formatting of doubles} precision \
    {expr 1e222} \
    1e+222
test util-16.1.17.223 {8.4 compatible formatting of doubles} precision \
    {expr 1e223} \
    1e+223
test util-16.1.17.224 {8.4 compatible formatting of doubles} precision \
    {expr 1e224} \
    9.9999999999999997e+223
test util-16.1.17.225 {8.4 compatible formatting of doubles} precision \
    {expr 1e225} \
    9.9999999999999993e+224
test util-16.1.17.226 {8.4 compatible formatting of doubles} precision \
    {expr 1e226} \
    9.9999999999999996e+225
test util-16.1.17.227 {8.4 compatible formatting of doubles} precision \
    {expr 1e227} \
    1.0000000000000001e+227
test util-16.1.17.228 {8.4 compatible formatting of doubles} precision \
    {expr 1e228} \
    9.9999999999999992e+227
test util-16.1.17.229 {8.4 compatible formatting of doubles} precision \
    {expr 1e229} \
    9.9999999999999999e+228
test util-16.1.17.230 {8.4 compatible formatting of doubles} precision \
    {expr 1e230} \
    1.0000000000000001e+230
test util-16.1.17.231 {8.4 compatible formatting of doubles} precision \
    {expr 1e231} \
    1.0000000000000001e+231
test util-16.1.17.232 {8.4 compatible formatting of doubles} precision \
    {expr 1e232} \
    1.0000000000000001e+232
test util-16.1.17.233 {8.4 compatible formatting of doubles} precision \
    {expr 1e233} \
    9.9999999999999997e+232
test util-16.1.17.234 {8.4 compatible formatting of doubles} precision \
    {expr 1e234} \
    1e+234
test util-16.1.17.235 {8.4 compatible formatting of doubles} precision \
    {expr 1e235} \
    1.0000000000000001e+235
test util-16.1.17.236 {8.4 compatible formatting of doubles} precision \
    {expr 1e236} \
    1.0000000000000001e+236
test util-16.1.17.237 {8.4 compatible formatting of doubles} precision \
    {expr 1e237} \
    9.9999999999999994e+236
test util-16.1.17.238 {8.4 compatible formatting of doubles} precision \
    {expr 1e238} \
    1e+238
test util-16.1.17.239 {8.4 compatible formatting of doubles} precision \
    {expr 1e239} \
    9.9999999999999999e+238
test util-16.1.17.240 {8.4 compatible formatting of doubles} precision \
    {expr 1e240} \
    1e+240
test util-16.1.17.241 {8.4 compatible formatting of doubles} precision \
    {expr 1e241} \
    1.0000000000000001e+241
test util-16.1.17.242 {8.4 compatible formatting of doubles} precision \
    {expr 1e242} \
    1.0000000000000001e+242
test util-16.1.17.243 {8.4 compatible formatting of doubles} precision \
    {expr 1e243} \
    1.0000000000000001e+243
test util-16.1.17.244 {8.4 compatible formatting of doubles} precision \
    {expr 1e244} \
    1.0000000000000001e+244
test util-16.1.17.245 {8.4 compatible formatting of doubles} precision \
    {expr 1e245} \
    1e+245
test util-16.1.17.246 {8.4 compatible formatting of doubles} precision \
    {expr 1e246} \
    1.0000000000000001e+246
test util-16.1.17.247 {8.4 compatible formatting of doubles} precision \
    {expr 1e247} \
    9.9999999999999995e+246
test util-16.1.17.248 {8.4 compatible formatting of doubles} precision \
    {expr 1e248} \
    1e+248
test util-16.1.17.249 {8.4 compatible formatting of doubles} precision \
    {expr 1e249} \
    9.9999999999999992e+248
test util-16.1.17.250 {8.4 compatible formatting of doubles} precision \
    {expr 1e250} \
    9.9999999999999992e+249
test util-16.1.17.251 {8.4 compatible formatting of doubles} precision \
    {expr 1e251} \
    1e+251
test util-16.1.17.252 {8.4 compatible formatting of doubles} precision \
    {expr 1e252} \
    1.0000000000000001e+252
test util-16.1.17.253 {8.4 compatible formatting of doubles} precision \
    {expr 1e253} \
    9.9999999999999994e+252
test util-16.1.17.254 {8.4 compatible formatting of doubles} precision \
    {expr 1e254} \
    9.9999999999999994e+253
test util-16.1.17.255 {8.4 compatible formatting of doubles} precision \
    {expr 1e255} \
    9.9999999999999999e+254
test util-16.1.17.256 {8.4 compatible formatting of doubles} precision \
    {expr 1e256} \
    1e+256
test util-16.1.17.257 {8.4 compatible formatting of doubles} precision \
    {expr 1e257} \
    1e+257
test util-16.1.17.258 {8.4 compatible formatting of doubles} precision \
    {expr 1e258} \
    1.0000000000000001e+258
test util-16.1.17.259 {8.4 compatible formatting of doubles} precision \
    {expr 1e259} \
    9.9999999999999993e+258
test util-16.1.17.260 {8.4 compatible formatting of doubles} precision \
    {expr 1e260} \
    1.0000000000000001e+260
test util-16.1.17.261 {8.4 compatible formatting of doubles} precision \
    {expr 1e261} \
    9.9999999999999993e+260
test util-16.1.17.262 {8.4 compatible formatting of doubles} precision \
    {expr 1e262} \
    1e+262
test util-16.1.17.263 {8.4 compatible formatting of doubles} precision \
    {expr 1e263} \
    1e+263
test util-16.1.17.264 {8.4 compatible formatting of doubles} precision \
    {expr 1e264} \
    1e+264
test util-16.1.17.265 {8.4 compatible formatting of doubles} precision \
    {expr 1e265} \
    1.0000000000000001e+265
test util-16.1.17.266 {8.4 compatible formatting of doubles} precision \
    {expr 1e266} \
    1e+266
test util-16.1.17.267 {8.4 compatible formatting of doubles} precision \
    {expr 1e267} \
    9.9999999999999997e+266
test util-16.1.17.268 {8.4 compatible formatting of doubles} precision \
    {expr 1e268} \
    9.9999999999999997e+267
test util-16.1.17.269 {8.4 compatible formatting of doubles} precision \
    {expr 1e269} \
    1e+269
test util-16.1.17.270 {8.4 compatible formatting of doubles} precision \
    {expr 1e270} \
    1e+270
test util-16.1.17.271 {8.4 compatible formatting of doubles} precision \
    {expr 1e271} \
    9.9999999999999995e+270
test util-16.1.17.272 {8.4 compatible formatting of doubles} precision \
    {expr 1e272} \
    1.0000000000000001e+272
test util-16.1.17.273 {8.4 compatible formatting of doubles} precision \
    {expr 1e273} \
    9.9999999999999995e+272
test util-16.1.17.274 {8.4 compatible formatting of doubles} precision \
    {expr 1e274} \
    9.9999999999999992e+273
test util-16.1.17.275 {8.4 compatible formatting of doubles} precision \
    {expr 1e275} \
    9.9999999999999996e+274
test util-16.1.17.276 {8.4 compatible formatting of doubles} precision \
    {expr 1e276} \
    1.0000000000000001e+276
test util-16.1.17.277 {8.4 compatible formatting of doubles} precision \
    {expr 1e277} \
    1e+277
test util-16.1.17.278 {8.4 compatible formatting of doubles} precision \
    {expr 1e278} \
    9.9999999999999996e+277
test util-16.1.17.279 {8.4 compatible formatting of doubles} precision \
    {expr 1e279} \
    1.0000000000000001e+279
test util-16.1.17.280 {8.4 compatible formatting of doubles} precision \
    {expr 1e280} \
    1e+280
test util-16.1.17.281 {8.4 compatible formatting of doubles} precision \
    {expr 1e281} \
    1e+281
test util-16.1.17.282 {8.4 compatible formatting of doubles} precision \
    {expr 1e282} \
    1e+282
test util-16.1.17.283 {8.4 compatible formatting of doubles} precision \
    {expr 1e283} \
    9.9999999999999996e+282
test util-16.1.17.284 {8.4 compatible formatting of doubles} precision \
    {expr 1e284} \
    1.0000000000000001e+284
test util-16.1.17.285 {8.4 compatible formatting of doubles} precision \
    {expr 1e285} \
    9.9999999999999998e+284
test util-16.1.17.286 {8.4 compatible formatting of doubles} precision \
    {expr 1e286} \
    1e+286
test util-16.1.17.287 {8.4 compatible formatting of doubles} precision \
    {expr 1e287} \
    1.0000000000000001e+287
test util-16.1.17.288 {8.4 compatible formatting of doubles} precision \
    {expr 1e288} \
    1e+288
test util-16.1.17.289 {8.4 compatible formatting of doubles} precision \
    {expr 1e289} \
    1.0000000000000001e+289
test util-16.1.17.290 {8.4 compatible formatting of doubles} precision \
    {expr 1e290} \
    1.0000000000000001e+290
test util-16.1.17.291 {8.4 compatible formatting of doubles} precision \
    {expr 1e291} \
    9.9999999999999996e+290
test util-16.1.17.292 {8.4 compatible formatting of doubles} precision \
    {expr 1e292} \
    1e+292
test util-16.1.17.293 {8.4 compatible formatting of doubles} precision \
    {expr 1e293} \
    9.9999999999999992e+292
test util-16.1.17.294 {8.4 compatible formatting of doubles} precision \
    {expr 1e294} \
    1.0000000000000001e+294
test util-16.1.17.295 {8.4 compatible formatting of doubles} precision \
    {expr 1e295} \
    9.9999999999999998e+294
test util-16.1.17.296 {8.4 compatible formatting of doubles} precision \
    {expr 1e296} \
    9.9999999999999998e+295
test util-16.1.17.297 {8.4 compatible formatting of doubles} precision \
    {expr 1e297} \
    1e+297
test util-16.1.17.298 {8.4 compatible formatting of doubles} precision \
    {expr 1e298} \
    9.9999999999999996e+297
test util-16.1.17.299 {8.4 compatible formatting of doubles} precision \
    {expr 1e299} \
    1.0000000000000001e+299
test util-16.1.17.300 {8.4 compatible formatting of doubles} precision \
    {expr 1e300} \
    1.0000000000000001e+300
test util-16.1.17.301 {8.4 compatible formatting of doubles} precision \
    {expr 1e301} \
    1.0000000000000001e+301
test util-16.1.17.302 {8.4 compatible formatting of doubles} precision \
    {expr 1e302} \
    1.0000000000000001e+302
test util-16.1.17.303 {8.4 compatible formatting of doubles} precision \
    {expr 1e303} \
    1e+303
test util-16.1.17.304 {8.4 compatible formatting of doubles} precision \
    {expr 1e304} \
    9.9999999999999994e+303
test util-16.1.17.305 {8.4 compatible formatting of doubles} precision \
    {expr 1e305} \
    9.9999999999999994e+304
test util-16.1.17.306 {8.4 compatible formatting of doubles} precision \
    {expr 1e306} \
    1e+306
test util-16.1.17.307 {8.4 compatible formatting of doubles} precision \
    {expr 1e307} \
    9.9999999999999999e+306

test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    set r {}
    foreach {input} {
	0x1ffffffffffffc000
	0x1ffffffffffffc800
	0x1ffffffffffffd000
2223
2224
2225
2226
2227
2228
2229




2230
2231
2232
2233
2234
2235
2236
2237
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:







>
>
>
>








4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
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}

if {[catch {set ::tcl_precision $saved_precision}]} {
    unset ::tcl_precision
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
Changes to tests/var.test.
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
    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
	}
	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 {
    catch {unset aaaaa}
    catch {unset xxxxx}
} -body {
    set aaaaa 77777







|



<







265
266
267
268
269
270
271
272
273
274
275

276
277
278
279
280
281
282
    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 1 a {} vv namespace
	}
	p
    }

    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 {
    catch {unset aaaaa}
    catch {unset xxxxx}
} -body {
    set aaaaa 77777
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
    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 {
    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 $test_ns_var::five \
        [set test_ns_var::six 6] [set test_ns_var::six] $six
} -cleanup {
    catch {unset five}
    catch {unset six}
} -result {5 5 6 6 666}







|











|







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
    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 {
    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 $test_ns_var::five \
        [set test_ns_var::six 6] [set test_ns_var::six] $six
} -cleanup {
    catch {unset five}
    catch {unset six}
} -result {5 5 6 6 666}
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
        variable sev:::en 7
    }
} -result {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
        variable 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 {
    catch {namespace delete test_ns_var2}
} -body {
    set a ""







|

|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
        variable sev:::en 7
    }
} -result {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
        variable 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 {
    catch {namespace delete test_ns_var2}
} -body {
    set a ""
Changes to tests/while-old.test.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    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
} 10
test while-old-1.2 {basic while loops} {
    set value xxx
    while {2 > 3} {set value yyy}
    set value
} xxx







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    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
} 10
test while-old-1.2 {basic while loops} {
    set value xxx
    while {2 > 3} {set value yyy}
    set value
} xxx
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
} {2}

test while-old-2.1 {continue in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 2} {set index [expr $index+1]; continue}
	set result [concat $result [lindex $list $index]]
	set index [expr $index+1]
    }
    set result
} {1 2 4 5}

test while-old-3.1 {break in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 3} break
	set result [concat $result [lindex $list $index]]
	set index [expr $index+1]
    }
    set result
} {1 2 3}

test while-old-4.1 {errors in while loops} {
    set err [catch {while} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.2 {errors in while loops} {
    set err [catch {while 1} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
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 "+"}}
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} {







|

|











|



















|







54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
} {2}

test while-old-2.1 {continue in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 2} {set index [expr {$index + 1}]; continue}
	set result [concat $result [lindex $list $index]]
	set index [expr {$index + 1}]
    }
    set result
} {1 2 4 5}

test while-old-3.1 {break in while loop} {
    set list {1 2 3 4 5}
    set index 0
    set result {}
    while {$index < 5} {
	if {$index == 3} break
	set result [concat $result [lindex $list $index]]
	set index [expr {$index + 1}]
    }
    set result
} {1 2 3}

test while-old-4.1 {errors in while loops} {
    set err [catch {while} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.2 {errors in while loops} {
    set err [catch {while 1} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
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 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.
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    catch {while {$i<} break}
    return $::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 {
    set value 1
    while {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
    }







|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    catch {while {$i<} break}
    return $::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 as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
    set value 1
    while {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
    }
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
} -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} -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}







|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
} -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} -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}
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
} -cleanup {
    unset x1 bb x2 a i
} -result {x1}
test while-1.12 {TclCompileWhileCmd: long command body} -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
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
} -cleanup {
    unset x1 bb x2 a i
} -result {x1}
test while-1.12 {TclCompileWhileCmd: long command body} -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
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
    set a [while {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
test while-1.14 {TclCompileWhileCmd: while command result} -body {
    set i 0
    set a [while {$i < 5} {if $i==3 break; incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}

# Check "while" and "continue".








|







151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
    set a [while {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
test while-1.14 {TclCompileWhileCmd: while command result} -body {
    set i 0
    set a [while {$i < 5} {if {$i==3} break; incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}

# Check "while" and "continue".

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
} -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 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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|
|







203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
} -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 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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
} -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 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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|
|















|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
} -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 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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} break
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    return $::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 {
    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 value 1
    set z while
    $z {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break







|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    return $::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 {
    set z while
    $z {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
    set value 1
    set z while
    $z {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
    invoked from within
"$z {$i < 5} {set}"}
test while-4.10 {while (not compiled): simple command body} -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}







|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
    invoked from within
"$z {$i < 5} {set}"}
test while-4.10 {while (not compiled): simple command body} -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}
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
    unset z x1 bb x2 a i
} -result {x1}
test while-4.13 {while (not compiled): long command body} -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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
    unset z x1 bb x2 a i
} -result {x1}
test while-4.13 {while (not compiled): long command body} -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"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
    return $a
} -cleanup {
    unset a i z
} -result {}
test while-4.15 {while (not compiled): while command result} -body {
    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 {}

# Check "break" with computed command names.








|







480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
    return $a
} -cleanup {
    unset a i z
} -result {}
test while-4.15 {while (not compiled): while command result} -body {
    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 {}

# Check "break" with computed command names.

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
    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 a {}
    set i 1
    set z break
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==5 $z
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if $i==4 $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|
|















|







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
    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 a {}
    set i 1
    set z break
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==5} $z
	if {$i>5} continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i==4} $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
    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 a {}
    set i 1
    set z continue
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==4 break
	if $i>5 $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg







|
|
|







633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
    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 a {}
    set i 1
    set z continue
    while {$i<6} {
	if {$i==2} {incr i; continue}
	if {$i==4} break
	if {$i>5} $z
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
Changes to tests/winDde.test.
16
17
18
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

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]}]} {
	testConstraint dde 1
    }
}



# -------------------------------------------------------------------------
# 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 {
        # DDE child server -
        #
	if {"::tcltest" ni [namespace children]} {
	    package require tcltest 2.5
	    namespace import -force ::tcltest::*
	}







|



>













|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

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 [info loaded "" Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]


# -------------------------------------------------------------------------
# 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 {
        # DDE child server -
        #
	if {"::tcltest" ni [namespace children]} {
	    package require tcltest 2.5
	    namespace import -force ::tcltest::*
	}
106
107
108
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.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
} -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
} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
	-constraints dde -body {
    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]







|







|



|







107
108
109
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}
} -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}
} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
	-constraints dde -body {
    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]
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
} -result foo
test winDde-3.5 {DDE request locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
    dde request -binary TclEval self \xe1
} -result "foo\x00"
# Set variable a to A with diaeresis (unicode C4) by relying on the fact
# that utf8 is sent (e.g. "c3 84" on the wire)
test winDde-3.6 {DDE request utf8} -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 -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







|
|






|







150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
} -result foo
test winDde-3.5 {DDE request locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
    dde request -binary TclEval self \xe1
} -result "foo\x00"
# Set variable a to A with diaeresis (unicode C4) by relying on the fact
# that utf-8 is sent (e.g. "c3 84" on the wire)
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 {
    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
Changes to tests/winFCmd.test.
24
25
26
27
28
29
30


31

32
33
34
35
36
37
38
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)]}]


proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}







>
>
|
>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
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
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv     [expr {![info exists ::env(CI)]}]
testConstraint knownMsvcBug   [expr {![info exists ::env(CI_BUILD_WITH_MSVC)]}]

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
# 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 {
    cleanup
} -constraints {win testfile} -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 {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -returnCodes error -result EISDIR
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {







|






|




|





|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
# 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 {
    cleanup
} -constraints {win testfile notInCIenv} -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 {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    file mkdir td1
    testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -returnCodes error -result EISDIR
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
    cleanup
} -constraints {win testfile} -body {
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
    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 {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / c:/







|







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    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 {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    file mkdir td1
    testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / c:/
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
} -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} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
    cleanup
} -constraints {win testfile} -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}
test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
	-constraints {win exdev testfile testchmod} -body {







|






|






|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
} -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 notInCIenv} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -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}
test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
	-constraints {win exdev testfile testchmod} -body {
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    createfile tf1
    testfile mv td1 tf1
} -cleanup {
    cleanup
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {







|







342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
    createfile tf1
    testfile mv td1 tf1
} -cleanup {
    cleanup
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
        lappend inodes $stat(ino)
        unset stat
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}







|







393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
        lappend inodes $stat(ino)
        unset stat
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notInCIenv} -body {
    file mkdir td1
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
    list [file type td1] [file type td2]
} -cleanup {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
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
    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 {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile} -body {
    testfile rmdir /
    # 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
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|










|






|







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
    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 {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile notInCIenv} -body {
    testfile rmdir /
    # 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
} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup







|







939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notInCIenv} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 1] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 0] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
} -cleanup {
    cleanup







|







|







1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 1] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notInCIenv} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 0] [file attributes td1 -archive]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notInCIenv} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
} -cleanup {
    cleanup
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
} -cleanup {
    cleanup
} -result {{} 1}







|







1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notInCIenv} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
} -cleanup {
    cleanup
} -result {{} 1}
Changes to tests/winFile.test.
20
21
22
23
24
25
26

27
28
29
30
31
32
33

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}


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 {
    # The administrator account should always exist.
    glob ~administrator







>







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

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]

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 {
    # The administrator account should always exist.
    glob ~administrator
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS
} -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
} -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
} -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







|














|










|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS notWine
} -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
} -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
} -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
Changes to tests/winPipe.test.
23
24
25
26
27
28
29



30
31
32
33
34
35
36
    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]




# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]







>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    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 {![info exists ::env(CI_USING_WINE)]}]


# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    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} {
    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} {
    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} {
    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} {
    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}







|







|







|







|







196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
    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} {
    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} {
    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} {
    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} {
    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}
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547

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} -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} -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} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}







|








|








|







518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

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 {
    _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 {
    _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 {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}
Changes to tests/winTime.test.
15
16
17
18
19
20
21


22
23
24
25
26
27
28
29
    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} {
    set ::env(TZ) JST-9
    set result [clock format -1 -format %Y]







>
>
|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    namespace import -force ::tcltest::*
}

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

testConstraint testwinclock [llength [info commands testwinclock]]
# Some things fail under all Continuous Integration systems for subtle reasons
# such as CI often running with elevated privileges in a container.
testConstraint notInCIenv   [expr {![info exists ::env(CI)]}]

# 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} {
    set ::env(TZ) JST-9
    set result [clock format -1 -format %Y]
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    set result
} {1969}

# Next test tries to make sure that the Tcl clock stays in step
# with the Windows clock.  30 sec really isn't enough,
# but how much time does a tester have patience for?

test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock knownMsvcBug} {
    # May fail due to OS/hardware discrepancies.  See:
    # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
    set failed {}
    set ok 1
    foreach start_sec [testwinclock] break
    while { 1 } {
	foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
    set result
} {1969}

# Next test tries to make sure that the Tcl clock stays in step
# with the Windows clock.  30 sec really isn't enough,
# but how much time does a tester have patience for?

test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} {
    # May fail due to OS/hardware discrepancies.  See:
    # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
    set failed {}
    set ok 1
    foreach start_sec [testwinclock] break
    while { 1 } {
	foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break
Changes to tests/zlib.test.
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    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} {







|







136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    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} {
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
    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







|







447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
    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
Changes to tools/README.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
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







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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/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
Changes to tools/checkLibraryDoc.tcl.
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])
# 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.)





|







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., tcl8.7/*/*.[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
    Tcl_SavedResult \
    Tcl_ThreadDataKey \
    Tcl_ThreadId \
    Tcl_Time \
    Tcl_TimerToken \
    Tcl_Token \
    Tcl_Trace \


    Tcl_Var \
    Tk_3DBorder \
    Tk_ArgvInfo \
    Tk_BindingTable \
    Tk_Canvas \
    Tk_CanvasTextInfo \
    Tk_ConfigSpec \







>
>







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
    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 \
Changes to tools/configure.
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
# 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


# Check whether --with-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`







|







1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
# 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.7


# Check whether --with-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`
Changes to tools/configure.ac.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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?)













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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=8.7

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?)
Changes to tools/tcl.hpj.in.
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
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl90.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0








|

|







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=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl87.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Changes to tools/tclZIC.tcl.
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
    pacificnew southamerica systemv
}

# Define the year at which the DST information will stop.

set maxyear 2100

# Determine how big a wide integer is.







|







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
}

# Define the year at which the DST information will stop.

set maxyear 2100

# Determine how big a wide integer is.
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
#!/usr/bin/env tclsh

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)."
    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 ::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]






|

















|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#!/usr/bin/env tclsh

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\
	tclsh8.7 (or the equivalent tclsh87.exe\non Windows)."
    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/8.7"
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]
Changes to unix/Makefile.in.
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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@








|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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)/../tcl8

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

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
# 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
# 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}







|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
# 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 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}
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
# 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}
	rm -rf $(TOP_DIR)/tests/safe-stock86.test
	$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"

tcltest-real:
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE}








<







862
863
864
865
866
867
868

869
870
871
872
873
874
875
# 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}

	$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"

tcltest-real:
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE}

958
959
960
961
962
963
964
965

966
967
968
969
970
971
972
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-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"; \







|
>







957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
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}"

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"; \
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
	@for i in opt0.4 cookiejar0.2 encoding; do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		else true; \
		fi; \
	    done;
	@for i in 9.0 9.0/platform; \
	    do \
	    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)/"
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(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 \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	@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 \
		"$(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 \
		"$(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 \
		"$(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 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)} }" >> \







|




















|






|


|


|


|







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
	@for i in opt0.4 cookiejar0.2 encoding; do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		else true; \
		fi; \
	    done;
	@for i in 8.4 8.4/platform 8.5 8.6 8.7; \
	    do \
	    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)/"
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(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 \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	@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 \
		"$(MODULE_INSTALL_DIR)/8.6/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 \
		"$(MODULE_INSTALL_DIR)/8.7/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)/8.5/tcltest-2.5.3.tm"
	@echo "Installing package platform 1.0.14 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/8.4/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)/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)} }" >> \
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
# 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 \
		$(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 \
		$(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \
		$(UNIX_DIR)/install-sh \
		$(UNIX_DIR)/README $(UNIX_DIR)/tcl.spec \
		$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix

	$(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 \
		$(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 \
		$(TOP_DIR)/library/manifest.txt \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	@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
	$(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
	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
	@( cd $(TOP_DIR); find library/tzdata -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] \
		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
	$(INSTALL_DATA_DIR) $(DISTDIR)/compat
	$(DIST_INSTALL_DATA) $(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 \
		$(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 \
		$(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 \
		$(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 \
		$(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
	$(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \
		$(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \
		$(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 \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
		$(TOOL_DIR)/*.bmp $(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
	$(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; \
		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.* &
# 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.
#







<
<

















|
|
|
|
>
|



|


>
|
|
|
|
|
|
|


|
|



|
|

|
|
|
|
|




|
|

|
|

|




|
|
|


|
|
|




<
|

|
|
|
|
|
|
|
|


<
|
|
|
|


|
|


|
|

|
|




<
<
<
<
<
|
|
|
|
|














|







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


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 \
		$(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH}
	rm -rf $(DISTDIR)
	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.ac \
		$(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \
		$(UNIX_DIR)/install-sh \
		$(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 $(DISTDIR)/unix/configure.ac
	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)
	@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 $(BUILTIN_PACKAGE_LIST); do \
	    mkdir $(DISTDIR)/library/$$i;\
	    cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	done
	cp -p $(TOP_DIR)/library/cookiejar/*.txt.gz $(DISTDIR)/library/cookiejar
	@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) ; xargs tar cf - ) \
	    | ( cd $(DISTDIR) ; tar xfp - )
	@mkdir $(DISTDIR)/doc
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
	@mkdir $(DISTDIR)/compat
	cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \
		$(COMPAT_DIR)/README $(DISTDIR)/compat
	@mkdir $(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 - )
	@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
	@mkdir $(DISTDIR)/win
	cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
	cp $(TOP_DIR)/win/configure.ac $(TOP_DIR)/win/configure \
		$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
		$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
		$(TOP_DIR)/win/tclsh.exe.manifest.in \
		$(DISTDIR)/win

	cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
		$(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/*.vc $(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 \

		$(MAC_OSX_DIR)/configure $(DISTDIR)/macosx
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx
	@mkdir $(DISTDIR)/macosx/Tcl.xcode
	cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \
		$(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \
		$(DISTDIR)/macosx/Tcl.xcode
	@mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
	cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \
		$(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \
		$(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.ac \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools





	@mkdir $(DISTDIR)/libtommath
	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
	@mkdir $(DISTDIR)/pkgs
	cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
	cp $(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; \
		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 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.
#
Changes to unix/README.
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
	--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 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):







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
	--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,
				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.
1
2
3
4
5
6
7
8
9
10
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for tcl 9.0.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.


|







1
2
3
4
5
6
7
8
9
10
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for tcl 8.7.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
PACKAGE_VERSION='9.0'
PACKAGE_STRING='tcl 9.0'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H







|
|







573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
PACKAGE_VERSION='8.7'
PACKAGE_STRING='tcl 8.7'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
#
# 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 tcl 9.0 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.







|







1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
#
# 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 tcl 8.7 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.
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tcl 9.0:";;
   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]







|







1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tcl 8.7:";;
   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]
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)

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 (default:
                          iso8859-1)
  --with-system-libtommath
                          use external libtommath (default: true if available,
                          false otherwise)
  --with-tzdata           install timezone data (default: autodetect)

Some influential environment variables:
  CC          C compiler command







|







1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
  --enable-framework      package shared libraries in MacOSX frameworks
                          (default: off)

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 (default:
                          utf-8)
  --with-system-libtommath
                          use external libtommath (default: true if available,
                          false otherwise)
  --with-tzdata           install timezone data (default: autodetect)

Some influential environment variables:
  CC          C compiler command
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tcl configure 9.0
generated by GNU Autoconf 2.69

Copyright (C) 2012 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







|







1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tcl configure 8.7
generated by GNU Autoconf 2.69

Copyright (C) 2012 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
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_member
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 tcl $as_me 9.0, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{







|







2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_member
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 tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
ac_compiler_gnu=$ac_cv_c_compiler_gnu






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







|
|
|
|







2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
ac_compiler_gnu=$ac_cv_c_compiler_gnu






TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a4"
VERSION=${TCL_VERSION}

EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992

cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else

$as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------







|







3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992

cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else

$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
	case "${CC}" in
	    *++|*++-*)
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac







|







5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	case "${CC}" in
	    *++|*++-*)
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
struct tm tm; tm.tm_gmtoff;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_member_tm_gmtoff=yes
else







|







8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649

	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <time.h>
int
main ()
{
struct tm tm; (void)tm.tm_gmtoff;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_member_tm_gmtoff=yes
else
11130
11131
11132
11133
11134
11135
11136
11137
11138
11139
11140
11141
11142
11143
11144
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, 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 tcl $as_me 9.0, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@







|







11130
11131
11132
11133
11134
11135
11136
11137
11138
11139
11140
11141
11142
11143
11144
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, 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 tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
11187
11188
11189
11190
11191
11192
11193
11194
11195
11196
11197
11198
11199
11200
11201

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
tcl config.status 9.0
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."








|







11187
11188
11189
11190
11191
11192
11193
11194
11195
11196
11197
11198
11199
11200
11201

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
tcl config.status 8.7
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

Changes to 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
#! /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





|


















|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
#! /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.7])
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=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a4"
VERSION=${TCL_VERSION}

EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
Changes to unix/dltest/pkga.c.
46
47
48
49
50
51
52

53
54
55
56
57
58
59
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    const char *str1, *str2;
    int len1, len2;


    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);







>







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    const char *str1, *str2;
    int len1, len2;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
87
88
89
90
91
92
93


94
95
96
97
98
99
100
static int
Pkga_QuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{


    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[1]);
    return TCL_OK;
}







>
>







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
static int
Pkga_QuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[1]);
    return TCL_OK;
}
Changes to unix/dltest/pkgb.c.
50
51
52
53
54
55
56

57
58
59
60
61
62
63
Pkgb_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;


    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {







>







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Pkgb_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
90
91
92
93
94
95
96




97
98
99
100
101
102
103
104
105
106
107
108



109
110
111
112
113
114
115
static int
Pkgb_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{




    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;




    if (Tcl_ListObjIndex(NULL, Tcl_GetEncodingSearchPath(), 0, &first)
	    == TCL_OK) {
	Tcl_SetObjResult(interp, first);
    }
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1));







>
>
>
>












>
>
>







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
static int
Pkgb_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (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));
Changes to unix/dltest/pkgc.c.
44
45
46
47
48
49
50

51
52
53
54
55
56
57
Pkgc_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;


    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {







>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Pkgc_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
81
82
83
84
85
86
87




88
89
90
91
92
93
94
static int
Pkgc_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{




    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







>
>
>
>







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
static int
Pkgc_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
Changes to unix/dltest/pkgd.c.
44
45
46
47
48
49
50

51
52
53
54
55
56
57
Pkgd_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;


    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {







>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Pkgd_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, second;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
81
82
83
84
85
86
87




88
89
90
91
92
93
94
static int
Pkgd_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{




    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







>
>
>
>







82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
static int
Pkgd_UnsafeObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
Changes to unix/dltest/pkgooa.c.
34
35
36
37
38
39
40


41
42
43
44
45
46
47
static int
Pkgooa_StubsOKObjCmd(
    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, "");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(
	    Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance));
    return TCL_OK;







>
>







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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;
72
73
74
75
76
77
78
79
80
81




82
83
84
85
86
87
88
    /* 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)) Pkgooa_StubsOKObjCmd
    /* More entries could be here, but those are not used
     * for this test-case. So, being NULL is OK. */




};

extern DLLEXPORT int
Pkgooa_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{







|


>
>
>
>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
    /* 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. */
{
Changes to unix/dltest/pkgua.c.
121
122
123
124
125
126
127

128
129
130
131
132
133
134
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    const char *str1, *str2;
    int len1, len2;


    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);







>







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    const char *str1, *str2;
    int len1, len2;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv,  "string1 string2");
	return TCL_ERROR;
    }

    str1 = Tcl_GetStringFromObj(objv[1], &len1);
162
163
164
165
166
167
168


169
170
171
172
173
174
175
static int
PkguaQuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{


    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[1]);
    return TCL_OK;
}







>
>







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
static int
PkguaQuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[1]);
    return TCL_OK;
}
Changes to unix/install-sh.
1
2
3
4
5
6
7
8
9
10
11
#!/bin/sh
# install - install a program, script, or datafile

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
#



|







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

# 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
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
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.


nl='
'
IFS=" ""	$nl"

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





chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
mvcmd=$mvprog
rmcmd="$rmprog -f"
stripcmd=

src=
dst=
dir_arg=
dst_arg=

copy_on_change=false
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...








|





>


|

|

<

<
|
<
<
<














<
<
<
<
<
<
<
<
<
<
<




>
>
>
>














|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

51

52



53
54
55
56
57
58
59
60
61
62
63
64
65
66











67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
# 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
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.

tab='	'
nl='
'
IFS=" $tab$nl"

# Set DOITPROG to "echo" to test this script.


doit=${DOITPROG-}

doit_exec=${doit:-exec}




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

usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
   or: $0 [OPTION]... SRCFILES... DIRECTORY
   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
   or: $0 [OPTION]... -d DIRECTORIES...

116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161


162




163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178










179
180
181
182
183
184
185
186
187
188
189
190
191
192




193
194
195
196
197
198
199
200
201
202
203
204









205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
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            $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;;

    --help) echo "$usage"; exit $?;;

    -m) mode=$2
	case $mode in
	  *' '* | *'	'* | *'
'*	  | *'*'* | *'?'* | *'['*)
	    echo "$0: invalid mode: $mode" >&2
	    exit 1;;
	esac
	shift;;

    -o) chowncmd="$chownprog $2"
	shift;;

    -s) stripcmd=$stripprog;;

    -S) stripcmd="$stripprog $2"
	shift;;



    -t) dst_arg=$2




	shift;;

    -T) no_target_directory=true;;

    --version) echo "$0 $scriptversion"; exit $?;;

    --)	shift
	break;;

    -*)	echo "$0: invalid option: $1" >&2
	exit 1;;

    *)  break;;
  esac
  shift
done











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




  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.
  # This can happen when creating conditional directories.
  exit 0
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=
      else
	u_plus_rw='% 200'
      fi
      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
    *)
      if test -z "$stripcmd"; then
	u_plus_rw=
      else
	u_plus_rw=,u+rw
      fi
      cp_umask=$mode$u_plus_rw;;
  esac
fi

for src
do
  # Protect names starting with `-'.
  case $src in
    -*) src=./$src;;
  esac

  if test -n "$dir_arg"; then
    dst=$src
    dstdir=$dst
    test -d "$dstdir"
    dstdir_status=$?







|

















|




|
<
|
|
|
|
|


|




|

>
>
|
>
>
>
>
|

|



|
|

|
|





>
>
>
>
>
>
>
>
>
>














>
>
>
>








|



>
>
>
>
>
>
>
>
>

















|

|




|

|







|

|







105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
  -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.
  -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;;

    --help) echo "$usage"; exit $?;;

    -m) mode=$2
        case $mode in

          *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
            echo "$0: invalid mode: $mode" >&2
            exit 1;;
        esac
        shift;;

    -o) chowncmd="$chownprog $2"
        shift;;

    -s) stripcmd=$stripprog;;

    -S) stripcmd="$stripprog $2"
        shift;;

    -t)
        is_target_a_directory=always
        dst_arg=$2
        # Protect names problematic for 'test' and other utilities.
        case $dst_arg in
          -* | [=\(\)!]) dst_arg=./$dst_arg;;
        esac
        shift;;

    -T) is_target_a_directory=never;;

    --version) echo "$0 $scriptversion"; exit $?;;

    --) shift
        break;;

    -*) 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.
  # 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=
      else
        u_plus_rw='% 200'
      fi
      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
    *)
      if test -z "$stripcmd"; then
        u_plus_rw=
      else
        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.
  case $src in
    -* | [=\(\)!]) src=./$src;;
  esac

  if test -n "$dir_arg"; then
    dst=$src
    dstdir=$dst
    test -d "$dstdir"
    dstdir_status=$?
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278




279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311





312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350





351




352

353
354
355
356
357
358
359

360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460











461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
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; won't work
    # if double slashes aren't ignored.
    if test -d "$dst"; then
      if test -n "$no_target_directory"; then
	echo "$0: $dst_arg: Is a directory" >&2
	exit 1
      fi
      dstdir=$dst
      dst=$dstdir/`basename "$src"`




      dstdir_status=0
    else
      # Prefer dirname, but fall back on a substitute if dirname fails.
      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






  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

	posix_mkdir=false
	case $umask in
	  *[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










	    if (umask $mkdir_umask &&

		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.

		   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"
      )
    then :
    else

      # 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='';;
      esac

      eval "$initialize_posix_glob"

      oIFS=$IFS
      IFS=/
      $posix_glob set -f
      set fnord $dstdir
      shift
      $posix_glob set +f
      IFS=$oIFS

      prefixes=

      for d
      do
	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/
      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
      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=$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 && $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` &&

       eval "$initialize_posix_glob" &&
       $posix_glob set -f &&
       set X $old && old=:$2:$4:$5:$6 &&
       set X $new && new=:$2:$4:$5:$6 &&
       $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 rename the file to the real destination.
	$doit $mvcmd "$dsttmp" "$dst"
      }
    fi || exit 1

    trap '' 0
  fi
done

# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:







<

<
<
<
<

|
<

|
|
|


|
>
>
>
>


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




>
>
>
>
>






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

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

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




|
|




|




|
|
|


<
<


|


|






|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|



|
|
|
|
|












|
|





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














|
|
<
<
|


|
<












|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|








|


|


273
274
275
276
277
278
279

280




281
282

283
284
285
286
287
288
289
290
291
292
293
294
295

296

























297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
















312
313
314
315
316
317
318
319
320
321





322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383


384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470


471
472
473
474

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

    if test -z "$dst_arg"; then
      echo "$0: no destination specified." >&2
      exit 1
    fi

    dst=$dst_arg





    # If destination is a directory, append the input filename.

    if test -d "$dst"; then
      if test "$is_target_a_directory" = never; then
        echo "$0: $dst_arg: Is a directory" >&2
        exit 1
      fi
      dstdir=$dst
      dstbase=`basename "$src"`
      case $dst in
	*/) dst=$dst$dstbase;;
	*)  dst=$dst/$dstbase;;
      esac
      dstdir_status=0
    else

      dstdir=`dirname "$dst"`

























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
















        # 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





	# here however when possible just to lower collision chance.
	tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$

	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 &&
	    $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.
	       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;;

    esac

    if
      $posix_mkdir && (
        umask $mkdir_umask &&
        $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
      )
    then :
    else

      # 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='';;
      esac



      oIFS=$IFS
      IFS=/
      set -f
      set fnord $dstdir
      shift
      set +f
      IFS=$oIFS

      prefixes=

      for d
      do
        test X"$d" = X && 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/
      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
      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.$$_

    # 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") &&

    # 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 &&
       set X $old && old=:$2:$4:$5:$6 &&
       set X $new && new=:$2:$4:$5:$6 &&
       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 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)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:
Changes to unix/tcl.m4.
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
	    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 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` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi







|


|
|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
	    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/tcl8.7 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
	case "${CC}" in
	    *++|*++-*)
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac







|







962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	case "${CC}" in
	    *++|*++-*)
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
	AC_TRY_COMPILE([#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; 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







|







2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
	AC_TRY_COMPILE([#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)])
    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
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
#		TCL_CFGVAL_ENCODING
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CFG_ENCODING], [
    AC_ARG_WITH(encoding,
	AC_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,"iso8859-1",
	    [What encoding should be used for embedded configuration info?])
    fi
])

#--------------------------------------------------------------------
# SC_TCL_CHECK_BROKEN_FUNC
#







|






|







2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
#		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})

    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",
	    [What encoding should be used for embedded configuration info?])
    fi
])

#--------------------------------------------------------------------
# SC_TCL_CHECK_BROKEN_FUNC
#
Changes to unix/tcl.spec.
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
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}







|







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:       8.7a3
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/tclConfig.sh.in.
16
17
18
19
20
21
22





23
24
25
26
27
28
29
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@'






# 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@'







>
>
>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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.
# DEPRECATED, will be removed in Tcl 9!
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@'
Changes to unix/tclEpollNotfy.c.
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    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;

    /*







|







236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	newEvent.events |= EPOLLIN;
    }
    if (filePtr->mask & TCL_WRITABLE) {
	newEvent.events |= EPOLLOUT;
    }
    if (isNew) {
        newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	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));
    }
}







|
|





|







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
#endif /* HAVE_EVENTFD */
    ckfree(tsdPtr->triggerFilePtr->pedPtr);
    ckfree(tsdPtr->triggerFilePtr);
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	ckfree(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));
    }
}
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
    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);
}

/*
 *----------------------------------------------------------------------







|




















|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
    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 *)ckalloc(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 *)ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	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;







|







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	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;
	    isNew = 1;
	} else {
	    isNew = 0;
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

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







|











|







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

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
	if (filePtr->pedPtr) {
	    ckfree(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
	    /*
	     * 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;







|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
	    /*
	     * 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);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
	    /*
	     * 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;
	}







|







809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
	    /*
	     * 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;
	}
Changes to unix/tclKqueueNotfy.c.
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
{
    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







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	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));
    }
}







|







340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
	tsdPtr->triggerPipe[1] = -1;
    }
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	ckfree(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));
    }
}
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
	}
    }
    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);
}

/*
 *----------------------------------------------------------------------







|





|







405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
	}
    }
    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 *)ckalloc(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 *)ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
	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;







|







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
	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;
	    isNew = 1;
	} else {
	    isNew = 0;
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

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







|











|







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

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
	if (filePtr->pedPtr) {
	    ckfree(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
	    /*
	     * 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;







|







765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
	    /*
	     * 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);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
	    /*
	     * 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;
	}







|







825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
	    /*
	     * 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;
	}
Changes to unix/tclLoadDl.c.
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
	/*
	 * 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);

	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	/*
	 * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
	 */
	handle = dlopen(native, dlopenflags);
	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));
	}
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;







|




















|



|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;
	const char *fileName = Tcl_GetString(pathPtr);

	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	/*
	 * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
	 */
	handle = dlopen(native, dlopenflags);
	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",
		    Tcl_GetString(pathPtr), errorStr));
	}
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	native = Tcl_DStringAppend(&newName, native, -1);
	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, Tcl_DStringValue(&ds), -1);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */







|







187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
#ifdef __cplusplus
    if (proc == NULL) {
	char buf[32];
	sprintf(buf, "%d", Tcl_DStringLength(&ds));
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "__Z");
	Tcl_DStringAppend(&newName, buf, -1);
	Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), -1);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    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;

    dlclose(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *))
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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









252
253
254
255
256
257
258
259




























260
261
262
263
264
265
266
267
268
    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;

    dlclose(handle);
    ckfree(loadHandle);




























}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to unix/tclLoadDyld.c.
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    /*
     * 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);
    nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr),
	    -1, &ds);

#if TCL_DYLD_USE_DLFCN
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     */








|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    /*
     * 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);
    nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr),
	    -1, &ds);

#if TCL_DYLD_USE_DLFCN
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     */

254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296

297
298
299
300
301
302
303
		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
    ) {
	dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle->dlHandle = dlHandle;
#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));
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {
	Tcl_Obj *errObj = Tcl_NewObj();


	if (errMsg != NULL) {
	    Tcl_AppendToObj(errObj, errMsg, -1);
	}
#if TCL_DYLD_USE_NSMODULE
	if (objFileImageErrMsg) {
	    Tcl_AppendPrintfToObj(errObj,
		    "\nNSCreateObjectFileImageFromFile() error: %s",







|



















|





|







|

>







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
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 (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
    ) {
	dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle->dlHandle = dlHandle;
#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)ckalloc(sizeof(*newHandle));
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {
	Tcl_Obj *errObj;

	TclNewObj(errObj);
	if (errMsg != NULL) {
	    Tcl_AppendToObj(errObj, errMsg, -1);
	}
#if TCL_DYLD_USE_NSMODULE
	if (objFileImageErrMsg) {
	    Tcl_AppendPrintfToObj(errObj,
		    "\nNSCreateObjectFileImageFromFile() error: %s",
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr->module = module;
		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
		    dyldLoadHandle->modulePtr = modulePtr;
		}
#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
	    } else {
		NSLinkEditErrors editError;







|







378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    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;
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

	while (modulePtr != NULL) {
	    void *ptr = modulePtr;

	    (void) NSUnLinkModule(modulePtr->module,
		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
	    modulePtr = modulePtr->nextPtr;
	    Tcl_Free(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_Free(dyldLoadHandle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *) /*bufPtr*/)
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemoryGetBuffer --
 *







|



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







453
454
455
456
457
458
459
460
461
462
463
464
465




























466
467
468
469
470
471
472

	while (modulePtr != NULL) {
	    void *ptr = modulePtr;

	    (void) NSUnLinkModule(modulePtr->module,
		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
	    modulePtr = modulePtr->nextPtr;
	    ckfree(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    ckfree(dyldLoadHandle);
    ckfree(loadHandle);




























}

/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemoryGetBuffer --
 *
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620

	    /*
	     * Fat binary, try to find mach_header for our architecture
	     */

	    if ((size_t) codeSize >= sizeof(struct fat_header) +
		    fh_nfat_arch * sizeof(struct fat_arch)) {
		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);
		}
		fa = NXFindBestFatArch(arch->cputype | arch_abi,







|







579
580
581
582
583
584
585
586
587
588
589
590
591
592
593

	    /*
	     * Fat binary, try to find mach_header for our architecture
	     */

	    if ((size_t) codeSize >= sizeof(struct fat_header) +
		    fh_nfat_arch * sizeof(struct fat_arch)) {
		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);
		}
		fa = NXFindBestFatArch(arch->cputype | arch_abi,
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle->dlHandle = NULL;
    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;
    return TCL_OK;
}







|


|



|







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle->dlHandle = NULL;
    dyldLoadHandle->dyldLibHeader = NULL;
    dyldLoadHandle->modulePtr = modulePtr;
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = dyldLoadHandle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
Changes to unix/tclLoadNext.c.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
    char *fileName;
    char *files[2];
    const char *native;
    int result = 1;

    NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);

    fileName = TclGetString(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.
     */








|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
    char *fileName;
    char *files[2];
    const char *native;
    int result = 1;

    NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);

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

97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	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;

    return TCL_OK;







|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;

    return TCL_OK;
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

void
UnloadFile(
    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 --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    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:
 */







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









171
172
173
174
175
176
177
178






























179
180
181
182
183
184
185
186
187

void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    ckfree(loadHandle);






























}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to unix/tclLoadOSF.c.
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
				 * 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;

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







|







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
				 * function which should be used for this
				 * file. */
    int flags)
{
    Tcl_LoadHandle newHandle;
    ldr_module_t lm;
    char *pkg;
    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.
     */
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
     */

    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;
    return TCL_OK;
}







|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
     */

    if ((pkg = strrchr(fileName, '/')) == NULL) {
        pkg = fileName;
    } else {
	pkg++;
    }
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235

static void
UnloadFile(
    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 --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this function is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name.  A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    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:
 */







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









189
190
191
192
193
194
195
196






























197
198
199
200
201
202
203
204
205

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    ckfree(loadHandle);






























}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to unix/tclLoadShl.c.
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
				 * function which should be used for this
				 * file. */
    int flags)
{
    shl_t handle;
    Tcl_LoadHandle newHandle;
    const char *native;
    char *fileName = TclGetString(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







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
				 * function which should be used for this
				 * file. */
    int flags)
{
    shl_t handle;
    Tcl_LoadHandle newHandle;
    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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}








|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
    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_unload(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this procedure is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    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:
 */







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









178
179
180
181
182
183
184
185






























186
187
188
189
190
191
192
193
194
    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_unload(handle);
    ckfree(loadHandle);






























}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to unix/tclSelectNotfy.c.
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
	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;







|







470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
	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;
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

#if defined(__CYGWIN__)

static unsigned int __stdcall
NotifierProc(







|







589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	ckfree(filePtr);
    }
}

#if defined(__CYGWIN__)

static unsigned int __stdcall
NotifierProc(
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	    /*
	     * 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;
	}







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	    /*
	     * 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;
	}
Changes to unix/tclUnixChan.c.
124
125
126
127
128
129
130




131
132
133
134
135
136
137
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);




static int		FileTruncateProc(void *instanceData,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(void *instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileWatchProc(void *instanceData, int mask);
#ifdef SUPPORTS_TTY
static int		TtyCloseProc(void *instanceData,







>
>
>
>







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
#ifndef TCL_NO_DEPRECATED
static int		FileSeekProc(void *instanceData, long offset,
			    int mode, int *errorCode);
#endif
static int		FileTruncateProc(void *instanceData,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(void *instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileWatchProc(void *instanceData, int mask);
#ifdef SUPPORTS_TTY
static int		TtyCloseProc(void *instanceData,
155
156
157
158
159
160
161
162
163
164



165

166
167
168
169
170
171
172
/*
 * This structure describes the channel type structure for file based IO:
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */



	NULL,

    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */







|


>
>
>

>







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
/*
 * This structure describes the channel type structure for file based IO:
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
#ifndef TCL_NO_DEPRECATED
    FileSeekProc,		/* Seek proc. */
#else
	NULL,
#endif
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
 * 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 = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* 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. */







|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 * 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 = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* 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. */
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    /*
     * 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) {
	return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}








|







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
    /*
     * 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, (size_t) toRead);
    if (bytesRead >= 0) {
	return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
	 * 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) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}








|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
	 * 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, (size_t) toWrite);
    if (written >= 0) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

368
369
370
371
372
373
374
375
376
377
378
379
380
381
382

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    Tcl_Free(fsPtr);
    return errorCode;
}

#ifdef SUPPORTS_TTY
static int
TtyCloseProc(
    void *instanceData,







|







376
377
378
379
380
381
382
383
384
385
386
387
388
389
390

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    ckfree(fsPtr);
    return errorCode;
}

#ifdef SUPPORTS_TTY
static int
TtyCloseProc(
    void *instanceData,
416
417
418
419
420
421
422





























































423
424
425
426
427
428
429
     * Delegate to close for files.
     */

    return FileCloseProc(instanceData, interp, flags);
}
#endif /* SUPPORTS_TTY */






























































/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	This function is called by the generic IO level to move the access
 *	point in a file based channel, with offsets expressed as wide







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







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
     * Delegate to close for files.
     */

    return FileCloseProc(instanceData, interp, flags);
}
#endif /* 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.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_DEPRECATED
static int
FileSeekProc(
    void *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. */
{
    FileState *fsPtr = (FileState *)instanceData;
    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == -1) {
	/*
	 * Bad things are happening. Error out...
	 */

	*errorCodePtr = errno;
	return -1;
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > INT_MAX) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
	return -1;
    } else {
	*errorCodePtr = (newLoc == -1) ? errno : 0;
    }
    return (int) newLoc;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	This function is called by the generic IO level to move the access
 *	point in a file based channel, with offsets expressed as wide
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
TtySetOptionProc(
    void *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;
    TtyAttrs tty;
    int argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
    vlen = strlen(value);







|







656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
TtySetOptionProc(
    void *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;
    unsigned int len, vlen;
    TtyAttrs tty;
    int argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
    vlen = strlen(value);
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
	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);
	    return TCL_ERROR;
	}

	tcgetattr(fsPtr->fileState.fd, &iostate);

	iostate.c_cc[VSTART] = argv[0][0];
	iostate.c_cc[VSTOP] = argv[1][0];







|







741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
	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);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	tcgetattr(fsPtr->fileState.fd, &iostate);

	iostate.c_cc[VSTART] = argv[0][0];
	iostate.c_cc[VSTOP] = argv[1][0];
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
	    iostate.c_cc[VSTART] = character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if ((character > 0xFF) || argv[1][charLen]) {
		goto badXchar;
	    }
	    iostate.c_cc[VSTOP] = character;
	}
	Tcl_Free(argv);

	tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec







|







764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	    iostate.c_cc[VSTART] = character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if ((character > 0xFF) || argv[1][charLen]) {
		goto badXchar;
	    }
	    iostate.c_cc[VSTOP] = character;
	}
	ckfree(argv);

	tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    Tcl_Free(argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fileState.fd, TIOCMGET, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		Tcl_Free(argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);







|






|







806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fileState.fd, TIOCMGET, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);
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
		if (flag) {
		    ioctl(fsPtr->fileState.fd, TIOCSBRK, NULL);
		} else {
		    ioctl(fsPtr->fileState.fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		Tcl_Free(argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		Tcl_Free(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 */
    }

    /*







|










|





|







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
		if (flag) {
		    ioctl(fsPtr->fileState.fd, TIOCSBRK, NULL);
		} else {
		    ioctl(fsPtr->fileState.fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		ckfree(argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	ioctl(fsPtr->fileState.fd, TIOCMSET, &control);
	ckfree(argv);
	return TCL_OK;
#else /* TIOCMGET&TIOCMSET */
	UNSUPPORTED_OPTION("-ttycontrol");
#endif /* TIOCMGET&TIOCMSET */
    }

    /*
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
TtyGetOptionProc(
    void *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;
    char buf[3*TCL_INTEGER_SPACE + 16];
    int valid = 0;		/* Flag if valid option parsed. */
    struct termios iostate;

    if (optionName == NULL) {
	len = 0;
    } else {







|







995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
TtyGetOptionProc(
    void *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;
    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 {
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
	fsPtr->doReset = 0;
	tcgetattr(fsPtr->fileState.fd, &fsPtr->initState);







|







1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)ckalloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
	fsPtr->doReset = 0;
	tcgetattr(fsPtr->fileState.fd, &fsPtr->initState);
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
	 * 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);
	    return NULL;
	}
    }

    return fsPtr->fileState.channel;
}








|







1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
	 * 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_Close(NULL, fsPtr->fileState.channel);
	    return NULL;
	}
    }

    return fsPtr->fileState.channel;
}

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
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
    struct stat buf;


    if (mode == 0) {
	return NULL;
    }



#ifdef SUPPORTS_TTY
    if (isatty(fd)) {
	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
			|| sockaddr.sa_family == AF_INET6)) {
	    return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	}
	goto normalChannelAfterAll;
    } else {
    normalChannelAfterAll:
	channelTypePtr = &fileChannelType;
	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;







|
>




>
>







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

<




|







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
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const 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)) {
	channelTypePtr = &ttyChannelType;
	sprintf(channelName, "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */





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


    } else {

	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)ckalloc(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;
Changes to unix/tclUnixCompat.c.
1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17
/*
 * 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 <errno.h>
#include <string.h>

/*
 * See also: SC_BLOCKING_STYLE in unix/tcl.m4
 */











>
>







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

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
     */

    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);
	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);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else







|












|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = (char *)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 *)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
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
     */

    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);
	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);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else







|












|







277
278
279
280
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 (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = (char *)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 *)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
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --







|







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))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ckfree(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
     */

    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);
	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);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else







|












|







380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = (char *)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 *)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
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
     */

    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);
	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);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else







|












|







460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = (char *)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 *)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
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --







|







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))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ckfree(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --
Changes to unix/tclUnixFCmd.c.
37
38
39
40
41
42
43


44
45
46
47
48
49
50
 * 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"


#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>







>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 * 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 */
#ifdef HAVE_FTS
#include <fts.h>
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define haveRealpath	(tclMacOSXDarwinRelease >= 7)
#else
#   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
#elif defined(__APPLE__) && defined(__LP64__) && \







<
<
<
<
<







256
257
258
259
260
261
262





263
264
265
266
267
268
269
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define haveRealpath	(tclMacOSXDarwinRelease >= 7)
#else
#   define haveRealpath	1
#endif





#endif /* NO_REALPATH */

#ifdef HAVE_FTS
#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
/* fts doesn't do stat64 */
#   define noFtsStat	1
#elif defined(__APPLE__) && defined(__LP64__) && \
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
    const char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    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 */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE







|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    const char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    const Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    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
599
600
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
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = (char *)Tcl_Alloc(blockSize);
    while (1) {
	nread = read(srcFd, buffer, blockSize);
	if ((nread == TCL_IO_FAILURE) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = TCL_IO_FAILURE;
	    break;
	}
    }

    Tcl_Free(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) {
	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.







|

|
|



|




|

|







596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = (char *)ckalloc(blockSize);
    while (1) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = (size_t) -1;
	    break;
	}
    }

    ckfree(buffer);
    close(srcFd);
    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.
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
    				 * 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;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;







|
|







946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
    				 * 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, sourceLen;
    int targetLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
	}
	return TCL_ERROR;
    }

    groupPtr = TclpGetGrGid(statBuf.st_gid);

    if (groupPtr == NULL) {
	*attributePtrPtr = Tcl_NewWideIntObj(statBuf.st_gid);
    } else {
	Tcl_DString ds;
	const char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, -1);
	Tcl_DStringFree(&ds);







|







1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
	}
	return TCL_ERROR;
    }

    groupPtr = TclpGetGrGid(statBuf.st_gid);

    if (groupPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_gid);
    } else {
	Tcl_DString ds;
	const char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, -1);
	Tcl_DStringFree(&ds);
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
	}
	return TCL_ERROR;
    }

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	*attributePtrPtr = Tcl_NewWideIntObj(statBuf.st_uid);
    } else {
	Tcl_DString ds;

	(void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = TclDStringToObj(&ds);
    }
    return TCL_OK;







|







1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
	}
	return TCL_ERROR;
    }

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
    } else {
	Tcl_DString ds;

	(void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = TclDStringToObj(&ds);
    }
    return TCL_OK;
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	size_t length;

	string = TclGetStringFromObj(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\":"







<

|

|







1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;


	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->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\":"
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	size_t length;

	string = TclGetStringFromObj(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\":"







<

|

|







1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
    int result;
    const char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;


	string = TclGetString(attributePtr);

	native = Tcl_UtfToExternalDString(NULL, string, attributePtr->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\":"
1943
1944
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954
1955
1956
1957
1958
				 * 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 cur;
    size_t pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);

    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

    currentPathEndPosition = path + nextCheckpoint;







<
|
>







1938
1939
1940
1941
1942
1943
1944

1945
1946
1947
1948
1949
1950
1951
1952
1953
				 * 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 cur;

    const char *path = TclGetString(pathPtr);
    size_t pathLen = pathPtr->length;
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif

    currentPathEndPosition = path + nextCheckpoint;
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
	     */

	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    size_t newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * The original path is unchanged.







|







2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
	     */

	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    int newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * The original path is unchanged.
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
	    }

	    /*
	     * Free the original path and replace it with the normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 */

		int normLen = Tcl_DStringLength(&ds);







|







2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
	    }

	    /*
	     * Free the original path and replace it with the normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 */

		int normLen = Tcl_DStringLength(&ds);
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
    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));







<






|
|








|
|










|
|







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
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_DString templ, tmp;
    const char *string;
    int fd;


    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = TclGetString(basenameObj);
	Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = TclGetString(extensionObj);
	Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&templ));
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
	    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







|




|







2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)
{
    int size;
    const char *native =  (const char *)Tcl_FSGetNativePath(fileName);
    WCHAR *winPath;

    size = cygwin_conv_path(1, native, NULL, 0);
    winPath = (WCHAR *)ckalloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
    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;
    }

    *attributePtrPtr = Tcl_NewWideIntObj(
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *







|






|







2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
    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);
    ckfree(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    TclNewIntObj(*attributePtrPtr,
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
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
    }

    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)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes







|












|




|







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
    }

    winPath = winPathFromObj(fileName);

    fileAttributes = old = GetFileAttributesW(winPath);

    if (fileAttributes == -1) {
	ckfree(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    if (yesNo) {
	fileAttributes |= attributeArray[objIndex];
    } else {
	fileAttributes &= ~attributeArray[objIndex];
    }

    if ((fileAttributes != old)
	    && !SetFileAttributesW(winPath, fileAttributes)) {
	ckfree(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    ckfree(winPath);
    return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewWideIntObj((statBuf.st_flags & UF_IMMUTABLE) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes







|







2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }

    TclNewIntObj(*attributePtrPtr, (statBuf.st_flags & UF_IMMUTABLE) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
Changes to unix/tclUnixFile.c.
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

#ifdef __CYGWIN__
void
TclpFindExecutable(
    TCL_UNUSED(const char *) /*argv0*/)
{
    Tcl_Encoding encoding;
    size_t length;
    wchar_t buf[PATH_MAX];
    char name[PATH_MAX * 3 + 1];

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

#ifdef __CYGWIN__
void
TclpFindExecutable(
    TCL_UNUSED(const char *) /*argv0*/)
{
    Tcl_Encoding encoding;
    int length;
    wchar_t buf[PATH_MAX];
    char name[PATH_MAX * 3 + 1];

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = (char *)Tcl_Alloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
    }

    /*
     * No change to pwd.







|







725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = (char*)ckalloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
    }

    /*
     * No change to pwd.
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
	/*
	 * Check symbolic link flag first, since we prefer to create these.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    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);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
		toPtr = NULL;
	    }
	    Tcl_DStringFree(&ds);
	} else if (linkAction & TCL_CREATE_HARD_LINK) {







<











|
|







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
	/*
	 * Check symbolic link flag first, since we prefer to create these.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    Tcl_DString ds;
	    Tcl_Obj *transPtr;


	    /*
	     * 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 = TclGetString(transPtr);
	    target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
		toPtr = NULL;
	    }
	    Tcl_DStringFree(&ds);
	} else if (linkAction & TCL_CREATE_HARD_LINK) {
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
	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(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);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
}

/*







|
>









|







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
	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetString(validPathPtr);
    len = validPathPtr->length;
    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 *)ckalloc(len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
}

/*
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);

    copy = (char *)Tcl_Alloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *







|







1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);

    copy = (char *)ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
Changes to unix/tclUnixInit.c.
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

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







|







|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    Tcl_DString buffer;

    TclNewObj(pathPtr);

    /*
     * 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.
     */
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	}
	Tcl_Free(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.
     */







|







508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	}
	ckfree(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
	    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);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *







|
>
|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
	    objPtr = Tcl_NewStringObj(str, -1);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
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
 * 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
 *	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
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    size_t *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;
    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;







|









|



|




|







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

int
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (native). */
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    int i, result = -1;
    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;
Changes to unix/tclUnixPipe.c.
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
 * This structure describes the channel type structure for command pipe based
 * I/O:
 */

static const Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* 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. */







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
 * This structure describes the channel type structure for command pipe based
 * I/O:
 */

static const Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* 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. */
225
226
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileName(void)
{
    Tcl_Obj *retVal, *nameObj = Tcl_NewObj();
    int fd;


    Tcl_IncrRefCount(nameObj);
    fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj);
    if (fd == -1) {
	Tcl_DecrRefCount(nameObj);
	return NULL;
    }








|


>







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileName(void)
{
    Tcl_Obj *retVal, *nameObj;
    int fd;

    TclNewObj(nameObj);
    Tcl_IncrRefCount(nameObj);
    fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj);
    if (fd == -1) {
	Tcl_DecrRefCount(nameObj);
	return NULL;
    }

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
     * an error message.
     */

    TclpCloseFile(errPipeOut);
    errPipeOut = NULL;

    fd = GetFd(errPipeIn);
    count = read(fd, errSpace, 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)));







|







520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
     * an error message.
     */

    TclpCloseFile(errPipeOut);
    errPipeOut = NULL;

    fd = GetFd(errPipeIn);
    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)));
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
    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));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;







|







740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
    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 *)ckalloc(sizeof(PipeState));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

    if (pipePtr->numPids != 0) {
	Tcl_Free(pipePtr->pidPtr);
    }
    Tcl_Free(pipePtr);
    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

/*







|

|







1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

    if (pipePtr->numPids != 0) {
	ckfree(pipePtr->pidPtr);
    }
    ckfree(pipePtr);
    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

/*
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
     * 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);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return bytesRead;







|







1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
     * 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, (size_t) toRead);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return bytesRead;
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

    /*
     * Some OSes can throw an interrupt error, for which we should immediately
     * retry. [Bug #415131]
     */

    do {
	written = write(GetFd(psPtr->outFile), buf, toWrite);
    } while ((written < 0) && (errno == EINTR));

    if (written < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return written;







|







1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114

    /*
     * Some OSes can throw an interrupt error, for which we should immediately
     * retry. [Bug #415131]
     */

    do {
	written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
    } while ((written < 0) && (errno == EINTR));

    if (written < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return written;
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
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
    } else {
	/*
	 * Get the channel and make sure that it refers to a pipe.
	 */

	chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL);
	if (chan == NULL) {
	    return TCL_ERROR;
	}
	if (Tcl_GetChannelType(chan) != &pipeChannelType) {
	    return TCL_OK;
	}

	/*
	 * Extract the process IDs from the pipe structure.
	 */

	pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;







|












|







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
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
    } else {
	/*
	 * Get the channel and make sure that it refers to a pipe.
	 */

	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == NULL) {
	    return TCL_ERROR;
	}
	if (Tcl_GetChannelType(chan) != &pipeChannelType) {
	    return TCL_OK;
	}

	/*
	 * Extract the process IDs from the pipe structure.
	 */

	pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
	TclNewObj(resultPtr);
	for (i = 0; i < pipePtr->numPids; i++) {
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    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
#endif

#ifdef __CYGWIN__
#ifdef __cplusplus
extern "C" {
#endif
    /* Make some symbols available without including <windows.h> */

#   define CP_UTF8 65001
#   define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004


#   define SOCKET unsigned int
#   define WSAEWOULDBLOCK 10035
    typedef unsigned short WCHAR;
#ifdef __clang__
#pragma clang diagnostic push
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif







>


>
>







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#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 SOCKET unsigned int
#   define WSAEWOULDBLOCK 10035
    typedef unsigned short WCHAR;
#ifdef __clang__
#pragma clang diagnostic push
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688

/*
 *---------------------------------------------------------------------------
 * 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)

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */








|
|
|







675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691

/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

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

Changes to unix/tclUnixSock.c.
155
156
157
158
159
160
161

162



163
164
165
166
167
168
169
 * 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. */







>
|
>
>
>







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
 * 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 */
#ifndef TCL_NO_DEPRECATED
    TcpCloseProc,		/* Close proc. */
#else
    TCL_CLOSE2PROC,		/* Close proc. */
#endif
    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. */
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
 *
 * ----------------------------------------------------------------------
 */

static void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *native = NULL;

#ifndef NO_UNAME
    struct utsname u;
    struct hostent *hp;







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
 *
 * ----------------------------------------------------------------------
 */

static void
InitializeHostName(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *native = NULL;

#ifndef NO_UNAME
    struct utsname u;
    struct hostent *hp;
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
	     * 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);

		memcpy(node, u.nodename, dot - u.nodename);
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		Tcl_Free(node);
	    }
	}
        if (hp != NULL) {
	    native = hp->h_name;
        } else {
	    native = u.nodename;
        }







|




|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
	     * 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 *)ckalloc(dot - u.nodename + 1);

		memcpy(node, u.nodename, dot - u.nodename);
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		ckfree(node);
	    }
	}
        if (hp != NULL) {
	    native = hp->h_name;
        } else {
	    native = u.nodename;
        }
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    if (native) {
	*lengthPtr = strlen(native);
	*valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
	memcpy(*valuePtr, native, *lengthPtr + 1);
    } else {
	*lengthPtr = 0;
	*valuePtr = (char *)Tcl_Alloc(1);
	*valuePtr[0] = '\0';
    }
}

/*
 * ----------------------------------------------------------------------
 *







|



|







285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    if (native) {
	*lengthPtr = strlen(native);
	*valuePtr = (char *)ckalloc(*lengthPtr + 1);
	memcpy(*valuePtr, native, *lengthPtr + 1);
    } else {
	*lengthPtr = 0;
	*valuePtr = (char *)ckalloc(1);
	*valuePtr[0] = '\0';
    }
}

/*
 * ----------------------------------------------------------------------
 *
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
 *
 * ----------------------------------------------------------------------
 */

const char *
Tcl_GetHostName(void)
{
    Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName);
    return TclGetString(tclObj);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *







|
<







315
316
317
318
319
320
321
322

323
324
325
326
327
328
329
 *
 * ----------------------------------------------------------------------
 */

const char *
Tcl_GetHostName(void)
{
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));

}

/*
 * ----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
    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.
	 */







|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
    if (bytesRead >= 0) {
	return bytesRead;
    }
    if (errno == ECONNRESET) {
	/*
	 * Turn ECONNRESET into a soft EOF condition.
	 */
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
    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;
}







|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
    TcpState *statePtr = (TcpState *)instanceData;
    int written;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);

    if (written >= 0) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
	}

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







|








|







648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
	}

    }
    fds = statePtr->fds.next;
    while (fds != NULL) {
	TcpFdList *next = fds->next;

	ckfree(fds);
	fds = next;
    }
    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
    }
    ckfree(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
        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;








|







1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = (TcpState *)ckalloc(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;

1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464

    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;
}

/*
 *----------------------------------------------------------------------







|







1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467

    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_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
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
    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;
}

/*
 *----------------------------------------------------------------------







|










|







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
    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 *)ckalloc(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_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
            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;








|






|







1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = (TcpState *)ckalloc(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 *)ckalloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;

1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
    /*
     * 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);







|







1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
    /*
     * 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(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);
Changes to unix/tclUnixThrd.c.
156
157
158
159
160
161
162








163
164
165
166
167
168
169
    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,
 * 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;







>
>
>
>
>
>
>
>







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
}
#endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */

#ifndef TCL_NO_DEPRECATED
typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_DEPRECATED */

/*
 * globalLock 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;
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID 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 flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;







|







218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&globalLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside global lock check to avoid a race condition.
	     */

	    pmutexPtr = (PMutex *)Tcl_Alloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&globalLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);







|







573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&globalLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside global lock check to avoid a race condition.
	     */

	    pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&globalLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    if (pmutexPtr != NULL) {
	PMutexDestroy(pmutexPtr);
	Tcl_Free(pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    if (pmutexPtr != NULL) {
	PMutexDestroy(pmutexPtr);
	ckfree(pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

	/*
	 * 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));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&globalLock);
    }
    pmutexPtr = *((PMutex **)mutexPtr);







|







683
684
685
686
687
688
689
690
691
692
693
694
695
696
697

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&globalLock);
    }
    pmutexPtr = *((PMutex **)mutexPtr);
763
764
765
766
767
768
769
770
771
772
773

774















































775
776
777
778
779
780
781
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	Tcl_Free(pcondPtr);
	*condPtr = NULL;
    }
}

















































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

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;








|



>

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







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
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	ckfree(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).
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
Tcl_DirEntry *
TclpReaddir(
    TclDIR * dir)
{
    return TclOSreaddir(dir);
}

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

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

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;

857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
#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!");
    }







|







913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }
Changes to unix/tclUnixTime.c.
11
12
13
14
15
16
17
18
























19
20




21
22
23
24
25
26
27
 */

#include "tclInt.h"
#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)
#include <mach/mach_time.h>
#endif

/*
























 * Static functions declared in this file.
 */





static void		NativeScaleTime(Tcl_Time *timebuf,
			    ClientData clientData);
static void		NativeGetTime(Tcl_Time *timebuf,
			    ClientData clientData);

/*








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


>
>
>
>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
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 "tclInt.h"
#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)
#include <mach/mach_time.h>
#endif

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

#ifndef TCL_NO_DEPRECATED
static Tcl_ThreadDataKey tmKey;
typedef struct {
    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);
#endif /* TCL_NO_DEPRECATED */

static void		NativeScaleTime(Tcl_Time *timebuf,
			    ClientData clientData);
static void		NativeGetTime(Tcl_Time *timebuf,
			    ClientData clientData);

/*
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------







|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
	Tcl_WideUInt now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (Tcl_WideUInt) times(&dummy);
    }
#else
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = (Tcl_WideUInt)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
 *	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:







|


|






|






|





|












|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetClicks(void)
{
    unsigned long now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (unsigned long) times(&dummy);
    }
#else
    Tcl_Time time;

    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 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:
289
290
291
292
293
294
295














































































































296
297
298
299
300
301
302
{
    tclGetTimeProcPtr(timePtr, tclTimeClientData);
}

/*
 *----------------------------------------------------------------------
 *














































































































 * Tcl_SetTimeProc --
 *
 *	TIP #233 (Virtualized Time): Registers two handlers for the
 *	virtualization of Tcl's access to time information.
 *
 * Results:
 *	None.







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







317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
{
    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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
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;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *	TIP #233 (Virtualized Time): Registers two handlers for the
 *	virtualization of Tcl's access to time information.
 *
 * Results:
 *	None.
400
401
402
403
404
405
406


407







































408

























409
410
411
412
413
414
{
    struct timeval tv;

    (void) gettimeofday(&tv, NULL);
    timePtr->sec = tv.tv_sec;
    timePtr->usec = tv.tv_usec;
}










































/*

























 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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

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






538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
{
    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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
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, NULL);
	} else {
	    ckfree(lastTZ);
	}
	lastTZ = (char *)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(
    TCL_UNUSED(ClientData))
{
    ckfree(lastTZ);
}
#endif /* TCL_NO_DEPRECATED */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to unix/tclXtNotify.c.
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
 *----------------------------------------------------------------------
 */

static void
SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    unsigned 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);
    } else {
	notifier.currentTimeout = 0;
    }
}

/*
 *----------------------------------------------------------------------







|












|







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
 *----------------------------------------------------------------------
 */

static void
SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    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,
		(unsigned long) timeout, TimerProc, NULL);
    } else {
	notifier.currentTimeout = 0;
    }
}

/*
 *----------------------------------------------------------------------
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->read = 0;
	filePtr->write = 0;
	filePtr->except = 0;
	filePtr->readyMask = 0;
	filePtr->mask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;







|







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	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
    }
    if (filePtr->mask & TCL_WRITABLE) {
	XtRemoveInput(filePtr->write);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	XtRemoveInput(filePtr->except);
    }
    Tcl_Free(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileProc --
 *







|







466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
    }
    if (filePtr->mask & TCL_WRITABLE) {
	XtRemoveInput(filePtr->write);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	XtRemoveInput(filePtr->except);
    }
    ckfree(filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileProc --
 *
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(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.
     */







|







521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    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.
     */
Changes to win/Makefile.in.
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
# 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)








|







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
# 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)/../tcl8

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

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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 -DMP_NO_STDINT

# 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







|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
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@ -D_ATL_XP_TARGETING=1 -D__USE_MINGW_ANSI_STDIO=0 -DMP_FIXED_CUTOFFS -DMP_NO_STDINT

# 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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
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)${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${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_FACILITIES	= package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)








|

|


|

|
|
|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
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_FACILITIES	= package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}]];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
${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}
	@$(RM) $(ROOT_DIR_NATIVE)/tests/safe-stock86.test
	$(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}
	@if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \







<







592
593
594
595
596
597
598

599
600
601
602
603
604
605
${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}
	@if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
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
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		else true; \
		fi; \
	    done;
	@for i in 9.0  9.0/platform; \
	    do \
	    if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \
		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}; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    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";
	@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 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";
	@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";
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done;

install-tzdata:
	@echo "Installing time zone data"







|


















|






|

|

|

|







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
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		else true; \
		fi; \
	    done;
	@for i in 8.4  8.4/platform 8.5 8.6 8.7; \
	    do \
	    if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \
		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}; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    done;
	@echo "Installing package http 2.10.0a1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10.0a1.tm";
	@echo "Installing package opt 0.4.7";
	@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)/8.7/msgcat-1.7.1.tm";
	@echo "Installing package tcltest 2.5.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/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)/8.4/platform-1.0.14.tm";
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm";
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done;

install-tzdata:
	@echo "Installing time zone data"
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
	$(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
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"







|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
	$(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 tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#

TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"
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
Tcl 9.0 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)

	and

	Visual C++ 6 or newer

	or

|

















|







1
2
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 8.7 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 8.7 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
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
on your path, in the system directory, or in the directory containing
tclsh90.exe.

Note: Tcl no longer provides support for Win32s.

3. Test suite
-------------

This distribution contains an extensive test suite for Tcl.  Some of the







|

|







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 tclsh87.exe, you must ensure that tcl87.dll is
on your path, in the system directory, or in the directory containing
tclsh87.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/configure.
776
777
778
779
780
781
782

783
784
785
786
787
788
789
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







>







776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_encoding
enable_shared
enable_time64bit
enable_64bit
enable_zipfs
enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
1398
1399
1400
1401
1402
1403
1404

1405
1406
1407
1408
1409
1410
1411
  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-shared         build and link with shared libraries (default: on)

  --enable-64bit          enable 64bit support (where applicable)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:







>







1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
  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-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-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163


# 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








|
|
|
|







2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165


# 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.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a4"
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

3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758

    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"
	$as_echo "#define TCL_CFGVAL_ENCODING \"cp1252\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.







<
|







3745
3746
3747
3748
3749
3750
3751

3752
3753
3754
3755
3756
3757
3758
3759

    if test x"${with_tcencoding}" != x ; then
	cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else

	$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h

    fi


#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
3786
3787
3788
3789
3790
3791
3792



















3793
3794
3795
3796
3797
3798
3799
	SHARED_BUILD=0

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

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








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







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
	SHARED_BUILD=0

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

    fi



#--------------------------------------------------------------------
# Check whether --enable-time64bit was given.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking force of 64-bit time_t" >&5
$as_echo_n "checking force of 64-bit time_t... " >&6; }
# Check whether --enable-time64bit was given.
if test "${enable_time64bit+set}" = set; then :
  enableval=$enable_time64bit; tcl_ok=$enableval
else
  tcl_ok=no
fi

{ $as_echo "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5
$as_echo "\"$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.
#--------------------------------------------------------------------

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
	    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%.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=""
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;







|











|







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
	    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=""
	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"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
5271
5272
5273
5274
5275
5276
5277

5278



5279
5280
5281
5282
5283
5284
5285
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}\""


eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""



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







>
|
>
>
>







5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
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}"
Changes to 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
#! /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














|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
#! /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=8.7
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=7
TCL_PATCH_LEVEL="a4"
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

86
87
88
89
90
91
92














93
94
95
96
97
98
99

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








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







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

#--------------------------------------------------------------------
# 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,
    AC_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.
#--------------------------------------------------------------------

341
342
343
344
345
346
347

348



349
350
351
352
353
354
355
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}\""


eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""



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







>
|
>
>
>







355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
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}"
Changes to win/makefile.vc.
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73


74
75
76


77
78
79
80
81
82
83
#
# 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.
#
# 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
#		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.
#
#		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.
#		symbols   =  Adds symbols for step debugging.
#		thrdalloc = Use the thread allocator (shared global free pool).


#		unchecked = Allows a symbols build to not use the debug
#			    enabled runtime (msvcrt.dll not msvcrtd.dll
#			    or libcmt.lib not libcmtd.lib).


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







|


















>
>



>
>







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#
# 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.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
#	OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,time64bit,unchecked,utfmax,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.
#
#		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.
#		symbols   =  Adds symbols for step debugging.
#		thrdalloc = Use the thread allocator (shared global free pool).
#		time64bit = Forces a build using 64-bit time_t for 32-bit build
#			    (CRT library should support this).
#		unchecked = Allows a symbols build to not use the debug
#			    enabled runtime (msvcrt.dll not msvcrtd.dll
#			    or libcmt.lib not libcmtd.lib).
#		utfmax    = Forces a build allowing 4-byte UTF-8 sequences
#			    internally.
#
#	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
#		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
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#







<
<
<
<







110
111
112
113
114
115
116




117
118
119
120
121
122
123
#		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.
#




# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#
894
895
896
897
898
899
900
901
902
903
904
905
906


907
908
909
910






911
912
913
914
915
916
917
!endif
	@echo Installing $(TCLSTUBLIBNAME)
	@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"

install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)" \
		$(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 "$(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)\"







|

|

|

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







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
!endif
	@echo Installing $(TCLSTUBLIBNAME)
	@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"

install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
	@if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
	@if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2"
	@if not exist "$(MODULE_INSTALL_DIR)" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)"
	@if not exist "$(MODULE_INSTALL_DIR)\8.4" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\8.4"
	@if not exist "$(MODULE_INSTALL_DIR)\8.4\platform" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\8.4\platform"
	@if not exist "$(MODULE_INSTALL_DIR)\8.5" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\8.5"
	@if not exist "$(MODULE_INSTALL_DIR)\8.6" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\8.6"
	@if not exist "$(MODULE_INSTALL_DIR)\8.7" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\8.7"
	@if not exist "$(LIB_INSTALL_DIR)\nmake" \
		$(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
	@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)\"
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
	@$(CPY) "$(ROOT)\library\cookiejar\*.gz" \
	    "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
	@echo Installing package opt $(PKG_OPT_VER)
	@$(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"
	@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"
	@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"
	@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"
	@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"
	@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)\"







|


|


|


|


|







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
	@$(CPY) "$(ROOT)\library\cookiejar\*.gz" \
	    "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
	@echo Installing package opt $(PKG_OPT_VER)
	@$(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)\8.6\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)\8.7\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)\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)\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)\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)\"
Changes to win/rules.vc.
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
#     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
# CFG_ENCODING - set to an character encoding.
#   TBD - this is passed to compiler as TCL_CFGVAL_ENCODING but can't
#   see where it is used

cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

#----------------------------------------------------------------







<
<
<







411
412
413
414
415
416
417



418
419
420
421
422
423
424
#     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.

#----------------------------------------------------------------
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516

# 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

!ifndef CFG_ENCODING
CFG_ENCODING	= \"cp1252\"
!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







<
<
<
<







496
497
498
499
500
501
502




503
504
505
506
507
508
509

# 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
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
# 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	= /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS
!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







|







1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
# 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
!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
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

# 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 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 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 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 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 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 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 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 Bsc_Name ""
# PROP Target_Dir ""

!ENDIF

# Begin Target








|








|











|








|











|








|











|








|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
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\tclsh87.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\tclsh87t.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\tclsh87g.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\tclsh87tg.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\tclsh87sg.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\tclsh87sg.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\tclsh87s.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\tclsh87s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ENDIF

# Begin Target

Changes to win/tcl.hpj.in.
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
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl90.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0








|

|







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=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl87.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Changes to win/tcl.m4.
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
	    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%.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=""
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;







|











|







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
	    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=""
	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"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
#		--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
    else
	TCL_BIN_DEFAULT=../../tcl9.0/win
    fi

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 9.0 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







|
|

|


|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
#		--with-tcl=...
#
#	Defines the following vars:
#		TCL_BIN_DIR	Full path to the tcl build dir.
#------------------------------------------------------------------------

AC_DEFUN([SC_WITH_TCL], [
    if test -d ../../tcl8.7$1/win;  then
	TCL_BIN_DEFAULT=../../tcl8.7$1/win
    else
	TCL_BIN_DEFAULT=../../tcl8.7/win
    fi

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.7 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
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096

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,"cp1252")
    fi
])

#--------------------------------------------------------------------
# SC_EMBED_MANIFEST
#
#	Figure out if we can embed the manifest where necessary







<
|







1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095

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

	AC_DEFINE(TCL_CFGVAL_ENCODING,"utf-8")
    fi
])

#--------------------------------------------------------------------
# SC_EMBED_MANIFEST
#
#	Figure out if we can embed the manifest where necessary
Changes to win/tclAppInit.c.
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#include <tchar.h>

#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_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;
#endif

#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
int _CRT_glob = 0;







|







25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#include <tchar.h>

#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_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

#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
int _CRT_glob = 0;
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_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if ((Tcl_Init)(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#if defined(STATIC_BUILD) && 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) {
	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);







|



|




|







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_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) {
	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);
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
281
282
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }

    /* 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 *)
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {







|

>

|







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }

    /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
#   undef Tcl_Alloc
#   undef Tcl_DbCkalloc

    argSpace = (TCHAR *)ckalloc(size * sizeof(char *)
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {
Changes to win/tclConfig.sh.in.
18
19
20
21
22
23
24





25
26
27
28
29
30
31
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@'






# 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@'







>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
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.
# DEPRECATED, will be removed in Tcl 9!
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@'
Changes to win/tclWin32Dll.c.
148
149
150
151
152
153
154
155

156
157
158
159
160
161
162
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *

TclWinGetTclInstance(void)
{
    return hInstance;
}

/*
 *----------------------------------------------------------------------







<
>







148
149
150
151
152
153
154

155
156
157
158
159
160
161
162
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


HINSTANCE
TclWinGetTclInstance(void)
{
    return hInstance;
}

/*
 *----------------------------------------------------------------------
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	Tcl_Free(dlIter->volumeName);
	Tcl_Free(dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *--------------------------------------------------------------------







|
|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	ckfree(dlIter->volumeName);
	ckfree(dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *--------------------------------------------------------------------
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
		}
	    }

	    /*
	     * Now dlPtr2 points to the structure to free.
	     */

	    Tcl_Free(dlPtr2->volumeName);
	    Tcl_Free(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.
	     */








|
|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
		}
	    }

	    /*
	     * Now dlPtr2 points to the structure to free.
	     */

	    ckfree(dlPtr2->volumeName);
	    ckfree(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.
	     */

381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
		    dlIter = dlIter->nextPtr) {
		if (wcscmp(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->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }







|







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
		    dlIter = dlIter->nextPtr) {
		if (wcscmp(dlIter->volumeName, Target) == 0) {
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422






































































423
424
425
426
427
428
429
    }

    /*
     * 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->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}







































































/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
 *	Get CPU ID information on an Intel box under Windows
 *







|








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







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
    }

    /*
     * 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 *)ckalloc(sizeof(MountPointMap));
    dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
 *
 *	Convert between UTF-8 and Unicode when running Windows.
 *
 *	On Mac and Unix, 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 Windows, 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.
 *	This saves you the trouble of writing the
 *	following type of fragment over and over:
 *
 *		encoding <- Tcl_GetEncoding("unicode");
 *		nativeBuffer <- UtfToExternal(encoding, utfBuffer);
 *		Tcl_FreeEncoding(encoding);
 *
 *	By convention, in Windows a WCHAR is a Unicode character. If you plan
 *	on targeting a Unicode interface when running on Windows, these
 *	functions should be used. If you plan on targetting a "char" oriented
 *	function on Windows, 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.
 *
 *---------------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#undef Tcl_WinUtfToTChar
TCHAR *
Tcl_WinUtfToTChar(
    const char *string,		/* Source string in UTF-8. */
    int len,			/* Source string length in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_DStringInit(dsPtr);
    return (TCHAR *)Tcl_UtfToWCharDString(string, len, dsPtr);
}
#undef Tcl_WinTCharToUtf
char *
Tcl_WinTCharToUtf(
    const TCHAR *string,	/* Source string in Unicode. */
    int len,			/* Source string length in bytes, or -1 for
				 * platform-specific string length. */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_DStringInit(dsPtr);
    return Tcl_WCharToUtfDString((WCHAR *)string, len >> 1, dsPtr);
}
#endif /* !defined(TCL_NO_DEPRECATED) */

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
 *	Get CPU ID information on an Intel box under Windows
 *
Changes to win/tclWinChan.c.
81
82
83
84
85
86
87




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



109

110
111
112
113
114
115
116
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);




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

/*
 * This structure describes the channel type structure for file based IO.
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */



	NULL,

    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. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */







>
>
>
>


















|


>
>
>

>







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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);
#ifndef TCL_NO_DEPRECATED
static int		FileSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCode);
#endif
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);

/*
 * This structure describes the channel type structure for file based IO.
 */

static const Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
#ifndef TCL_NO_DEPRECATED
    FileSeekProc,		/* Seek proc. */
#else
	NULL,
#endif
    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. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
     * (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));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
     * (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 *)ckalloc(sizeof(FileEvent));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

433
434
435
436
437
438
439
440
441
442
443















































































444
445
446
447
448
449
450
	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    Tcl_Free(fileInfoPtr);
    return errorCode;
}
















































































/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	Seeks on a file-based channel. Returns the new position.
 *







|



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







441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    ckfree(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.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_DEPRECATED
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;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	Seeks on a file-based channel. Returns the new position.
 *
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
    /*
     * 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);
	return (Tcl_Channel) NULL;
    }
    return channel;
}

/*
 *----------------------------------------------------------------------







|







1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
    /*
     * 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_Close(NULL, channel);
	return (Tcl_Channel) NULL;
    }
    return channel;
}

/*
 *----------------------------------------------------------------------
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
    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));

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








|







1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = (FileInfo *)ckalloc(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.
     */

Changes to win/tclWinConsole.c.
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 * This structure describes the channel type structure for command console
 * based IO.
 */

static const Tcl_ChannelType consoleChannelType = {
    "console",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    ConsoleInputProc,		/* Input proc. */
    ConsoleOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    ConsoleSetOptionProc,	/* Set option proc. */
    ConsoleGetOptionProc,	/* Get option proc. */
    ConsoleWatchProc,		/* Set up notifier to watch the channel. */
    ConsoleGetHandleProc,	/* Get an OS handle from channel. */







|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
 * This structure describes the channel type structure for command console
 * based IO.
 */

static const Tcl_ChannelType consoleChannelType = {
    "console",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* Close proc. */
    ConsoleInputProc,		/* Input proc. */
    ConsoleOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    ConsoleSetOptionProc,	/* Set option proc. */
    ConsoleGetOptionProc,	/* Get option proc. */
    ConsoleWatchProc,		/* Set up notifier to watch the channel. */
    ConsoleGetHandleProc,	/* Get an OS handle from channel. */
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
	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->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }







|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		needEvent = 1;
	    }
	}

	if (needEvent) {
	    ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent));

	    infoPtr->flags |= CONSOLE_PENDING;
	    evPtr->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (ConsoleInfo *) consolePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    if (consolePtr->writeBuf != NULL) {
	Tcl_Free(consolePtr->writeBuf);
	consolePtr->writeBuf = 0;
    }
    Tcl_Free(consolePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *







|


|







618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (ConsoleInfo *) consolePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    if (consolePtr->writeBuf != NULL) {
	ckfree(consolePtr->writeBuf);
	consolePtr->writeBuf = 0;
    }
    ckfree(consolePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	bytesWritten = toWrite;
    } else {







|


|







785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	bytesWritten = toWrite;
    } else {
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = (ConsoleInfo *)Tcl_Alloc(sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());







|







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

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());
Changes to win/tclWinError.c.
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    int errCode)		/* Win32 error code. */
{
    if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
	errCode -= WSAEWOULDBLOCK;
	if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
	    Tcl_SetErrno(errorTable[1]);
	} else {
	    Tcl_SetErrno(wsaErrorTable[errCode]);
	}
    } else {
	Tcl_SetErrno(errorTable[errCode]);
    }







|

|

|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    DWORD errCode)		/* Win32 error code. */
{
    if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
	errCode -= WSAEWOULDBLOCK;
	if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
	    Tcl_SetErrno(errorTable[1]);
	} else {
	    Tcl_SetErrno(wsaErrorTable[errCode]);
	}
    } else {
	Tcl_SetErrno(errorTable[errCode]);
    }
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
tclWinDebugPanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    va_start(argList, format);








|







377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN void
tclWinDebugPanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    va_start(argList, format);

409
410
411
412
413
414
415






416
417
418
419
420
421
422
423
424
425
	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:
 */







>
>
>
>
>
>










409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
	if (!isatty(fileno(stderr))) {
	    fprintf(stderr, "\xef\xbb\xbf");
	}
	vfprintf(stderr, format, argList);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
#   if defined(__GNUC__)
    __builtin_trap();
#   else
    DebugBreak();
#   endif
    abort();
}
#endif
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */
Changes to win/tclWinFCmd.c.
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
		 * 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);
	}

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







|
|







374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
		 * The MoveFile system call already handles the case of moving
		 * a file between filesystems.
		 */

		Tcl_SetErrno(EXDEV);
	    }

	    ckfree(srcArgv);
	    ckfree(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.
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
    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);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {







|
|







911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(Tcl_GetString(normSrcPtr), -1, &srcString);
    Tcl_UtfToWCharDString(Tcl_GetString(normDestPtr), -1, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(TclGetString(normPtr), -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {







|







985
986
987
988
989
990
991
992
993
994
995
996
997
998
999

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
	 * 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);

	if (len < 4) {
	    if (len == 0) {
		/*
		 * Not sure if this is possible, but we pass it on anyway.
		 */







|







1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
	 * 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.
	 */

	int len;
	const char *str = TclGetStringFromObj(fileName, &len);

	if (len < 4) {
	    if (len == 0) {
		/*
		 * Not sure if this is possible, but we pass it on anyway.
		 */
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
		 */

		attr = 0;
	    }
	}
    }

    *attributePtrPtr = Tcl_NewWideIntObj(attr != 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --







|







1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
		 */

		attr = 0;
	    }
	}
    }

    TclNewIntObj(*attributePtrPtr, attr != 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --
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
    TCL_UNUSED(int) /*objIndex*/,
    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)));
	    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;


	Tcl_ListObjIndex(NULL, splitPath, i, &elt);

	pathv = TclGetStringFromObj(elt, &length);
	if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
		|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
	    /*







<







|
















>







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
    TCL_UNUSED(int) /*objIndex*/,
    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;


    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",
		    Tcl_GetString(fileName)));
	    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 length;

	Tcl_ListObjIndex(NULL, splitPath, i, &elt);

	pathv = TclGetStringFromObj(elt, &length);
	if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
		|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
	    /*
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
    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_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
	    tclpFileAttrStrings[objIndex], TclGetString(fileName)));
    errno = EINVAL;
    Tcl_PosixError(interp);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------







|







1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
    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_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
	    tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
    errno = EINVAL;
    Tcl_PosixError(interp);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr, *elemPtr;
    char buf[40 * 4];		/* There couldn't be more than 30 drives??? */
    int i;
    char *p;

    resultPtr = Tcl_NewObj();

    /*
     * On Win32s:
     * GetLogicalDriveStrings() isn't implemented.
     * GetLogicalDrives() returns incorrect information.
     */








|







1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr, *elemPtr;
    char buf[40 * 4];		/* There couldn't be more than 30 drives??? */
    int i;
    char *p;

    TclNewObj(resultPtr);

    /*
     * On Win32s:
     * GetLogicalDriveStrings() isn't implemented.
     * GetLogicalDrives() returns incorrect information.
     */

Changes to win/tclWinFile.c.
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    WCHAR dummyBuf[MAX_PATH * 3];
} DUMMY_REPARSE_BUFFER;

/*
 * Other typedefs required by this code.
 */

static __time64_t		ToCTime(FILETIME fileTime);
static void		FromCTime(__time64_t posixTime, FILETIME *fileTime);

/*
 * Declarations for local functions defined in this file:
 */

static int		NativeAccess(const WCHAR *path, int mode);
static int		NativeDev(const WCHAR *path);







|
|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    WCHAR dummyBuf[MAX_PATH * 3];
} DUMMY_REPARSE_BUFFER;

/*
 * Other typedefs required by this code.
 */

static time_t		ToCTime(FILETIME fileTime);
static void		FromCTime(time_t posixTime, FILETIME *fileTime);

/*
 * Declarations for local functions defined in this file:
 */

static int		NativeAccess(const WCHAR *path, int mode);
static int		NativeDev(const WCHAR *path);
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
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);
MODULE_SCOPE void	tclWinDebugPanic(const char *format, ...);

/*
 *--------------------------------------------------------------------
 *
 * WinLink --
 *
 *	Make a link from source to target.







|







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
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);
MODULE_SCOPE TCL_NORETURN void	tclWinDebugPanic(const char *format, ...);

/*
 *--------------------------------------------------------------------
 *
 * WinLink --
 *
 *	Make a link from source to target.
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
 *
 * 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];







|







799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN 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];
829
830
831
832
833
834
835










836
837
838
839
840
841
842
    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else {
	MessageBeep(MB_ICONEXCLAMATION);
	MessageBoxW(NULL, msgString, L"Fatal Error",
		MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
    }










}

/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *







>
>
>
>
>
>
>
>
>
>







829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else {
	MessageBeep(MB_ICONEXCLAMATION);
	MessageBoxW(NULL, msgString, L"Fatal Error",
		MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
    }
#if defined(__GNUC__)
    __builtin_trap();
#elif defined(_WIN64)
    __debugbreak();
#elif defined(_MSC_VER) && defined (_M_IX86)
    _asm {int 3}
#else
    DebugBreak();
#endif
    abort();
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *
855
856
857
858
859
860
861
862









863
864
865
866
867
868
869
void
TclpFindExecutable(
    const char *argv0)		/* If NULL, install PanicMessageBox, otherwise
				 * ignore. */
{
    WCHAR wName[MAX_PATH];
    char name[MAX_PATH * 3];
    (void)argv0;










    GetModuleFileNameW(NULL, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
    TclWinNoBackslash(name);
    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}








|
>
>
>
>
>
>
>
>
>







865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
void
TclpFindExecutable(
    const char *argv0)		/* If NULL, install PanicMessageBox, otherwise
				 * ignore. */
{
    WCHAR wName[MAX_PATH];
    char name[MAX_PATH * 3];

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

    if (argv0 == NULL) {
#	undef Tcl_SetPanicProc
	Tcl_SetPanicProc(tclWinDebugPanic);
    }

    GetModuleFileNameW(NULL, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
    TclWinNoBackslash(name);
    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}

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
	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */


	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    size_t length = 0;
	    const char *str = TclGetStringFromObj(norm, &length);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str, length), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATAW data;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	size_t 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;








>


<
|









|










|







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
	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */

	    int len;
	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;

	    const char *str = TclGetStringFromObj(norm, &len);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(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;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	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;

1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
	 * 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;

	    native = data.cFileName;
	    attr = data.dwFileAttributes;
	    Tcl_DStringInit(&ds);
	    utfname = Tcl_WCharToUtfDString(native, -1, &ds);

	    if (!matchSpecialDots) {







<







1090
1091
1092
1093
1094
1095
1096

1097
1098
1099
1100
1101
1102
1103
	 * 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;


	    native = data.cFileName;
	    attr = data.dwFileAttributes;
	    Tcl_DStringInit(&ds);
	    utfname = Tcl_WCharToUtfDString(native, -1, &ds);

	    if (!matchSpecialDots) {
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
    char *result = NULL;
    USER_INFO_1 *uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    int rc = 0;
    const char *domain;
    WCHAR *wName, *wHomeDir, *wDomain;
    WCHAR buf[MAX_PATH];

    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;







<







1440
1441
1442
1443
1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
    char *result = NULL;
    USER_INFO_1 *uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    int rc = 0;
    const char *domain;
    WCHAR *wName, *wHomeDir, *wDomain;


    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
	    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 {

		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */

		GetProfilesDirectoryW(buf, &size);
		Tcl_WCharToUtfDString(buf, size-1, bufferPtr);







>







1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
	    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 {
		WCHAR buf[MAX_PATH];
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */

		GetProfilesDirectoryW(buf, &size);
		Tcl_WCharToUtfDString(buf, size-1, bufferPtr);
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
}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --
 *
 *	Converts a Windows FILETIME to a __time64_t in UTC.
 *
 * Results:
 *	Returns the count of seconds from the Posix epoch.
 *
 *------------------------------------------------------------------------
 */

static __time64_t
ToCTime(
    FILETIME fileTime)		/* UTC time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (__time64_t) ((convertedTime.QuadPart -
	    (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
}

/*
 *------------------------------------------------------------------------
 *
 * FromCTime --
 *
 *	Converts a __time64_t to a Windows FILETIME
 *
 * Results:
 *	Returns the count of 100-ns ticks seconds from the Windows epoch.
 *
 *------------------------------------------------------------------------
 */

static void
FromCTime(
    __time64_t posixTime,
    FILETIME *fileTime)		/* UTC Time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
	    + POSIX_EPOCH_AS_FILETIME;
    fileTime->dwLowDateTime = convertedTime.LowPart;







|







|








|








|









|







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
}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --
 *
 *	Converts a Windows FILETIME to a time_t in UTC.
 *
 * Results:
 *	Returns the count of seconds from the Posix epoch.
 *
 *------------------------------------------------------------------------
 */

static time_t
ToCTime(
    FILETIME fileTime)		/* UTC time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (time_t) ((convertedTime.QuadPart -
	    (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
}

/*
 *------------------------------------------------------------------------
 *
 * FromCTime --
 *
 *	Converts a time_t to a Windows FILETIME
 *
 * Results:
 *	Returns the count of 100-ns ticks seconds from the Windows epoch.
 *
 *------------------------------------------------------------------------
 */

static void
FromCTime(
    time_t posixTime,
    FILETIME *fileTime)		/* UTC Time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
	    + POSIX_EPOCH_AS_FILETIME;
    fileTime->dwLowDateTime = convertedTime.LowPart;
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
    char *firstSeparator;
    const char *path;
    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

    if (normPath == NULL) {
	return NULL;
    }
    path = TclGetString(normPath);
    if (path == NULL) {
	return NULL;
    }

    firstSeparator = strchr(path, '/');
    if (firstSeparator == NULL) {
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),







|







2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
    char *firstSeparator;
    const char *path;
    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

    if (normPath == NULL) {
	return NULL;
    }
    path = Tcl_GetString(normPath);
    if (path == NULL) {
	return NULL;
    }

    firstSeparator = strchr(path, '/');
    if (firstSeparator == NULL) {
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
    Tcl_DString dsNorm;		/* This will hold the normalized string. */
    char *path, *currentPathEndPosition;
    Tcl_Obj *temp = NULL;
    int isDrive = 1;
    Tcl_DString ds;		/* Some workspace. */

    Tcl_DStringInit(&dsNorm);
    path = TclGetString(pathPtr);

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }
    while (1) {
	char cur = *currentPathEndPosition;







|







2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
    Tcl_DString dsNorm;		/* This will hold the normalized string. */
    char *path, *currentPathEndPosition;
    Tcl_Obj *temp = NULL;
    int isDrive = 1;
    Tcl_DString ds;		/* Some workspace. */

    Tcl_DStringInit(&dsNorm);
    path = Tcl_GetString(pathPtr);

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }
    while (1) {
	char cur = *currentPathEndPosition;
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
		    nextCheckpoint = 0;
		    Tcl_AppendToObj(to, currentPathEndPosition, -1);

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

		    /*







|




|







2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
		    nextCheckpoint = 0;
		    Tcl_AppendToObj(to, currentPathEndPosition, -1);

		    /*
		     * Convert link to forward slashes.
		     */

		    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;

		    /*
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
		Tcl_DStringLength(&dsNorm)>>1, &ds);
	nextCheckpoint = Tcl_DStringLength(&ds);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    char *path;
	    Tcl_Obj *tmpPathPtr;
	    size_t length;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
	    path = TclGetStringFromObj(tmpPathPtr, &length);
	    Tcl_SetStringObj(pathPtr, path, length);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);







|

<




|
|







2812
2813
2814
2815
2816
2817
2818
2819
2820

2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
		Tcl_DStringLength(&dsNorm)>>1, &ds);
	nextCheckpoint = Tcl_DStringLength(&ds);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    int len;
	    Tcl_Obj *tmpPathPtr;


	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
	    path = TclGetStringFromObj(tmpPathPtr, &len);
	    Tcl_SetStringObj(pathPtr, path, len);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
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 (path[0] == '/') {
	/*
	 * Path of form /foo/bar which is a path in the root directory of the
	 * current volume.
	 */

	const char *drive = TclGetString(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);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {







|














|







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

    if (path[0] == '/') {
	/*
	 * Path of form /foo/bar which is a path in the root directory of the
	 * current volume.
	 */

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

	int cwdLen;
	const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    size_t len;
    char *copy, *p;

    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds);
    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);








|







2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    int len;
    char *copy, *p;

    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds);
    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

3059
3060
3061
3062
3063
3064
3065

3066
3067
3068
3069
3070
3071
3072
3073
	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
	 * so incr refCount here
	 */

	Tcl_IncrRefCount(validPathPtr);
    }


    str = TclGetStringFromObj(validPathPtr, &len);

    if (strlen(str) != len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;







>
|







3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
	 * so incr refCount here
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = Tcl_GetString(validPathPtr);
    len = validPathPtr->length;

    if (strlen(str) != len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

	goto done;
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
	}
    }

    /*
     * Overallocate 6 chars, making some room for extended paths
     */

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

    /*







|







3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
	}
    }

    /*
     * Overallocate 6 chars, making some room for extended paths
     */

    wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
    if (nativePathPtr==0) {
      goto done;
    }
    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr,
	    len + 1);

    /*
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202

    if (clientData == NULL) {
	return NULL;
    }

    len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);

    copy = (char *)Tcl_Alloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *







|







3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220

    if (clientData == NULL) {
	return NULL;
    }

    len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);

    copy = (char *)ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
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
        /*
	 * 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:
 */







|















|












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
        /*
	 * Find out how big the buffer needs to be.
	 */

        bufsz = 0;
        GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
        if (bufsz) {
            buf = (LPBYTE)ckalloc(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) {
        ckfree(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.
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;
    size_t length;

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








|






|

|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;
    int length;

    TclNewObj(pathPtr);

    /*
     * Initialize the substring used when locating the script library. The
     * installLib variable computes the script library path relative to the
     * installed DLL.
     */

221
222
223
224
225
226
227
228
229
230
231
232
233
234
235

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    *valuePtr = (char *)Tcl_Alloc(length);
    memcpy(*valuePtr, bytes, length);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *







|







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    *valuePtr = (char *)ckalloc(length);
    memcpy(*valuePtr, bytes, length);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free((void *)pathv);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeDefaultLibraryDir --







|







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	ckfree(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
 *
 *---------------------------------------------------------------------------
 */

static void
InitializeDefaultLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE 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);

    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);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *







|


|


















|







336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
 *
 *---------------------------------------------------------------------------
 */

static void
InitializeDefaultLibraryDir(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    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);

    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 *)ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
 *
 *---------------------------------------------------------------------------
 */

static void
InitializeSourceLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE 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);

    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);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *







|


|


















|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
 *
 *---------------------------------------------------------------------------
 */

static void
InitializeSourceLibraryDir(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    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);

    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 *)ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
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
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, 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 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.
 *
 *----------------------------------------------------------------------
 */

#  define tenviron2utfdstr(string, len, dsPtr) \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))

size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    size_t *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;
    const WCHAR *env;
    const char *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);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = _wenviron[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_WCharToUtfDString(env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = p1 - envUpper;
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);

	p1 = envUpper;
	p2 = nameUpper;
	for (; *p2 == *p1; p1++, p2++) {
	    /* NULL loop body. */







|
|
|
<










|



|




|










|



















|







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
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"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.
 *
 *----------------------------------------------------------------------
 */

#  define tenviron2utfdstr(string, len, dsPtr) \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))

int
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    int i, length, result = -1;
    const WCHAR *env;
    const char *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 *)ckalloc(length + 1);
    memcpy(nameUpper, name, length+1);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = _wenviron[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_WCharToUtfDString(env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	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
	Tcl_DStringFree(&envString);
    }

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    Tcl_Free(nameUpper);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|










685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
	Tcl_DStringFree(&envString);
    }

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    ckfree(nameUpper);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinInt.h.
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

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.







|




|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

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 */
    ClientData 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 ckalloc without
 * more overhead for finalize thread (should be executed anyway)
 *
 * #define _PTI_USE_CKALLOC 1
 */

/*
 * State of the pipe-worker.
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#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;







|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#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,
			    ClientData clientData, HANDLE wakeEvent);
MODULE_SCOPE int	TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);

static inline void
TclPipeThreadSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
Changes to win/tclWinLoad.c.
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
         * 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,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError;







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
         * 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(Tcl_GetString(pathPtr), -1, &ds);
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError;
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
        if (firstError == ERROR_MOD_NOT_FOUND ||
            firstError == ERROR_DLL_NOT_FOUND)
            lastError = GetLastError();
        else
            lastError = firstError;

	errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
		TclGetString(pathPtr));

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







|







114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
        if (firstError == ERROR_MOD_NOT_FOUND ||
            firstError == ERROR_DLL_NOT_FOUND)
            lastError = GetLastError();
        else
            lastError = firstError;

	errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
		Tcl_GetString(pathPtr));

	/*
	 * 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
	 */
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	return TCL_ERROR;
    }

    /*
     * 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;
}







|







167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
    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;

    FreeLibrary(hInstance);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
 *	this function is invoked to try to figure it out.
 *
 * Results:
 *	Always returns 0 to indicate that we couldn't figure out a package
 *	name; generic code will then try to guess the package from the file
 *	name. A return value of 1 would have meant that we figured out the
 *	package name and put it in bufPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_DString *))
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *







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







252
253
254
255
256
257
258
259




























260
261
262
263
264
265
266
    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;

    FreeLibrary(hInstance);
    ckfree(loadHandle);




























}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
    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:
 */







|











383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:
    dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR));
    wcscpy(dllDirectoryName, name);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to win/tclWinNotify.c.
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
	EnterCriticalSection(&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;








|







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
	EnterCriticalSection(&notifierMutex);
	if (notifierCount == 0) {
	    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 = NotifierProc;
	    clazz.hIcon = NULL;
	    clazz.hCursor = NULL;

191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
	 * notifier window class.
	 */

	EnterCriticalSection(&notifierMutex);
	if (notifierCount) {
	    notifierCount--;
	    if (notifierCount == 0) {
		UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance());
	    }
	}
	LeaveCriticalSection(&notifierMutex);
    }
}

/*







|







191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
	 * notifier window class.
	 */

	EnterCriticalSection(&notifierMutex);
	if (notifierCount) {
	    notifierCount--;
	    if (notifierCount == 0) {
		UnregisterClassW(className, TclWinGetTclInstance());
	    }
	}
	LeaveCriticalSection(&notifierMutex);
    }
}

/*
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
	 * 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.
	 */

	if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
	    tsdPtr->hwnd = CreateWindowW(className, className,
		    WS_TILED, 0, 0, 0, 0, NULL, NULL, (HINSTANCE)TclWinGetTclInstance(),
		    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.







|







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
	 * 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.
	 */

	if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
	    tsdPtr->hwnd = CreateWindowW(className, className,
		    WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(),
		    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.
Changes to win/tclWinPanic.c.
1
2
3
4
5
6
7
8
 /*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright (c) 2013 by Jan Nijtmans.
 * All rights reserved.
 *
|







1
2
3
4
5
6
7
8
/*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright (c) 2013 by Jan Nijtmans.
 * All rights reserved.
 *
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 *
 * 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];







|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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];
Changes to win/tclWinPipe.c.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    size_t dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList;

/*
 * Bit masks used in the flags field of the PipeInfo structure below.







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    DWORD dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList;

/*
 * Bit masks used in the flags field of the PipeInfo structure below.
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
 * This structure describes the channel type structure for command pipe based
 * I/O.
 */

static const Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* 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. */







|







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
 * This structure describes the channel type structure for command pipe based
 * I/O.
 */

static const Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    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. */
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent));
	    evPtr->header.proc = PipeEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    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

TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = (WinFile *)Tcl_Alloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*







|







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

TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = (WinFile *)ckalloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*
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
	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);
		return -1;
	    }
	}
	break;

    default:
	Tcl_Panic("TclpCloseFile: unexpected file type");
    }

    Tcl_Free(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.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------------------
 */

size_t
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) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return TCL_INDEX_NONE;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateProcess --
 *







|









|














|







|









|





|







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
	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());
		ckfree(filePtr);
		return -1;
	    }
	}
	break;

    default:
	Tcl_Panic("TclpCloseFile: unexpected file type");
    }

    ckfree(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, -1 is returned.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------------------
 */

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 == (DWORD) (size_t) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return (unsigned long) -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateProcess --
 *
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
    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];
    PipeInfo *infoPtr = (PipeInfo *)Tcl_Alloc(sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;







|







1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
    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];
    PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
	return;
    }

    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]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *







|





|







1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
	return;
    }

    pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj,
		Tcl_NewWideIntObj((unsigned)
			TclpGetPid(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
	 */

	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;

	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
		    TCL_READABLE);
	    Tcl_Free(filePtr);
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }

    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
    }

    if (pipePtr->writeBuf != NULL) {
	Tcl_Free(pipePtr->writeBuf);
    }

    Tcl_Free(pipePtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}








|









|



|


|







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

	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;

	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
		    TCL_READABLE);
	    ckfree(filePtr);
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }

    if (pipePtr->numPids > 0) {
	ckfree(pipePtr->pidPtr);
    }

    if (pipePtr->writeBuf != NULL) {
	ckfree(pipePtr->writeBuf);
    }

    ckfree(pipePtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = toWrite;
    } else {







|


|







2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = toWrite;
    } else {
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
     * 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) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*







|







2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
     * 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 == (DWORD) (size_t) pid) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
    }

    /*
     * Officially close the process handle.
     */

    CloseHandle(infoPtr->hProcess);
    Tcl_Free(infoPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *







|







2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
    }

    /*
     * Officially close the process handle.
     */

    CloseHandle(infoPtr->hProcess);
    ckfree(infoPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
 *
 *----------------------------------------------------------------------
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    size_t id)		/* Global process identifier */
{
    ProcInfo *procPtr = (ProcInfo*)Tcl_Alloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;







|

|







2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
 *
 *----------------------------------------------------------------------
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    unsigned long id)		/* Global process identifier */
{
    ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;
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
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
    } else {
	chan = Tcl_GetChannel(interp, TclGetString(objv[1]),
		NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
	chanTypePtr = Tcl_GetChannelType(chan);
	if (chanTypePtr != &pipeChannelType) {
	    return TCL_OK;
	}

	pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
		    Tcl_NewWideIntObj((unsigned)
			    TclpGetPid(pipePtr->pidPtr[i])));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }







|










|







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
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
    } else {
	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
		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);
	for (i = 0; i < pipePtr->numPids; i++) {
	    Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
		    Tcl_NewWideIntObj((unsigned)
			    TclpGetPid(pipePtr->pidPtr[i])));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
    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;







<
|







3193
3194
3195
3196
3197
3198
3199

3200
3201
3202
3203
3204
3205
3206
3207
    TCL_UNUSED(Tcl_Obj *) /*extensionObj*/,
    Tcl_Obj *resultingNameObj)
{
    WCHAR name[MAX_PATH];
    char *namePtr;
    HANDLE handle;
    DWORD flags = FILE_ATTRIBUTE_TEMPORARY;

    int length, counter, counter2;
    Tcl_DString buf;

    if (!resultingNameObj) {
	flags |= FILE_FLAG_DELETE_ON_CLOSE;
    }

    namePtr = (char *) name;
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
    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);
}







|







3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
    ClientData clientData,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = (TclPipeThreadInfo *)ckalloc(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);
}
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
	CloseHandle(pipeTI->evControl);
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	Tcl_Free(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
    }
}

/*
 *----------------------------------------------------------------------
 *







|







3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
	CloseHandle(pipeTI->evControl);
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	ckfree(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
    }
}

/*
 *----------------------------------------------------------------------
 *
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
	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:
 */







|













3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
	CloseHandle(pipeTI->evControl);
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	ckfree(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.
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
#endif

/*
 * Supply definitions for macros to query wait status, if not already
 * defined in header files above.
 */

#if TCL_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif /* TCL_UNION_WAIT */

#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xC0000000) == 0)







|







293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
#endif

/*
 * Supply definitions for macros to query wait status, if not already
 * defined in header files above.
 */

#ifdef TCL_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif /* TCL_UNION_WAIT */

#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xC0000000) == 0)
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
#   define MAXPATHLEN MAXPATH
#endif /* MAXPATHLEN */

/*
 * Define pid_t and uid_t if they're not already defined.
 */

#if ! TCL_PID_T
#   define pid_t int
#endif /* !TCL_PID_T */
#if ! TCL_UID_T
#   define uid_t int
#endif /* !TCL_UID_T */

/*
 * Visual C++ has some odd names for common functions, so we need to
 * define a few macros to handle them.  Also, it defines EDEADLOCK and
 * EDEADLK as the same value, which confuses Tcl_ErrnoId().







|


|







435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
#   define MAXPATHLEN MAXPATH
#endif /* MAXPATHLEN */

/*
 * Define pid_t and uid_t if they're not already defined.
 */

#if !defined(TCL_PID_T)
#   define pid_t int
#endif /* !TCL_PID_T */
#if !defined(TCL_UID_T)
#   define uid_t int
#endif /* !TCL_UID_T */

/*
 * Visual C++ has some odd names for common functions, so we need to
 * define a few macros to handle them.  Also, it defines EDEADLOCK and
 * EDEADLK as the same value, which confuses Tcl_ErrnoId().
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
 * 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:4996)
#   endif
#endif

/*







<
<
<







484
485
486
487
488
489
490



491
492
493
494
495
496
497
 * 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 _MSC_VER >= 1400
#	pragma warning(disable:4267)
#	pragma warning(disable:4996)
#   endif
#endif

/*
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581



582
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((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)

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




#endif /* _TCLWINPORT */







|















|
















>
>
>

539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size, isBin)	((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))

/* 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)	ckfree(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.
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
 * This structure describes the channel type structure for command serial
 * based IO.
 */

static const Tcl_ChannelType serialChannelType = {
    "serial",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* 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. */







|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
 * This structure describes the channel type structure for command serial
 * based IO.
 */

static const Tcl_ChannelType serialChannelType = {
    "serial",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TCL_CLOSE2PROC,		/* 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. */
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

	/*
	 * 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->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}








|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

	/*
	 * Queue an event if the serial is signaled for reading or writing.
	 */

	if (needEvent) {
	    infoPtr->flags |= SERIAL_PENDING;
	    evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent));
	    evPtr->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
    }

    /*
     * Wrap the error file into a channel and give it to the cleanup routine.
     */

    if (serialPtr->writeBuf != NULL) {
	Tcl_Free(serialPtr->writeBuf);
	serialPtr->writeBuf = NULL;
    }
    Tcl_Free(serialPtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}








|


|







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
    }

    /*
     * Wrap the error file into a channel and give it to the cleanup routine.
     */

    if (serialPtr->writeBuf != NULL) {
	ckfree(serialPtr->writeBuf);
	serialPtr->writeBuf = NULL;
    }
    ckfree(serialPtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = (DWORD) toWrite;








|


|







1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048

	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = (DWORD) toWrite;

1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;







|







1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
	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_Free((void *)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







|







1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
	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);
	    }
	    ckfree(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
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
	    dcb.XonChar = (char) character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if ((character > 0xFF) || argv[1][charLen]) {
		goto badXchar;
	    }
	    dcb.XoffChar = (char) character;
	}
	Tcl_Free((void *)argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    goto setStateFailed;
	}
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	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_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == 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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    result = TCL_ERROR;
		    break;
		}
	    } else {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal name \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
			    NULL);
		}
		result = TCL_ERROR;
		break;
	    }
	}

	Tcl_Free((void *)argv);
	return result;
    }

    /*
     * Option -sysbuffer {read_size write_size}
     * Option -sysbuffer read_size
     */








|












|











|





|











|











|











|










|




|
|







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
	    dcb.XonChar = (char) character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if ((character > 0xFF) || argv[1][charLen]) {
		goto badXchar;
	    }
	    dcb.XoffChar = (char) character;
	}
	ckfree(argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    goto setStateFailed;
	}
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	int i, res = 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_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    ckfree(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;
		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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = 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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = 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_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = TCL_ERROR;
		    break;
		}
	    } else {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal name \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
			    NULL);
		}
		res = TCL_ERROR;
		break;
	    }
	}

	ckfree(argv);
	return res;
    }

    /*
     * Option -sysbuffer {read_size write_size}
     * Option -sysbuffer read_size
     */

1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
	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);

	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_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);







|







1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
	if (argc == 1) {
	    inSize = atoi(argv[0]);
	    outSize = infoPtr->sysBufWrite;
	} else if (argc == 2) {
	    inSize  = atoi(argv[0]);
	    outSize = atoi(argv[1]);
	}
	ckfree(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_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
Changes to win/tclWinSock.c.
254
255
256
257
258
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282

283



284
285
286
287
288
289
290
static int		WaitForSocketEvent(TcpState *statePtr, 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_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:
 */

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







<





>
















>
|
>
>
>







254
255
256
257
258
259
260

261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
static int		WaitForSocketEvent(TcpState *statePtr, 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 Tcl_EventCheckProc	SocketCheckProc;
static Tcl_EventProc		SocketEventProc;
static Tcl_EventSetupProc	SocketSetupProc;
static Tcl_DriverBlockModeProc	TcpBlockModeProc;
static Tcl_DriverCloseProc	TcpCloseProc;
static Tcl_DriverClose2Proc	TcpClose2Proc;
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:
 */

static const Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
#ifndef TCL_NO_DEPRECATED
    TcpCloseProc,		/* Close proc. */
#else
    TCL_CLOSE2PROC,		/* Close proc. */
#endif
    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. */
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
 *
 *----------------------------------------------------------------------
 */

void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[256];
    DWORD length = sizeof(wbuf)/sizeof(WCHAR);
    Tcl_DString ds;

    Tcl_DStringInit(&ds);







|







360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
 *
 *----------------------------------------------------------------------
 */

void
InitializeHostName(
    char **valuePtr,
    unsigned int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[256];
    DWORD length = sizeof(wbuf)/sizeof(WCHAR);
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *







|







397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    Tcl_Free(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {







|







1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	    ckfree(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
    /*
     * 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);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --







|







1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
    /*
     * 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.
     */

    ckfree(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115

    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;
}

/*
 *----------------------------------------------------------------------







|



|







2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119

    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_Close(NULL, statePtr->channel);
	return NULL;
    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
	    "-eofchar", "")) {
	Tcl_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
	 * 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(







|







2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
	 * 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_Close(NULL, statePtr->channel);
	    return NULL;
	}
	return statePtr->channel;
    }

    if (interp != NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
    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.
     */








|




|







2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
    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_Close(NULL, newInfoPtr->channel);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }

    /*
     * Invoke the accept callback function.
     */

2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
	 * 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;








|







2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
	 * 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 = className;
	windowClass.lpfnWndProc = SocketProc;
	windowClass.hIcon = NULL;
	windowClass.hCursor = NULL;

2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626

    /*
     * 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);
}

/*
 *----------------------------------------------------------------------
 *







|







2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClassW(className, TclWinGetTclInstance());
    initialized = 0;
    Tcl_MutexUnlock(&socketMutex);
}

/*
 *----------------------------------------------------------------------
 *
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
    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);
}







|







2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
    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 *)ckalloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = statePtr->sockets->fd;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}
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
    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.
     */








|










|







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
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList));
	fds = fds->next;
    }

    /*
     * Populate new FD.
     */

3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
 *
 *----------------------------------------------------------------------
 */

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.







|







3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
 *
 *----------------------------------------------------------------------
 */

static TcpState *
NewSocketInfo(SOCKET socket)
{
    TcpState *statePtr = (TcpState *)ckalloc(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.
3384
3385
3386
3387
3388
3389
3390






























































3391
3392
3393
3394
3395
3396
3397
	if (fds->fd == socket) {
	    return 1;
	}
    }
    return 0;
}































































/*
 *----------------------------------------------------------------------
 *
 * TcpThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.
 *







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







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
	if (fds->fd == socket) {
	    return 1;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetSockOpt, et al. --
 *
 *	Those functions are historically exported by the stubs table and
 *	just use the original system calls now.
 *
 * Warning:
 *	Those functions are depreciated and will be removed with TCL 9.0.
 *
 * Results:
 *	As defined for each function.
 *
 * Side effects:
 *	As defined for each function.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
#undef TclWinGetSockOpt
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);
}

#undef TclpInetNtoa
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);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * TcpThreadActionProc --
 *
 *	Insert or remove any thread local refs to this channel.
 *
Changes to win/tclWinTest.c.
37
38
39
40
41
42
43

44
45
46
47
48
49
50
 * Forward declarations of functions defined later in this file:
 */

static Tcl_ObjCmdProc	TesteventloopCmd;
static Tcl_ObjCmdProc	TestvolumetypeCmd;
static Tcl_ObjCmdProc	TestwinclockCmd;
static Tcl_ObjCmdProc	TestwinsleepCmd;

static Tcl_ObjCmdProc	TestExceptionCmd;
static int		TestplatformChmod(const char *nativePath, int pmode);
static Tcl_ObjCmdProc	TestchmodCmd;

/*
 *----------------------------------------------------------------------
 *







>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
 * Forward declarations of functions defined later in this file:
 */

static Tcl_ObjCmdProc	TesteventloopCmd;
static Tcl_ObjCmdProc	TestvolumetypeCmd;
static Tcl_ObjCmdProc	TestwinclockCmd;
static Tcl_ObjCmdProc	TestwinsleepCmd;
static Tcl_ObjCmdProc	TestSizeCmd;
static Tcl_ObjCmdProc	TestExceptionCmd;
static int		TestplatformChmod(const char *nativePath, int pmode);
static Tcl_ObjCmdProc	TestchmodCmd;

/*
 *----------------------------------------------------------------------
 *
73
74
75
76
77
78
79

80
81
82
83
84
85
86
    Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
    Tcl_CreateObjCommand(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;
}

/*
 *----------------------------------------------------------------------
 *
 * TesteventloopCmd --







>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
    Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
    Tcl_CreateObjCommand(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);
    Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TesteventloopCmd --
304
305
306
307
308
309
310


























311
312
313
314
315
316
317
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
	return TCL_ERROR;
    }
    Sleep((DWORD) ms);
    return TCL_OK;
}



























/*
 *----------------------------------------------------------------------
 *
 * TestExceptionCmd --
 *
 *	Causes this process to end with the named exception. Used for testing







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







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
	return TCL_ERROR;
    }
    Sleep((DWORD) ms);
    return TCL_OK;
}

static int
TestSizeCmd(
    TCL_UNUSED(ClientData),
    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;
    }

syntax:
    Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestExceptionCmd --
 *
 *	Causes this process to end with the named exception. Used for testing
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = (BYTE *)Tcl_Alloc(secDescLen);
	if (!GetFileSecurityA(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;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */








|











|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = (BYTE *)ckalloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {
	    goto done;
	}
    }

    /*
     * Get the World SID.
     */

    userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */

497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = (PACL) Tcl_Alloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;







|







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539

    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = (PACL) ckalloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	Tcl_Free(secDesc);
    }
    if (newAcl) {
	Tcl_Free(newAcl);
    }
    if (userSid) {
	Tcl_Free(userSid);
    }
    if (userDomain) {
	Tcl_Free(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*







|


|


|


|







602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	ckfree(secDesc);
    }
    if (newAcl) {
	ckfree(newAcl);
    }
    if (userSid) {
	ckfree(userSid);
    }
    if (userDomain) {
	ckfree(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*
Changes to win/tclWinThrd.c.
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    Tcl_Free(winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    ckfree(winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID 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 flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(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







|






|







200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    ClientData clientData,	/* The one argument to Main(). */
    int stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    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
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	TclpGlobalLock();

	/*
	 * Double inside global lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpGlobalUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);







|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	TclpGlobalLock();

	/*
	 * Double inside global lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpGlobalUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	Tcl_Free(csPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *







|







625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	ckfree(csPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	TclpGlobalLock();

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpGlobalUnlock();







|







707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
	TclpGlobalLock();

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpGlobalUnlock();
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
     * The per-thread condition waiting event is reclaimed earlier in a
     * per-thread exit handler, which is called before thread local storage is
     * reclaimed.
     */

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











|







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
     * 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);
	ckfree(winCondPtr);
	*condPtr = NULL;
    }
}




1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047


void *
TclpThreadCreateKey(void)
{
    DWORD *key;

    key = (DWORD *)TclpSysAlloc(sizeof *key);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {







|







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047


void *
TclpThreadCreateKey(void)
{
    DWORD *key;

    key = (DWORD *)TclpSysAlloc(sizeof *key, 0);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {
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
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"





/*
 * Number of samples over which to estimate the performance counter.
 */

#define SAMPLES		64






















/*
 * Data for managing high-resolution timers.
 */

typedef struct {
    CRITICAL_SECTION cs;	/* Mutex guarding this structure. */
    int initialized;		/* Flag == 1 if this structure is







>
>
>
>






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







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
 *
 * 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.
 */

#ifndef TCL_NO_DEPRECATED
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 {
    char tzName[64];		/* Time zone name */
    struct tm tm;		/* time information */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_DEPRECATED */

/*
 * Data for managing high-resolution timers.
 */

typedef struct {
    CRITICAL_SECTION cs;	/* Mutex guarding this structure. */
    int initialized;		/* Flag == 1 if this structure is
102
103
104
105
106
107
108



109
110
111
112
113
114
115
} wideClick = {0, 0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */




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







>
>
>







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
} wideClick = {0, 0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */

#ifndef TCL_NO_DEPRECATED
static struct tm *	ComputeGMT(const time_t *tp);
#endif /* TCL_NO_DEPRECATED */
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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetSeconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())







|







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return (Tcl_WideUInt)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;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --







|








|









|







205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned long
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	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 (unsigned long)(now.sec * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --
679
680
681
682
683
684
685













































































































































































































































686
687
688
689
690
691
692
    CloseHandle(timeInfo.exitEvent);
    CloseHandle(timeInfo.calibrationThread);
}

/*
 *----------------------------------------------------------------------
 *













































































































































































































































 * CalibrationThread --
 *
 *	Thread that manages calibration of the hi-resolution time derived from
 *	the performance counter, to keep it synchronized with the system
 *	clock.
 *
 * Parameters:







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







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
    CloseHandle(timeInfo.exitEvent);
    CloseHandle(timeInfo.calibrationThread);
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_DEPRECATED
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;
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * CalibrationThread --
 *
 *	Thread that manages calibration of the hi-resolution time derived from
 *	the performance counter, to keep it synchronized with the system
 *	clock.
 *
 * Parameters:
1064
1065
1066
1067
1068
1069
1070







































































1071
1072
1073
1074
1075
1076
1077
	    timeInfo.sampleNo = 0;
	}

	return estFreq;
    }
}








































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *	TIP #233 (Virtualized Time): Registers two handlers for the
 *	virtualization of Tcl's access to time information.







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







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

#ifndef TCL_NO_DEPRECATED
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
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *	TIP #233 (Virtualized Time): Registers two handlers for the
 *	virtualization of Tcl's access to time information.