Tcl Source Code

Changes On Branch tip-526
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch tip-526 Excluding Merge-Ins

This is equivalent to a diff from e784d77fd7 to cbda4839f6

2021-01-28
12:11
Restore accidently overwritten testcases Leaf check-in: cbda4839f6 user: jan.nijtmans tags: tip-526
11:58
Merge 9.0 check-in: 425b938783 user: jan.nijtmans tags: tip-526
2020-10-30
14:09
Rename "trunk" to "main", but with new propagating tag "trunk" check-in: 40014cd0fa user: jan.nijtmans tags: trunk, main
2020-10-29
21:09
merge trunk check-in: b5e7f9da2b user: dgp tags: dgp-refactor
21:09
merge trunk check-in: 9ef0a76b94 user: dgp tags: dgp-properbytearray
21:08
merge trunk check-in: af4787a970 user: dgp tags: novem
11:40
Merge 8.7 Closed-Leaf check-in: e784d77fd7 user: jan.nijtmans tags: trunk
11:18
Merge 8.6 check-in: 642317cdbc user: jan.nijtmans tags: core-8-branch
2020-10-27
21:36
merge 8.7 check-in: de3076b8ab user: dgp tags: trunk

Changes to .fossil-settings/crlf-glob.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/contrib/vstudio/*/*.sln
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in








<









<
1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18

compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/contrib/vstudio/*/*.sln
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj

tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw

Changes to .fossil-settings/encoding-glob.

1
2
3
4
5
6
7
8
9
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in
<







<
1
2
3
4
5
6
7

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

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
46
47
48
49
50
51
name: Linux
on: [push]
jobs:
  gcc:
    runs-on: ubuntu-20.04
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "CFLAGS=-DTCL_UTF_MAX=3"
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
        working-directory: generic
      - name: Configure ${{ matrix.cfgopt }}
        run: |
          mkdir "${HOME}/install dir"
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: ${{ matrix.cfgopt }}
      - name: Build
        run: |
          make all
      - name: Build Test Harness
        run: |
          make tcltest
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
      - 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
name: macOS
on: [push]
jobs:
  xcode:
    runs-on: macos-11.0
    defaults:
      run:
        shell: bash
        working-directory: macosx
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
        working-directory: generic
      - name: Build
        run: make all
      - name: Run Tests
        run: make test styles=develop
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1
  clang:
    runs-on: macos-11.0
    strategy:
      matrix:
        cfgopt:
          - ""
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
    defaults:
      run:
        shell: bash
        working-directory: unix
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
          mkdir "$HOME/install dir"
        working-directory: generic
      - name: Configure ${{ matrix.cfgopt }}
        # Note that macOS is always a 64 bit platform
        run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1)
        env:
          CFGOPT: ${{ matrix.cfgopt }}
      - name: Build
        run: |
          make all tcltest
      - name: Run Tests
        run: |
          make test
        env:
          ERROR_ON_FAILURES: 1
          MAC_CI: 1

Added .github/workflows/onefiledist.yml.



















































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
name: Build Binaries
on: [push]
jobs:
  linux:
    name: Linux
    runs-on: ubuntu-16.04
    defaults:
      run:
        shell: bash
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Prepare
        run: |
          touch generic/tclStubInit.c generic/tclOOStubInit.c
          mkdir 1dist
          echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
        working-directory: .
      - name: Configure
        run: ./configure --disable-symbols --disable-shared --enable-zipfs
        working-directory: unix
      - name: Build
        run: |
          make tclsh tclzipfile
          make shell SCRIPT="$VER_PATH $GITHUB_ENV"
          echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
        working-directory: unix
      - name: Package
        run: |
          cat ../unix/tclsh $TCL_ZIP > tclsh${TCL_PATCHLEVEL}_unofficial
          chmod +x tclsh${TCL_PATCHLEVEL}_unofficial
          tar -cf tclsh${TCL_PATCHLEVEL}_unofficial.tar tclsh${TCL_PATCHLEVEL}_unofficial
        working-directory: 1dist
      - name: Upload
        uses: actions/[email protected]
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (unofficial)
          path: 1dist/*.tar
  macos:
    name: macOS
    runs-on: macos-latest
    defaults:
      run:
        shell: bash
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Checkout create-dmg
        uses: actions/[email protected]
        with:
          repository: create-dmg/create-dmg
          ref: v1.0.8
          path: create-dmg
      - name: Prepare
        run: |
          mkdir 1dist
          touch generic/tclStubInit.c generic/tclOOStubInit.c || true
          echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
          echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV
      - name: Configure
        run: ./configure --disable-symbols --disable-shared --enable-zipfs
        working-directory: unix
      - name: Build
        run: |
          make tclsh tclzipfile
          make shell SCRIPT="$VER_PATH $GITHUB_ENV"
          echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
          echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
        working-directory: unix
      - name: Package
        run: |
          mkdir contents
          cat $TCL_BIN $TCL_ZIP > contents/tclsh${TCL_PATCHLEVEL}_unofficial
          chmod +x contents/tclsh${TCL_PATCHLEVEL}_unofficial
          cat > contents/README.txt <<EOF
          This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL

          It is not intended as an official release at all, so it is unsigned and unnotarized.
          Use strictly at your own risk.

          To run it, you need to copy the executable out and run:
              xattr -d com.apple.quarantine tclsh${TCL_PATCHLEVEL}_unofficial
          to mark the executable as runnable on your machine.
          EOF
          $CREATE_DMG \
              --volname "Tcl $TCL_PATCHLEVEL (unofficial)" \
              --window-pos 200 120 \
              --window-size 800 400 \
              "Tcl-$TCL_PATCHLEVEL-(unofficial).dmg" \
              "contents/"
        working-directory: 1dist
      - name: Upload
        uses: actions/[email protected]
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (unofficial)
          path: 1dist/*.dmg
  win:
    name: Windows
    runs-on: windows-latest
    defaults:
      run:
        shell: bash
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Install MSYS2
        uses: msys2/[email protected]
      - name: Prepare
        run: |
          touch generic/tclStubInit.c generic/tclOOStubInit.c
          echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
          mkdir 1dist
        working-directory: .
      - name: Configure
        run: ./configure --disable-symbols --disable-shared --enable-zipfs
        working-directory: win
      - name: Build
        run: |
          make binaries libraries tclzipfile
          echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
        working-directory: win
      - name: Package
        run: |
          cat ../win/tclsh*.exe $TCL_ZIP > combined.exe
        working-directory: 1dist
      - name: Get Exact Version
        run: |
          ./combined.exe $VER_PATH $GITHUB_ENV
        working-directory: 1dist
      - name: Set Executable Name
        run: |
          mv combined.exe tclsh${TCL_PATCHLEVEL}_unofficial.exe
        working-directory: 1dist
      - name: Upload
        uses: actions/[email protected]
        with:
          name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (unofficial)
          path: '1dist/*_unofficial.exe'

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
76
77
78
79
80
81
82
83
84
85
name: Windows
on: [push]
jobs:
  msvc:
    runs-on: windows-latest
    defaults:
      run:
        shell: powershell
        working-directory: win
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CHECKS=nodep"
          - "OPTS=static"
          - "OPTS=symbols"
          - "OPTS=memdbg"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Init MSVC
        uses: ilammy/[email protected]
      - name: Build ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} all
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Build Test Harness ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
      - name: Run Tests ${{ matrix.cfgopt }}
        run: |
          &nmake -f makefile.vc ${{ matrix.cfgopt }} test
          if ($lastexitcode -ne 0) {
             throw "nmake exit code: $lastexitcode"
          }
        env:
          ERROR_ON_FAILURES: 1
          CI_BUILD_WITH_MSVC: 1
  gcc:
    runs-on: windows-latest
    defaults:
      run:
        shell: bash
        working-directory: win
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout
        uses: actions/[email protected]
      - name: Install MSYS2 and Make
        run: choco install msys2 make
      - name: Prepare
        run: |
          touch tclStubInit.c tclOOStubInit.c tclOOScript.h
          mkdir "${HOME}/install dir"
        working-directory: generic
      - name: Configure ${{ matrix.cfgopt }}
        run: |
          ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
        env:
          CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
      - 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 .travis.yml.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
    - name: "Linux/GCC/Mem-Debug"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"
# C++ build.
    - name: "Linux/G++/Shared"
      os: linux
      dist: focal
      compiler: g++
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register"
# Newer/Older versions of GCC
    - name: "Linux/GCC 10/Shared"
      os: linux
      dist: focal
      compiler: gcc-10
      addons:
        apt:






<
<
<
<
<
<
<
<







51
52
53
54
55
56
57








58
59
60
61
62
63
64
    - name: "Linux/GCC/Mem-Debug"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"








# Newer/Older versions of GCC
    - name: "Linux/GCC 10/Shared"
      os: linux
      dist: focal
      compiler: gcc-10
      addons:
        apt:
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
        - 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: []






<
<
<
<
<
<
<
<







128
129
130
131
132
133
134








135
136
137
138
139
140
141
        - BUILD_DIR=macosx
      install: []
      script: *mactest
      addons:
        homebrew:
          packages:
            - libtommath








# Newer MacOS versions
    - name: "macOS/Clang/Xcode 12/Universal Apps/Shared"
      os: osx
      osx_image: xcode12u
      env:
        - BUILD_DIR=macosx
      install: []
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
    - name: "Windows/MSVC/Shared"
      os: windows
      compiler: cl
      env: &vcenv
        - BUILD_DIR=win
        - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
      before_install: &vcpreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - PATH="$PATH:$VCDIR"
        - cd ${BUILD_DIR}
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test
    - name: "Windows/MSVC/Static"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:






<














|
|







|
|







197
198
199
200
201
202
203

204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
    - 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

        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - PATH="$PATH:$VCDIR"
        - cd ${BUILD_DIR}
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=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' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static' '-f' makefile.vc test
    - name: "Windows/MSVC/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
    - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Static"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:






|
|







|
|







257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
    - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Static"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - choco install -y make zip
        - cd ${BUILD_DIR}
    - name: "Windows/GCC/Shared: UTF_MAX=3"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
      before_install: *makepreinst
    - name: "Windows/GCC/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++ --enable-64bit"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --disable-shared"
      before_install: *makepreinst






<

















<
<
<
<
<
<
<
<
<







294
295
296
297
298
299
300

301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317









318
319
320
321
322
323
324
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst

        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - choco install -y make zip
        - cd ${BUILD_DIR}
    - name: "Windows/GCC/Shared: UTF_MAX=3"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
      before_install: *makepreinst
    - name: "Windows/GCC/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst









    - name: "Windows/GCC/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --disable-shared"
      before_install: *makepreinst
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++-x86/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC-x86/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--disable-shared"
      before_install: *makepreinst






<
<
<
<
<
<
<
<
<







353
354
355
356
357
358
359









360
361
362
363
364
365
366
    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst









    - name: "Windows/GCC-x86/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--disable-shared"
      before_install: *makepreinst
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
      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






<











384
385
386
387
388
389
390

391
392
393
394
395
396
397
398
399
400
401
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:

  - 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 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 9.0a2** source distribution.

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

8.6 (production release, daily build)
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-6-branch)
<br>
8.7 (in development, daily build))
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-branch)
<br>
9.0 (in development, daily build))
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Amain)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=main)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Amain)

## Contents
 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
takes place at [core.tcl-lang.org](https://core.tcl-lang.org/).
Tcl/Tk release and mailing list services are [hosted by
SourceForge](https://sourceforge.net/projects/tcl/)
with the Tcl Developer Xchange hosted at
[www.tcl-lang.org](https://www.tcl-lang.org).

Tcl is a freely available open source package.  You can do virtually
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






|





|





|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
When paired with the Tk toolkit, Tcl provides the fastest and most powerful
way to create GUI applications that run on PCs, Unix, and Mac OS X.
Tcl can also be used for a variety of web-related tasks and for creating
powerful command languages for applications.

Tcl is maintained, enhanced, and distributed freely by the Tcl community.
Source code development and tracking of bug reports and feature requests
take place at [core.tcl-lang.org](https://core.tcl-lang.org/).
Tcl/Tk release and mailing list services are [hosted by
SourceForge](https://sourceforge.net/projects/tcl/)
with the Tcl Developer Xchange hosted at
[www.tcl-lang.org](https://www.tcl-lang.org).

Tcl is a freely available open-source package.  You can do virtually
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 on 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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
## <a id="build">3.</a> Compiling and installing Tcl
There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms.  There is additional information
about building Tcl from sources
[online](https://www.tcl-lang.org/doc/howto/compile.html).

## <a id="devtools">4.</a> Development tools
ActiveState produces a high quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler and
more.  More information can be found at

	http://www.ActiveState.com/Tcl

## <a id="complangtcl">5.</a> Tcl newsgroup
There is a USENET news group, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications.  The newsgroup is a
great place to ask general information questions.  For bug reports, please
see the "Support and bug fixes" section below.

## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)
covering all aspects of Tcl/Tk.






|


|





|







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
## <a id="build">3.</a> Compiling and installing Tcl
There are brief notes in the `unix/README`, `win/README`, and `macosx/README`
about compiling on these different platforms.  There is additional information
about building Tcl from sources
[online](https://www.tcl-lang.org/doc/howto/compile.html).

## <a id="devtools">4.</a> Development tools
ActiveState produces a high-quality set of commercial quality development
tools that is available to accelerate your Tcl application development.
Tcl Dev Kit builds on the earlier TclPro toolset and provides a debugger,
static code checker, single-file wrapping utility, bytecode compiler, and
more.  More information can be found at

	http://www.ActiveState.com/Tcl

## <a id="complangtcl">5.</a> Tcl newsgroup
There is a USENET newsgroup, "`comp.lang.tcl`", intended for the exchange of
information about Tcl, Tk, and related applications.  The newsgroup is a
great place to ask general information questions.  For bug reports, please
see the "Support and bug fixes" section below.

## <a id="wiki">6.</a> Tcl'ers Wiki
There is a [wiki-based open community site](https://wiki.tcl-lang.org/)
covering all aspects of Tcl/Tk.

Changes to changes.

8988
8989
8990
8991
8992
8993
8994

































































































































8995
8996
8997
8998
8999
9000
9001
2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter)

2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres)

- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ -


































































































































Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter)

2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter)






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







8988
8989
8990
8991
8992
8993
8994
8995
8996
8997
8998
8999
9000
9001
9002
9003
9004
9005
9006
9007
9008
9009
9010
9011
9012
9013
9014
9015
9016
9017
9018
9019
9020
9021
9022
9023
9024
9025
9026
9027
9028
9029
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042
9043
9044
9045
9046
9047
9048
9049
9050
9051
9052
9053
9054
9055
9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
9082
9083
9084
9085
9086
9087
9088
9089
9090
9091
9092
9093
9094
9095
9096
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130
2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter)

2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres)

- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ -

2019-12-03 (bug)[3cd9be] Corner case in surrogate handling (nijtmans)

2019-12-09 (new) Add tcltest::(Setup|Eval|Cleanup|)Test (coulter,sebres)
=> tcltest 2.5.2

2019-12-12 (new) Add 3 libtommath functions to stub table (nijtmans)

2019-12-23 (bug)[ce3b9f] compilation errors with clang, windows msys2 (nijtmans)

2019-12-27 (bug)[1de6b0] [expr 1e2147483648] => 0.0 (kbk)

2020-01-04 (bug)[912886] tis-620 encoding fails to load (coulter)

2020-01-13 (bug)[0b9332] Win: support system encoding init to utf-8 (jedlička)

2020-01-17 (bug)[8cd2fe] [unload] corrupted list of loaded packages (berc)

2020-01-17 (bug)[5d989f] segfault in lsort for large list length (sebres)

2020-01-30 (bug) Reset WSAGetLastError()/errno in channel close (nijtmans)

2020-02-17 (bug) Win: avoid create of legacy error-vars on init phase (sebres)

2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)

2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
=> registry 1.4.3
=> dde 1.3.5

2020-03-05 (new) Update to Unicode-13 (nijtmans)

2020-03-16 (bug)[8f89e2] Win: env var encoding, env-2.5 (sebres, nijtmans)

2020-03-27 (bug)[767e07] Tcl_Get(Range|UniChar) validate index inputs (nijtmans)

2020-03-28 (bug)[8edfce] [binary encode base64] & multi-byte wrapchars (dgp)

2020-03-28 (bug)[ffeb20] [binary decode base64] ignore invalid chars (dgp)
See RFC 2045
        *** POTENTIAL INCOMPATIBILITY ***

2020-03-31 (bug)[b8e82d] some -maxlen values break uuencode round trip (dgp)
        *** POTENTIAL INCOMPATIBILITY ***

2020-04-01 (bug)[f58371] Fileevent run in proper thread (bron,sebres)

2020-04-13 (bug)[afa4b2] TclNeedSpace bug; tests util-8.5 .. util-8.11 (dgp)

2020-04-13 (bug)[085913] Tcl_DStringAppendElement # quoting precision (dgp)
        *** POTENTIAL INCOMPATIBILITY ***

2020-04-13 (bug)[a7f685] test util-5.52 (dgp)

2020-04-13 (bug)[c61818] Tcl_UtfPrev regression (dgp)

2020-04-15 (bug)[8af92d] zlib transform issue, bad inflate (sebres)

2020-04-16 (bug)[5e6346] Tcl_UtfPrev handling of overlong sequences (dgp)

2020-04-27 (bug)[45ca23] [string tolower] inconsistency (dgp)

2020-04-30 (bug)[da2352] init [info hostname] with DNS, not NetBIOS (nadkarni)

2020-05-11 (bug)[d402ff] Win32 potential crash when using main() (werner)

2020-05-13 (bug)[81242a] revised documentation for Tcl_UtfAtIndex() (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2020-05-13 (bug)[ed2980] Tcl_UtfToUniChar reads > TCL_UTF_MAX bytes (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2020-06-02 (bug) prevent segfault in parser (sebres)

2020-06-21 (bug)[f81bec] http POST a binary file (alakendu,nash)
=> http 2.9.2

2020-06-23 (bug)[41c985] auto_path nonsense in Safe Base (nash)

2020-06-24 (bug)[f70ce1] zlib multi-stream inflate acts only on first (sebres)

2020-07-09 (bug)[a1bd37] [clock scan] new ISO format (clock-34.(19-24)) (sebres)
        *** POTENTIAL INCOMPATIBILITY ***

2020-07-10 (bug)[501974] [clock scan] +time zone (clock-34.(53-68)) (sebres)
        *** POTENTIAL INCOMPATIBILITY ***

2020-07-15 (bug)[3c6e47] compiled [lappend] performance, avoid copy (sebres)

2020-07-16 (bug)[5bbd04] Fix index underflow (schwab)

2020-07-27 (bug)[cb0373] http::geturl -keepalive fixes (nash)
=> http 2.9.3

2020-08-10 (bug)[29e884] cmd resolution cycle (namespace-57.0) (coulter,sebres)

2020-08-12 (bug)[e87000] Tcl_BadChannelOption tolerate NULL (werner,nijtmans)

2020-08-31 (TIP #581) disfavor Master/Slave terminology (nijtmans)
=> opt 0.4.8

2020-09-11 (bug)[3bc0f4] UBSan complains about body.chars[] usage (nijtmans)

2020-09-17 (bug)[835c93] Support TIP 525 exit code for -singleproc 1 (nijtmans)
=> tcltest 2.5.3

2020-09-25 (new) force -eofchar \032 when evaluating library scripts (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2020-09-29 (bug)[0063cb] http::geturl -headers must be dict (oehlmann,nijtmans)

2020-10-19 (bug)[cb4582] Update install-sh script (stu,nijtmans)

2020-10-22 (bug)[c97593] Usage of gnu_printf in latest mingw-w64 (nijtmans)

2020-10-26 (new)[48898a] improve error message consistency (stu)
        *** POTENTIAL INCOMPATIBILITY ***

2020-11-06 (new) revised case of module names (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2020-12-10 (bug)[ed5be7] Win: recognize "comx:" as serial port (oehlmann)

2020-12-11 (new) support for msys2, Big Sur (nijtmans)
=> platform 1.0.15

2020-12-23 tzdata updated to Olson's tzdata2020e (jima)

- Released 8.6.11, Dec 31, 2020 - details at http://core.tcl-lang.org/tcl/ -

Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter)

2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter)

Changes to doc/ByteArrObj.3.

33
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
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
If non-NULL, filled with the length of the array of bytes in the value.

.BE

.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl byte-array values
from C code.  Byte-array values are typically used to hold the
results of binary IO operations or data structures created with the






|
|
>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
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 size_t | int *lengthPtr out
Filled with the length of the array of bytes in the value.
May be (int *)NULL when not used.
.BE

.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl byte-array values
from C code.  Byte-array values are typically used to hold the
results of binary IO operations or data structures created with the

Changes to doc/CrtChannel.3.

249
250
251
252
253
254
255

256
257
258
259
260
261
262
263
outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
4096.
.PP
\fBTcl_NotifyChannel\fR is called by a channel driver to indicate to
the generic layer that the events specified by \fImask\fR have
occurred on the channel.  Channel drivers are responsible for invoking
this function whenever the channel handlers need to be called for the

channel.  See \fBWATCHPROC\fR below for more details.
.PP
\fBTcl_BadChannelOption\fR is called from driver specific
\fIsetOptionProc\fR or \fIgetOptionProc\fR to generate a complete
error message.
.PP
\fBTcl_ChannelBuffered\fR returns the number of bytes of input
currently buffered in the internal buffer (push back area) of the






>
|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
4096.
.PP
\fBTcl_NotifyChannel\fR is called by a channel driver to indicate to
the generic layer that the events specified by \fImask\fR have
occurred on the channel.  Channel drivers are responsible for invoking
this function whenever the channel handlers need to be called for the
channel (or other pending tasks like a write flush should be performed).
See \fBWATCHPROC\fR below for more details.
.PP
\fBTcl_BadChannelOption\fR is called from driver specific
\fIsetOptionProc\fR or \fIgetOptionProc\fR to generate a complete
error message.
.PP
\fBTcl_ChannelBuffered\fR returns the number of bytes of input
currently buffered in the internal buffer (push back area) of the
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
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
(suitable for use with \fBTcl_SetErrno\fR) on failure.






|







758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
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,
        long long \fIlength\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created, and
\fIlength\fR is the new length of the underlying file, which should
not be negative. The result should be 0 on success or an errno code
(suitable for use with \fBTcl_SetErrno\fR) on failure.

Changes to doc/CrtTrace.3.

1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 by Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS


|







1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS

Changes to doc/DumpActiveMemory.3.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface
|
|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans.
'\" Copyright (c) 2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface

Changes to doc/FileSystem.3.

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
.sp
Tcl_Obj *
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
Tcl_StatBuf *
\fBTcl_AllocStatBuf\fR()
.sp
Tcl_WideInt
\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
\fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetDeviceTypeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSDeviceFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSInodeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetGroupIdFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetLinkCountFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetModeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR)
.SH ARGUMENTS
.AS Tcl_GlobTypeData **srcPathPtr out
.AP "const Tcl_Filesystem" *fsPtr in






|





|


|




















|


|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
.sp
Tcl_Obj *
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
Tcl_StatBuf *
\fBTcl_AllocStatBuf\fR()
.sp
long long
\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned long long
\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
.sp
long long
\fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetDeviceTypeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSDeviceFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSInodeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetGroupIdFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetLinkCountFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetModeFromStat\fR(\fIstatPtr\fR)
.sp
long long
\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned long long
\fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR)
.SH ARGUMENTS
.AS Tcl_GlobTypeData **srcPathPtr out
.AP "const Tcl_Filesystem" *fsPtr in

Changes to doc/GetHostName.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetHostName \- get the name of the local host
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetHostName \- get the name of the local host

Changes to doc/GetStdChan.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1996 by Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS

Changes to doc/GetTime.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <[email protected]>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS

Changes to doc/Init.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script

Changes to doc/IntObj.3.

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
with which values might be exchanged.  The C integral types for which Tcl
provides value exchange routines are \fBint\fR, \fBlong int\fR,
\fBTcl_WideInt\fR, and \fBmp_int\fR.  The \fBint\fR and \fBlong int\fR types
are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
on the platform and the C compiler, the actual type might be
\fBlong long int\fR, \fB__int64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
Tcl value initialized to the integral value of the argument.  The
returned Tcl value is unshared.






|







98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
with which values might be exchanged.  The C integral types for which Tcl
provides value exchange routines are \fBint\fR, \fBlong int\fR,
\fBTcl_WideInt\fR, and \fBmp_int\fR.  The \fBint\fR and \fBlong int\fR types
are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
on the platform and the C compiler, the actual type might be
\fBlong long int\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
Tcl value initialized to the integral value of the argument.  The
returned Tcl value is unshared.

Changes to doc/NRE.3.

1
2
3
4
5
6
7
8
9
10
.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
|
|







1
2
3
4
5
6
7
8
9
10
.\"
.\" Copyright (c) 2008 Kevin B. Kenny.
.\" Copyright (c) 2018 Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
228
229
230
231
232
233
234
235
236
implement looping and sequencing constructs using the function stack.
.PP
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.






|
|
228
229
230
231
232
233
234
235
236
implement looping and sequencing constructs using the function stack.
.PP
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright \(co 2008 Kevin B. Kenny.
Copyright \(co 2018 Nathan Coulter.

Changes to doc/OpenFileChnl.3.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
.sp
int
\fBTcl_InputBuffered\fR(\fIchannel\fR)
.sp
int
\fBTcl_OutputBuffered\fR(\fIchannel\fR)
.sp
Tcl_WideInt
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
.sp
Tcl_WideInt
\fBTcl_Tell\fR(\fIchannel\fR)
.sp
int
\fBTcl_TruncateChannel\fR(\fIchannel, length\fR)
.sp
int
\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)






|


|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
.sp
int
\fBTcl_InputBuffered\fR(\fIchannel\fR)
.sp
int
\fBTcl_OutputBuffered\fR(\fIchannel\fR)
.sp
long long
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
.sp
long long
\fBTcl_Tell\fR(\fIchannel\fR)
.sp
int
\fBTcl_TruncateChannel\fR(\fIchannel, length\fR)
.sp
int
\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
.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
Relative to which point to seek; used with \fIoffset\fR to calculate the new
access point for the channel. Legal values are \fBSEEK_SET\fR,
\fBSEEK_CUR\fR, and \fBSEEK_END\fR.
.AP Tcl_WideInt length in
The (non-negative) length to truncate the channel the channel to.
.AP "const char" *optionName in
The name of an option applicable to this channel, such as \fB\-blocking\fR.
May have any of the values accepted by the \fBfconfigure\fR command.
.AP Tcl_DString *optionValue in
Where to store the value of an option or a list of all options and their
values. Must have been initialized by the caller.






|







|







186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
.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 "long long" 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
Relative to which point to seek; used with \fIoffset\fR to calculate the new
access point for the channel. Legal values are \fBSEEK_SET\fR,
\fBSEEK_CUR\fR, and \fBSEEK_END\fR.
.AP "long long" length in
The (non-negative) length to truncate the channel the channel to.
.AP "const char" *optionName in
The name of an option applicable to this channel, such as \fB\-blocking\fR.
May have any of the values accepted by the \fBfconfigure\fR command.
.AP Tcl_DString *optionValue in
Where to store the value of an option or a list of all options and their
values. Must have been initialized by the caller.

Changes to doc/SaveResult.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"

Changes to doc/SourceRCFile.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SourceRCFile \- source the Tcl rc file
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SourceRCFile \- source the Tcl rc file

Changes to doc/StdChannels.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by ActiveState Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 ActiveState Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS

Changes to doc/StringObj.3.

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
.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.






|
|
|







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
.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 size_t | int *lengthPtr out
The location where \fBTcl_GetStringFromObj\fR will store the length
of a value's string representation. May be (int *)NULL when not used.
.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.

Changes to doc/TCL_MEM_DEBUG.3.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging
|
|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans.
'\" Copyright (c) 2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging

Changes to doc/Tcl.n.

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.RS
.PP
The range U+00D800\(enU+00DFFF is reserved for surrogates, which
are illegal on its own. Therefore, such sequences will result in
the replacement character U+FFFD. Surrogate pairs should be
encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE






|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.RS
.PP
The range U+00D800\(enU+00DFFF is reserved for surrogates, which
are illegal on their own. Therefore, such sequences will result in
the replacement character U+FFFD. Surrogate pairs should be
encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE

Changes to doc/ToUpper.3.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" 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_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS

Changes to doc/abstract.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR

Changes to doc/binary.n.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Copyright (c) 2008 by Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|
|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
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

Changes to doc/callback.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
.SH SYNOPSIS
.nf
package require TclOO

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
.SH SYNOPSIS
.nf
package require tcl::oo

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,

Changes to doc/chan.n.

171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
operating system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1a) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.
For output, the end-of-file character is output when the channel is
closed.  If \fIchar\fR is the empty string, then there is no special
end of file character marker.  For read-write channels, a two-element
list specifies the end of file marker for input and output,
respectively.  As a convenience, when setting the end-of-file
character for a read-write channel you can specify a single value that
will apply to both reading and writing.  When querying the end-of-file
character of a read-write channel, a two-element list will always be
returned.  The default value for \fB\-eofchar\fR is the empty string
in all cases except for files under Windows.  In that case the
\fB\-eofchar\fR is Control-z (\ex1a) for reading and the empty string
for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP






|












|







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
operating system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1A) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.
For output, the end-of-file character is output when the channel is
closed.  If \fIchar\fR is the empty string, then there is no special
end of file character marker.  For read-write channels, a two-element
list specifies the end of file marker for input and output,
respectively.  As a convenience, when setting the end-of-file
character for a read-write channel you can specify a single value that
will apply to both reading and writing.  When querying the end-of-file
character of a read-write channel, a two-element list will always be
returned.  The default value for \fB\-eofchar\fR is the empty string
in all cases except for files under Windows.  In that case the
\fB\-eofchar\fR is Control-z (\ex1A) for reading and the empty string
for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP

Changes to doc/class.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::class \- class of all classes
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::class\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::class \- class of all classes
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::class\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR

Changes to doc/classvariable.n.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
.SH SYNOPSIS
.nf
package require TclOO

\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBclassvariable\fR command is available within methods. It takes a series
of one or more variable names and makes them available in the method's scope;






|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
.SH SYNOPSIS
.nf
package require tcl::oo

\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBclassvariable\fR command is available within methods. It takes a series
of one or more variable names and makes them available in the method's scope;

Changes to doc/clock.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\"
.TH "clock" n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
clock \- Obtain and manipulate dates and times
.SH "SYNOPSIS"
package require \fBTcl 8.5\fR
.sp
\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
.sp
\fBclock clicks\fR ?\fI\-option\fR?
.sp
\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
.sp









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'\"
'\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\"
.TH "clock" n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
clock \- Obtain and manipulate dates and times
.SH "SYNOPSIS"
package require \fBTcl 8.5-\fR
.sp
\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR?
.sp
\fBclock clicks\fR ?\fI\-option\fR?
.sp
\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
.sp
947
948
949
950
951
952
953
954
955
956
957
differences and the correct date is given when going from the end
of a long month to a short month.
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
clock, date, time
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:






|



947
948
949
950
951
952
953
954
955
956
957
differences and the correct date is given when going from the end
of a long month to a short month.
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
clock, date, time
.SH "COPYRIGHT"
Copyright \(co 2004 Kevin B. Kenny <[email protected]>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/copy.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::copy \- create copies of objects and classes
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBoo::copy\fR command creates a copy of an object or class. It takes the






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::copy \- create copies of objects and classes
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBoo::copy\fR command creates a copy of an object or class. It takes the

Changes to doc/define.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::define, oo::objdefine \- define and configure classes and objects
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::define\fI class defScript\fR
\fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR?
\fBoo::objdefine\fI object defScript\fR
\fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR?
.fi
.BE






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::define, oo::objdefine \- define and configure classes and objects
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::define\fI class defScript\fR
\fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR?
\fBoo::objdefine\fI object defScript\fR
\fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR?
.fi
.BE

Changes to doc/dict.n.

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
The key rule only matches those key/value pairs whose keys match any
of the given patterns (in the style of \fBstring match\fR.)
.TP
\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR
.
The script rule tests for matching by assigning the key to the
\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
the given script which should return a boolean value (with the
key/value pair only being included in the result of the \fBdict
filter\fR when a true value is returned.)  Note that the first
argument after the rule selection word is a two-element list.  If the
\fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further
key/value pairs are considered for inclusion in the resulting
dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
result. The key/value pairs are tested in the order in which the keys






|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
The key rule only matches those key/value pairs whose keys match any
of the given patterns (in the style of \fBstring match\fR.)
.TP
\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR
.
The script rule tests for matching by assigning the key to the
\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
the given script which should result in a boolean value (with the
key/value pair only being included in the result of the \fBdict
filter\fR when a true value is returned.)  Note that the first
argument after the rule selection word is a two-element list.  If the
\fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further
key/value pairs are considered for inclusion in the resulting
dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
result. The key/value pairs are tested in the order in which the keys

Changes to doc/encoding.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/exec.n.

242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
accept arguments with forward slashes only as option delimiters and
backslashes only in paths.  Any arguments to an application that specify a
path name with forward slashes will not automatically be converted to use
the backslash character.  If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
the program.
.PP
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
names must use the short, cryptic, path format (e.g., using
.QW applba~1.def
instead of
.QW applbakery.default ),
which can be obtained with the
.QW "\fBfile attributes\fI fileName \fB\-shortname\fR"
command.
.PP
Two or more forward or backward slashes in a row in a path refer to a
network path.  For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
\fBc://windows/system\fR (two slashes together), which refers to the mount
point called \fBsystem\fR on the machine called \fBwindows\fR (and the
\fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR,
which describes a directory on the current computer.  The \fBfile join\fR






<
<
<
<
<
<
<
<
<







242
243
244
245
246
247
248









249
250
251
252
253
254
255
accept arguments with forward slashes only as option delimiters and
backslashes only in paths.  Any arguments to an application that specify a
path name with forward slashes will not automatically be converted to use
the backslash character.  If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
the program.
.PP









Two or more forward or backward slashes in a row in a path refer to a
network path.  For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
\fBc://windows/system\fR (two slashes together), which refers to the mount
point called \fBsystem\fR on the machine called \fBwindows\fR (and the
\fBc:/\fR is ignored), and is not equivalent to \fBc:/windows/system\fR,
which describes a directory on the current computer.  The \fBfile join\fR
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
application name, the following directories are automatically searched in
order when attempting to locate the application:
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.
.IP \(bu 3
The Windows NT 32-bit system directory.
.IP \(bu 3
The Windows NT 16-bit system directory.
.IP \(bu 3
The Windows NT home directory.
.IP \(bu 3
The directories listed in the path.
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcmd.exe /c\0\fR"
because built-in commands are not implemented using executables.






|

<
<
|







282
283
284
285
286
287
288
289
290


291
292
293
294
295
296
297
298
application name, the following directories are automatically searched in
order when attempting to locate the application:
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.
.IP \(bu 3
The Windows 32-bit system directory.
.IP \(bu 3


The Windows home directory.
.IP \(bu 3
The directories listed in the path.
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcmd.exe /c\0\fR"
because built-in commands are not implemented using executables.

Changes to doc/expr.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43












44
45
46
47
48
49
50
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <[email protected]>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
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:


|











|



<
|









|












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







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

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 Kevin B. Kenny <[email protected]>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIexpression\fR
.BE
.SH DESCRIPTION
.PP

Evaluates the expression, \fIexpression\fR, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR {8.2 + 6}
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
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 "9.0, TIP 526"
Unlike with prior versions of Tcl, from Tcl 9.0 onwards, the \fBexpr\fR
command only accepts a single argument instead of concatenating an arbitrary
number of arguments to form an expression.
See \fBCOMPATIBILITY WITH TCL 8.*\fR below for details.
.VE "9.0, TIP 526"
.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
.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






|
|
|







89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
.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
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
.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]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary






|






|







275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
.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]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or
.QW \fBe\fR
.PP
. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
of evaluating the expression
.QW "$a + 2*4" .
Enclosing the
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4






|

|






|












|







368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or
.QW \fBe\fR .
.PP
For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SH "PERFORMANCE AND COMPATIBILITY"
.PP
Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
of evaluating the expression
.QW "$a + 2*4" .
Simply enclosing the
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
402
403
404
405
406
407
408
409
410

411
412
413
414
415




416










417
418
419



























420
421
422

423

424
425
426
427


428
429
430
431
432
433
434
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.PP
If it is necessary to include a non-constant expression string within the
wider context of an otherwise-constant expression, the most efficient

technique is to put the varying part inside a recursive \fBexpr\fR, as this at
least allows for the compilation of the outer part, though it does mean that
the varying part must itself be evaluated as a separate expression. Thus, in
this example the result is 20 and the outer expression benefits from fully
cached bytecode compilation.




.PP










.CS
set a 3
set b {$a + 2}



























\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP

In general, you should enclose your expression in braces wherever possible,

and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
namespace) than it is to do complex expression generation.


.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE






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

>
>
>
>
>
>
>
>
>
>



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



>
|
>
|
<
<
|
>
>







413
414
415
416
417
418
419
420
421
422
423

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478


479
480
481
482
483
484
485
486
487
488
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.PP
In general, you should enclose your expression in braces wherever possible,
and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR

namespace) than it is to do complex expression generation. Storing a
complex expression in a variable and using that with \fBexpr\fR is a
case which the bytecode compiler also supports well, provided that
expression is always evaluated in the same stack context (though the
expression could be conveyed across procedure calls and through
\fBuplevel\fR calls in between).
.SS "COMPATIBILITY WITH TCL 8.*"
.PP
.VS "9.0, TIP 526"
In Tcl 8 and older, the \fBexpr\fR command would concatenate multiple
arguments to form the expression; if this behavior is desired in Tcl 9.0
onwards, explicit use of \fBconcat\fR is required (this is also compatible
with earlier versions of Tcl) or a double-quoted argument could be used (as
whitespace is not generally important in expressions). Note that this style of
programming is often a source of bugs, including security bugs, so it is
\fInot recommended\fR. For example, instead of this version (supported in Tcl
8 and before):
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b * 4
.CE
.PP
you might write:
.PP
.CS
# ...
\fBexpr\fR [concat $b * 4]
.CE
.PP
or:
.PP
.CS
# ...
\fBexpr\fR "$b * 4"
.CE
.PP
Both of the above cases substitute \fB$b\fR prior to evaluating the
expression, and do the building of the expression dynamically making it
difficult to avoid compiling the expression on every call to \fBexpr\fR.
.PP
However, some use cases that \fIare\fR supported may be preferable, such as
embedding the use of \fBexpr\fR with a variable argument inside an otherwise
constant expression:
.PP
.CS
# ...
\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP
This changes what value is calculated (in this case, producing \fB20\fR rather
than \fB11\fR) because they force the inner expression to be evaluated
independently of the outer one; such changes may actually fix more bugs than
they cause! Note that this allows the outer expression to be fully compiled,


and enables compilation of the inner expression too (which can be cached in
some cases).
.VE "9.0, TIP 526"
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
481
482
483
484
485
486
487

488

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510

511
.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
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
.SH "SEE ALSO"
array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison, integer value
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff

'\" End:






>

>


















|



>

535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
.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
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
.SH "SEE ALSO"
array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison, integer value
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 Kevin B. Kenny <[email protected]>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/fconfigure.n.

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1a) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.  For
output, the end-of-file character is output when the channel is closed.
If \fIchar\fR is the empty string, then there is no special end of file
character marker.  For read-write channels, a two-element list specifies
the end of file marker for input and output, respectively.  As a
convenience, when setting the end-of-file character for a read-write
channel you can specify a single value that will apply to both reading
and writing.  When querying the end-of-file character of a read-write
channel, a two-element list will always be returned.  The default value
for \fB\-eofchar\fR is the empty string in all cases except for files
under Windows.  In that case the \fB\-eofchar\fR is Control-z (\ex1a) for
reading and the empty string for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.






|











|

|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
system, as returned by \fBencoding system\fR.
.RE
.TP
\fB\-eofchar\fR \fIchar\fR
.TP
\fB\-eofchar\fR \fB{\fIinChar outChar\fB}\fR
.
This option supports DOS file systems that use Control-z (\ex1A) as an
end of file marker.  If \fIchar\fR is not an empty string, then this
character signals end-of-file when it is encountered during input.  For
output, the end-of-file character is output when the channel is closed.
If \fIchar\fR is the empty string, then there is no special end of file
character marker.  For read-write channels, a two-element list specifies
the end of file marker for input and output, respectively.  As a
convenience, when setting the end-of-file character for a read-write
channel you can specify a single value that will apply to both reading
and writing.  When querying the end-of-file character of a read-write
channel, a two-element list will always be returned.  The default value
for \fB\-eofchar\fR is the empty string in all cases except for files
under Windows.  In that case the \fB\-eofchar\fR is Control-z (\ex1A) for
reading and the empty string for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7F;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
.

Changes to doc/file.n.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

53
54


55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
.TP
\fBfile attributes \fIname\fR
.TP
\fBfile attributes \fIname\fR ?\fIoption\fR?
.TP
\fBfile attributes \fIname\fR ?\fIoption value option value...\fR?
.
This subcommand returns or sets platform specific values associated
with a file. The first form returns a list of the platform specific
flags and their values. The second form returns the value for the
specific option. The third form sets one or more of the values. The
values are as follows:
.RS
.PP
On Unix, \fB\-group\fR gets or sets the group name for the file. A group id
can be given to the command, but it returns a group name. \fB\-owner\fR gets
or sets the user name of the owner of the file. The command returns the
owner name, but the numerical id can be passed when setting the
owner. \fB\-permissions\fR sets or retrieves the octal code that chmod(1)

uses.  This command does also has limited support for setting using the
symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],


where multiple symbolic attributes can be separated by commas (example:
\fBu+s,go\-rw\fR add sticky bit for user, remove read and write
permissions for group and other).  A simplified \fBls\fR style string,
of the form rwxrwxrwx (must be 9 characters), is also supported
(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
On versions of Unix supporting file flags, \fB\-readonly\fR gives the
value or sets or clears the readonly attribute of the file,
i.e. the user immutable flag \fBuchg\fR to chflags(1).

.PP
On Windows, \fB\-archive\fR gives the value or sets or clears the
archive attribute of the file. \fB\-hidden\fR gives the value or sets
or clears the hidden attribute of the file. \fB\-longname\fR will
expand each path element to its long version. This attribute cannot be
set. \fB\-readonly\fR gives the value or sets or clears the readonly
attribute of the file. \fB\-shortname\fR gives a string where every






|
|
|
|
|


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







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
.TP
\fBfile attributes \fIname\fR
.TP
\fBfile attributes \fIname\fR ?\fIoption\fR?
.TP
\fBfile attributes \fIname\fR ?\fIoption value option value...\fR?
.
This subcommand returns or sets platform-specific values associated
with a file. The first form returns a list of the platform-specific
options and their values. The second form returns the value for the
given option. The third form sets one or more of the values. The values
are as follows:
.RS
.PP
On Unix, \fB\-group\fR gets or sets the group name for the file. A
group id can be given to the command, but it returns a group name.
\fB\-owner\fR gets or sets the user name of the owner of the file. The
command returns the owner name, but the numerical id can be passed when
setting the owner. \fB\-permissions\fR retrieves or sets a file's
access permissions, using octal notation by default. This option also
provides limited support for setting permissions using the symbolic

notation accepted by the \fBchmod\fR command, following the form
[\fBugo\fR]?[[\fB+-=\fR][\fBrwxst\fR]\fB,\fR[...]]. Multiple permission
specifications may be given, separated by commas. E.g., \fBu+s,go-rw\fR
would set the setuid bit for a file's owner as well as remove read and
write permission for the file's group and other users. An
\fBls\fR-style string of the form \fBrwxrwxrwx\fR is also accepted but
must always be 9 characters long. E.g., \fBrwxr-xr-t\fR is equivalent
to \fB01755\fR. On versions of Unix supporting file flags,
\fB-readonly\fR returns the value of, or sets, or clears the readonly
attribute of a file, i.e., the user immutable flag (\fBuchg\fR) to the
\fBchflags\fR command.
.PP
On Windows, \fB\-archive\fR gives the value or sets or clears the
archive attribute of the file. \fB\-hidden\fR gives the value or sets
or clears the hidden attribute of the file. \fB\-longname\fR will
expand each path element to its long version. This attribute cannot be
set. \fB\-readonly\fR gives the value or sets or clears the readonly
attribute of the file. \fB\-shortname\fR gives a string where every

Changes to doc/filename.n.

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
should choose file names that do not contain special characters like:
\fB<>:?"/\e|\fR.
'\""\" reset emacs highlighting
The safest approach is to use names consisting of
alphanumeric characters only.  Care should be taken with filenames
which contain spaces (common on Windows systems) and
filenames where the backslash is the directory separator (Windows
native path names).  Also Windows 3.1 only supports file
names with a root of no more than 8 characters and an extension of no
more than 3 characters.
.PP
On Windows platforms there are file and path length restrictions.
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
Another Windows peculiarity is that any number of trailing dots
.QW .






|
<
<







146
147
148
149
150
151
152
153


154
155
156
157
158
159
160
should choose file names that do not contain special characters like:
\fB<>:?"/\e|\fR.
'\""\" reset emacs highlighting
The safest approach is to use names consisting of
alphanumeric characters only.  Care should be taken with filenames
which contain spaces (common on Windows systems) and
filenames where the backslash is the directory separator (Windows
native path names).


.PP
On Windows platforms there are file and path length restrictions.
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
Another Windows peculiarity is that any number of trailing dots
.QW .

Changes to doc/fpclassify.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'\"
'\" Copyright (c) 2018 by Kevin B. Kenny <[email protected]>. All rights reserved
'\" Copyright (c) 2019 by Donal Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fpclassify n 8.7 Tcl "Tcl Float Classifier"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fpclassify \- Floating point number classification of Tcl values
.SH SYNOPSIS
package require \fBTcl 8.7\fR
.sp
\fBfpclassify \fIvalue\fR
.BE
.SH DESCRIPTION
The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and
returns one of the following strings that describe it:
.TP
|
|











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'\"
'\" Copyright (c) 2018 Kevin B. Kenny <[email protected]>. All rights reserved
'\" Copyright (c) 2019 Donal Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fpclassify n 8.7 Tcl "Tcl Float Classifier"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fpclassify \- Floating point number classification of Tcl values
.SH SYNOPSIS
package require \fBtcl 8.7\fR
.sp
\fBfpclassify \fIvalue\fR
.BE
.SH DESCRIPTION
The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and
returns one of the following strings that describe it:
.TP
72
73
74
75
76
77
78
79
80
81
82
83
floating point
.SH STANDARDS
This command depends on the \fBfpclassify\fR() C macro conforming to
.QW "ISO C99"
(i.e., to ISO/IEC 9899:1999).
.SH COPYRIGHT
.nf
Copyright \(co 2018 by Kevin B. Kenny <[email protected]>. All rights reserved
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:






|




72
73
74
75
76
77
78
79
80
81
82
83
floating point
.SH STANDARDS
This command depends on the \fBfpclassify\fR() C macro conforming to
.QW "ISO C99"
(i.e., to ISO/IEC 9899:1999).
.SH COPYRIGHT
.nf
Copyright \(co 2018 Kevin B. Kenny <[email protected]>. All rights reserved
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/http.n.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros

|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.9 http "Tcl Bundled Packages"
.so man.macros
74
75
76
77
78
79
80



81
82
83
84
85
86
87
the HTTP operation is done in the background.
\fB::http::geturl\fR returns immediately after generating the
HTTP request and the callback is invoked
when the transaction completes.  For this to work, the Tcl event loop
must be active.  In Tk applications this is always true.  For pure-Tcl
applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.



.SH COMMANDS
.TP
\fB::http::config\fR ?\fIoptions\fR?
.
The \fB::http::config\fR command is used to set and query the name of the
proxy server and port, and the User-Agent name used in the HTTP
requests.  If no options are specified, then the current configuration






>
>
>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
the HTTP operation is done in the background.
\fB::http::geturl\fR returns immediately after generating the
HTTP request and the callback is invoked
when the transaction completes.  For this to work, the Tcl event loop
must be active.  In Tk applications this is always true.  For pure-Tcl
applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.
.PP
\fBNote:\fR The event queue is even used without the \fB-command\fR option.
As a side effect, arbitrary commands may be processed while \fBhttp::geturl\fR is running.
.SH COMMANDS
.TP
\fB::http::config\fR ?\fIoptions\fR?
.
The \fB::http::config\fR command is used to set and query the name of the
proxy server and port, and the User-Agent name used in the HTTP
requests.  If no options are specified, then the current configuration
321
322
323
324
325
326
327



328
329
330
331
332
333
334
335
336
337
Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the
default). Should only be necessary for servers that do not understand or
otherwise complain about HTTP/1.1.
.TP
\fB\-query\fR \fIquery\fR
.
This flag causes \fB::http::geturl\fR to do a POST request that passes the



\fIquery\fR to the server. The \fIquery\fR must be an x-url-encoding
formatted query.  The \fB::http::formatQuery\fR procedure can be used to
do the formatting.
.TP
\fB\-queryblocksize\fR \fIsize\fR
.
The block size used when posting query data to the URL.
At most
\fIsize\fR
bytes are written at once.  After each block, a call to the






>
>
>
|
|
<







324
325
326
327
328
329
330
331
332
333
334
335

336
337
338
339
340
341
342
Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the
default). Should only be necessary for servers that do not understand or
otherwise complain about HTTP/1.1.
.TP
\fB\-query\fR \fIquery\fR
.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
\fIquery\fR as payload verbatim to the server.
The content format (and encoding) of \fIquery\fR is announced by the header
field \fBcontent-type\fR set by the option \fB-type\fR.
\fIquery\fR is an x-url-encoding formatted query, if used for html forms.
The \fB::http::formatQuery\fR procedure can be used to do the formatting.

.TP
\fB\-queryblocksize\fR \fIsize\fR
.
The block size used when posting query data to the URL.
At most
\fIsize\fR
bytes are written at once.  After each block, a call to the
547
548
549
550
551
552
553








554
555
556
557
558
559
560
If the server closes the socket without replying, then no error
is raised, but the status of the transaction will be \fBeof\fR.
.TP
\fBerror\fR
.
The error message will also be stored in the \fBerror\fR status
array element, accessible via \fB::http::error\fR.








.PP
Another error possibility is that \fB::http::geturl\fR is unable to
write all the post query data to the server before the server
responds and closes the socket.
The error message is saved in the \fBposterror\fR status array
element and then  \fB::http::geturl\fR attempts to complete the
transaction.






>
>
>
>
>
>
>
>







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
If the server closes the socket without replying, then no error
is raised, but the status of the transaction will be \fBeof\fR.
.TP
\fBerror\fR
.
The error message will also be stored in the \fBerror\fR status
array element, accessible via \fB::http::error\fR.
.TP
\fBtimeout\fR
.
A timeout occurred before the transaction could complete
.TP
\fBreset\fR
.
user-reset
.PP
Another error possibility is that \fB::http::geturl\fR is unable to
write all the post query data to the server before the server
responds and closes the socket.
The error message is saved in the \fBposterror\fR status array
element and then  \fB::http::geturl\fR attempts to complete the
transaction.
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
\fBposterror\fR
.
The error, if any, that occurred while writing
the post query data to the server.
.TP
\fBstatus\fR
.
Either \fBok\fR, for successful completion, \fBreset\fR for
user-reset, \fBtimeout\fR if a timeout occurred before the transaction
could complete, or \fBerror\fR for an error condition.  During the
transaction this value is the empty string.
.TP
\fBtotalsize\fR
.
A copy of the \fBContent-Length\fR meta-data value.
.TP
\fBtype\fR
.






|
|
<
|







675
676
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691
\fBposterror\fR
.
The error, if any, that occurred while writing
the post query data to the server.
.TP
\fBstatus\fR
.
See description in the chapter \fBERRORS\fR above for a
list and description of \fBstatus\fR.

During the transaction this value is the empty string.
.TP
\fBtotalsize\fR
.
A copy of the \fBContent-Length\fR meta-data value.
.TP
\fBtype\fR
.

Changes to doc/lindex.n.

1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 by Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS


|







1
2
3
4
5
6
7
8
9
10
11
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/link.n.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
.SH SYNOPSIS
.nf
package require TclOO

\fBlink\fR \fImethodName\fR ?\fI...\fR?
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBlink\fR command is available within methods. It takes a series of one






|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
.SH SYNOPSIS
.nf
package require tcl::oo

\fBlink\fR \fImethodName\fR ?\fI...\fR?
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBlink\fR command is available within methods. It takes a series of one

Changes to doc/load.n.

85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100
101
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
This may be done differently on different platforms.
The default guess, which is used on most UNIX platforms, is to
take the last element of \fIfileName\fR, strip off the first
three characters if they are \fBlib\fR, and use any following

alphabetic and underline characters as the module name.
For example, the command \fBload libxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
module name \fBlast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR






|
>

|







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
be specified.
.PP
If \fIpackageName\fR is omitted or specified as an empty string,
Tcl tries to guess the name of the package.
This may be done differently on different platforms.
The default guess, which is used on most UNIX platforms, is to
take the last element of \fIfileName\fR, strip off the first
three characters if they are \fBlib\fR, then strip off the next
three characters if they are \fBtcl\fR, and use any following
alphabetic and underline characters as the module name.
For example, the command \fBload libtclxyz4.2.so\fR uses the module
name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
module name \fBlast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR

Changes to doc/lpop.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2018 by Peter Spjuth.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2018 Peter Spjuth.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/lrepeat.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2003 by Simon Geard.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2003 Simon Geard.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/lreverse.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2006 by Donal K. Fellows.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2006 Donal K. Fellows.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/lset.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 2001 Kevin B. Kenny <[email protected]>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/mathfunc.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <[email protected]>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathfunc \- Mathematical functions for Tcl expressions
.SH SYNOPSIS
package require \fBTcl 8.5\fR
.sp
\fB::tcl::mathfunc::abs\fR \fIarg\fR
.br
\fB::tcl::mathfunc::acos\fR \fIarg\fR
.br
\fB::tcl::mathfunc::asin\fR \fIarg\fR
.br


|











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 Kevin B. Kenny <[email protected]>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathfunc \- Mathematical functions for Tcl expressions
.SH SYNOPSIS
package require \fBTcl 8.5-\fR
.sp
\fB::tcl::mathfunc::abs\fR \fIarg\fR
.br
\fB::tcl::mathfunc::acos\fR \fIarg\fR
.br
\fB::tcl::mathfunc::asin\fR \fIarg\fR
.br
353
354
355
356
357
358
359
360
361
362
363
364
365
are returned as an integer value.
.SH "SEE ALSO"
expr(n), fpclassify(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005, 2006 by Kevin B. Kenny <[email protected]>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:






|





353
354
355
356
357
358
359
360
361
362
363
364
365
are returned as an integer value.
.SH "SEE ALSO"
expr(n), fpclassify(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005-2006 Kevin B. Kenny <[email protected]>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/mathop.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
.\"
.\" Copyright (c) 2006-2007 Donal K. Fellows.
.\"
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
.TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathop \- Mathematical operators as Tcl commands
.SH SYNOPSIS
package require \fBTcl 8.5\fR
.sp
\fB::tcl::mathop::!\fR \fInumber\fR
.br
\fB::tcl::mathop::~\fR \fInumber\fR
.br
\fB::tcl::mathop::+\fR ?\fInumber\fR ...?
.br












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
.\"
.\" Copyright (c) 2006-2007 Donal K. Fellows.
.\"
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
.TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathop \- Mathematical operators as Tcl commands
.SH SYNOPSIS
package require \fBTcl 8.5-\fR
.sp
\fB::tcl::mathop::!\fR \fInumber\fR
.br
\fB::tcl::mathop::~\fR \fInumber\fR
.br
\fB::tcl::mathop::+\fR ?\fInumber\fR ...?
.br

Changes to doc/memory.n.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
memory \- Control Tcl memory debugging capabilities
|
|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans
'\" Copyright (c) 2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
memory \- Control Tcl memory debugging capabilities

Changes to doc/msgcat.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.7\fR
.sp
\fBpackage require msgcat 1.7\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require tcl 8.7\fR
.sp
\fBpackage require msgcat 1.7\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp

Changes to doc/my.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require tcl::oo

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP

Changes to doc/next.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
next, nextto \- invoke superclass method implementations
.SH SYNOPSIS
.nf
package require TclOO

\fBnext\fR ?\fIarg ...\fR?
\fBnextto\fI class\fR ?\fIarg ...\fR?
.fi
.BE

.SH DESCRIPTION






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
next, nextto \- invoke superclass method implementations
.SH SYNOPSIS
.nf
package require tcl::oo

\fBnext\fR ?\fIarg ...\fR?
\fBnextto\fI class\fR ?\fIarg ...\fR?
.fi
.BE

.SH DESCRIPTION

Changes to doc/object.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::object \- root class of the class hierarchy
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::object\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
.fi






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::object \- root class of the class hierarchy
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::object\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
.fi

Changes to doc/packagens.n.

1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
|







1
2
3
4
5
6
7
8
9
'\"
'\" Copyright (c) 1998-2000 Scriptics Corporation.
'\" All rights reserved.
'\"
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME

Changes to doc/re_syntax.n.

133
134
135
136
137
138
139
140


141
142
143
144













145
146
147
148
149
150
151
are met. A constraint may not be followed by a quantifier. The
simple constraints are as follows; some more constraints are described
later, under \fBESCAPES\fR.
.RS 2
.TP 8
\fB^\fR
.
matches at the beginning of a line


.TP
\fB$\fR
.
matches at the end of a line













.TP
\fB(?=\fIre\fB)\fR
.
\fIpositive lookahead\fR (AREs only), matches at any point where a
substring matching \fIre\fR begins
.TP
\fB(?!\fIre\fB)\fR






|
>
>



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







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
are met. A constraint may not be followed by a quantifier. The
simple constraints are as follows; some more constraints are described
later, under \fBESCAPES\fR.
.RS 2
.TP 8
\fB^\fR
.
matches at the beginning of the string or a line (according to whether
matching is newline-sensitive or not, as described in \fBMATCHING\fR,
below).
.TP
\fB$\fR
.
matches at the end of the string or a line (according to whether
matching is newline-sensitive or not, as described in \fBMATCHING\fR,
below).
.RS
.PP
The difference between string and line matching modes is immaterial
when the string does not contain a newline character.  The \fB\eA\fR
and \fB\eZ\fR constraint escapes have a similar purpose but are
always constraints for the overall string.
.PP
The default newline-sensitivity depends on the command that uses the
regular expression, and can be overridden as described in
\fBMETASYNTAX\fR, below.
.RE
.TP
\fB(?=\fIre\fB)\fR
.
\fIpositive lookahead\fR (AREs only), matches at any point where a
substring matching \fIre\fR begins
.TP
\fB(?!\fIre\fB)\fR
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
and \fB=]\fR is an equivalence class, standing for the sequences of
characters of all collating elements equivalent to that one, including
itself. (If there are no other equivalent collating elements, the
treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
For example, if \fBo\fR and \fB\[^o]\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
.QW \fB[[=\[^o]=]]\fR ,
and
.QW \fB[o\[^o]]\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
(\fINote:\fR Tcl implements only the Unicode locale. It does not define any
equivalence classes. The examples above are just illustrations.)
.RE
.SH ESCAPES






|


|

|







304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
and \fB=]\fR is an equivalence class, standing for the sequences of
characters of all collating elements equivalent to that one, including
itself. (If there are no other equivalent collating elements, the
treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
For example, if \fBo\fR and \fB\(^o\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
.QW \fB[[=\(^o=]]\fR ,
and
.QW \fB[o\(^o]\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
(\fINote:\fR Tcl implements only the Unicode locale. It does not define any
equivalence classes. The examples above are just illustrations.)
.RE
.SH ESCAPES

Changes to doc/self.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
self \- method call internal introspection
.SH SYNOPSIS
.nf
package require TclOO

\fBself\fR ?\fIsubcommand\fR?
.fi
.BE
.SH DESCRIPTION
The \fBself\fR command, which should only be used from within the context of a
call to a method (i.e. inside a method, constructor or destructor body) is






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
self \- method call internal introspection
.SH SYNOPSIS
.nf
package require tcl::oo

\fBself\fR ?\fIsubcommand\fR?
.fi
.BE
.SH DESCRIPTION
The \fBself\fR command, which should only be used from within the context of a
call to a method (i.e. inside a method, constructor or destructor body) is

Changes to doc/singleton.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR






|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
.SH SYNOPSIS
.nf
package require tcl::oo

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR

Changes to doc/socket.n.

1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 by Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

|







1
2
3
4
5
6
7
8
9
10
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS

Changes to doc/tclsh.1.

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
the medium, or by the character,
.QW \e032
.PQ \eu001a ", control-Z" .
If this character is present in the file, the \fBtclsh\fR application
will read text up to but not including the character.  An application
that requires this character in the file may safely encode it as
.QW \e032 ,
.QW \ex1a ,
or
.QW \eu001a ;
or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
line, but the script file can always \fBsource\fR it if desired.
.PP






|







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
the medium, or by the character,
.QW \e032
.PQ \eu001a ", control-Z" .
If this character is present in the file, the \fBtclsh\fR application
will read text up to but not including the character.  An application
that requires this character in the file may safely encode it as
.QW \e032 ,
.QW \ex1A ,
or
.QW \eu001a ;
or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
line, but the script file can always \fBsource\fR it if desired.
.PP

Changes to doc/tcltest.n.

1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite main script:
.RS
.PP
.CS
package require Tcl 8.6
package require tcltest 2.5
package require example
\fB::tcltest::configure\fR -testdir \e
        [file dirname [file normalize [info script]]]
eval \fB::tcltest::configure\fR $argv
\fB::tcltest::runAllTests\fR
.CE






<







1175
1176
1177
1178
1179
1180
1181

1182
1183
1184
1185
1186
1187
1188
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite main script:
.RS
.PP
.CS

package require tcltest 2.5
package require example
\fB::tcltest::configure\fR -testdir \e
        [file dirname [file normalize [info script]]]
eval \fB::tcltest::configure\fR $argv
\fB::tcltest::runAllTests\fR
.CE

Changes to doc/zipfs.n.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?






|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require tcl::zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?

Changes to generic/regc_color.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * colorings of characters
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * colorings of characters
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regc_cvec.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * Utility functions for handling cvecs
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * Utility functions for handling cvecs
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regc_lex.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * lexical analyzer
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * lexical analyzer
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
    chr c = (chr)pc;

    switch (c) {
    case CHR('*'):
	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
	    RETV(PLAIN, c);
	}
	RET('*');
	break;
    case CHR('['):
	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
		*(v->now+1) == CHR(':') &&
		(*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
		*(v->now+3) == CHR(':') &&
		*(v->now+4) == CHR(']') &&






|







1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
    chr c = (chr)pc;

    switch (c) {
    case CHR('*'):
	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
	    RETV(PLAIN, c);
	}
	RETV('*', 1);
	break;
    case CHR('['):
	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
		*(v->now+1) == CHR(':') &&
		(*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
		*(v->now+3) == CHR(':') &&
		*(v->now+4) == CHR(']') &&

Changes to generic/regc_locale.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * regc_locale.c --
 *
 *	This file contains the Unicode locale specific regexp routines.
 *	This file is #included by regcomp.c.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/* ASCII character-name table */






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * regc_locale.c --
 *
 *	This file contains the Unicode locale specific regexp routines.
 *	This file is #included by regcomp.c.
 *
 * Copyright © 1998 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/* ASCII character-name table */

Changes to generic/regc_nfa.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * NFA utilities.
 * This file is #included by regcomp.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * NFA utilities.
 * This file is #included by regcomp.c.
 *
 * Copyright © 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regcomp.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * re_*comp and friends - compile REs
 * This file #includes several others (see the bottom).
 *
 * Copyright (c) 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * re_*comp and friends - compile REs
 * This file #includes several others (see the bottom).
 *
 * Copyright © 1998, 1999 Henry Spencer. All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results. The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/rege_dfa.c.

1
2
3
4
5
6
7
8
9
10
11
12
/*
 * DFA routines
 * This file is #included by regexec.c.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without



|







1
2
3
4
5
6
7
8
9
10
11
12
/*
 * DFA routines
 * This file is #included by regexec.c.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regerror.c.

1
2
3
4
5
6
7
8
9
10
11
/*
 * regerror - error-code expansion
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without


|







1
2
3
4
5
6
7
8
9
10
11
/*
 * regerror - error-code expansion
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regexec.c.

1
2
3
4
5
6
7
8
9
10
11
/*
 * re_*exec and friends - match REs
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without


|







1
2
3
4
5
6
7
8
9
10
11
/*
 * re_*exec and friends - match REs
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regfree.c.

1
2
3
4
5
6
7
8
9
10
11
/*
 * regfree - free an RE
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without


|







1
2
3
4
5
6
7
8
9
10
11
/*
 * regfree - free an RE
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/regfronts.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * regcomp and regexec - front ends to re_ routines
 *
 * Mostly for implementation of backward-compatibility kludges. Note that
 * these routines exist ONLY in char versions.
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * regcomp and regexec - front ends to re_ routines
 *
 * Mostly for implementation of backward-compatibility kludges. Note that
 * these routines exist ONLY in char versions.
 *
 * Copyright © 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
 * Corporation, none of whom are responsible for the results.  The author
 * thanks all of them.
 *
 * Redistribution and use in source and binary forms -- with or without

Changes to generic/tcl.decls.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h
#	and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the tcl interface with several sub interfaces:






|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h
#	and tclStubInit.c files.
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001, 2002 Kevin B. Kenny.  All rights reserved.
# Copyright © 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the tcl interface with several sub interfaces:
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
	    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)






|



|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
	    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 {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
}
declare 10 {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
}
declare 32 {
    int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *boolPtr)
}
declare 33 {
    unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)






|







141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
}
declare 32 {
    int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *boolPtr)
}
declare 33 {
    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
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)
}
declare 43 {
    int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *elemListPtr)






|







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
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 *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
declare 43 {
    int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    Tcl_Obj *elemListPtr)
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
declare 166 {
    Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp)
}

# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we include it here for compatibility reasons.

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)






|







612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
declare 166 {
    Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp)
}

# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we include it here for compatibility reasons.

declare 167 {
    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)
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
# 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,






|







1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *TclGetUnicodeFromObj(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,
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
declare 489 {
    void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue)
}
declare 490 {
    Tcl_StatBuf *Tcl_AllocStatBuf(void)
}
declare 491 {
    Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode)
}
declare 492 {
    Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
}

# TIP#91 (back-compat enhancements for channels) dkf
declare 493 {
    Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
	    const Tcl_ChannelType *chanTypePtr)
}






|


|







1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
declare 489 {
    void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue)
}
declare 490 {
    Tcl_StatBuf *Tcl_AllocStatBuf(void)
}
declare 491 {
    long long Tcl_Seek(Tcl_Channel chan, long long offset, int mode)
}
declare 492 {
    long long Tcl_Tell(Tcl_Channel chan)
}

# TIP#91 (back-compat enhancements for channels) dkf
declare 493 {
    Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
	    const Tcl_ChannelType *chanTypePtr)
}
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
}
declare 559 {
    int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value)
}

# TIP #208 ('chan' command) jeffh
declare 560 {
    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
}
declare 561 {
    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
	    const Tcl_ChannelType *chanTypePtr)
}

# TIP#219 (channel reflection api) akupries






|







2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
}
declare 559 {
    int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value)
}

# TIP #208 ('chan' command) jeffh
declare 560 {
    int Tcl_TruncateChannel(Tcl_Channel chan, long long length)
}
declare 561 {
    Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
	    const Tcl_ChannelType *chanTypePtr)
}

# TIP#219 (channel reflection api) akupries
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
declare 594 {
    int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr)
}
declare 595 {
    int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
}
declare 596 {
    Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 597 {
    Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 598 {
    Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 599 {
    Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
}
declare 600 {
    Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
}
declare 601 {
    unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
}

# TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om
declare 602 {






|


|


|


|


|







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
declare 594 {
    int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr)
}
declare 595 {
    int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
}
declare 596 {
    long long Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 597 {
    long long Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 598 {
    long long Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 599 {
    unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
}
declare 600 {
    unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
}
declare 601 {
    unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
}

# TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om
declare 602 {
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
    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,






>
>
>
>
>
>
>
>
>
>
>
















|
<
<
<
<
<
<
<
<




<
<
<
<
<
<
|




>
>
>







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

# TIP #481
declare 651 {
    char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
    unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}

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









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







declare 1 {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, size_t maxPathLen, char *libraryPath)
}
declare 2 {
    void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

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

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

export {
    void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,

Changes to generic/tcl.h.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 * unix/configure.ac	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.ac	(as above)
 * win/tcl.m4		(not patchlevel)
 * 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







<







41
42
43
44
45
46
47

48
49
50
51
52
53
54
 * unix/configure.ac	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.ac	(as above)
 * win/tcl.m4		(not patchlevel)
 * 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)

 */

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

98
99
100
101
102
103
104



105

106
107
108
109
110
111
112
 * 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)






>
>
>
|
>







97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 * 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)
#   if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
#	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
#   else
#	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#   endif
#   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)
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 *
 * Note: when building static but linking dynamically to MSVCRT we must still
 *       correctly decorate the C library imported function.  Use CRTIMPORT
 *       for this purpose.  _DLL is defined by the compiler when linking to
 *       MSVCRT.
 */

#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#   define HAVE_DECLSPEC 1
#   ifdef STATIC_BUILD
#       define DLLIMPORT
#       define DLLEXPORT
#       ifdef _DLL
#           define CRTIMPORT __declspec(dllimport)
#       else
#           define CRTIMPORT






<
|







148
149
150
151
152
153
154

155
156
157
158
159
160
161
162
 *
 * Note: when building static but linking dynamically to MSVCRT we must still
 *       correctly decorate the C library imported function.  Use CRTIMPORT
 *       for this purpose.  _DLL is defined by the compiler when linking to
 *       MSVCRT.
 */


#ifdef _WIN32
#   ifdef STATIC_BUILD
#       define DLLIMPORT
#       define DLLEXPORT
#       ifdef _DLL
#           define CRTIMPORT __declspec(dllimport)
#       else
#           define CRTIMPORT
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295



296

297
298
299
300


301
302
303
304
305
306
307
/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__
#   ifdef __LP64__
#	undef TCL_WIDE_INT_TYPE
#	define TCL_WIDE_INT_IS_LONG 1
#	define TCL_CFG_DO64BIT 1
#    else /* !__LP64__ */
#	define TCL_WIDE_INT_TYPE long long
#	undef TCL_WIDE_INT_IS_LONG
#	undef TCL_CFG_DO64BIT
#    endif /* __LP64__ */
#    undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */








/*
 * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
 * Tcl_WideUInt to be the unsigned variant of that type (assuming that where
 * we have one, we can have the other.)
 *
 * Also defines the following macros:
 * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a
 *	LP64 system such as modern Solaris or Linux ... not including Win64)
 * Tcl_WideAsLong - forgetful converter from wideInt to long.
 * Tcl_LongAsWide - sign-extending converter from long to wideInt.
 * Tcl_WideAsDouble - converter from wideInt to double.
 * Tcl_DoubleAsWide - converter from double to wideInt.
 *
 * The following invariant should hold for any long value 'longVal':
 *	longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
 *
 * Note on converting between Tcl_WideInt and strings. This implementation (in
 * tclObj.c) depends on the function
 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
#      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"
#   else /* ! _WIN32 && ! __GNUC__ */
/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#      include <limits.h>
#      if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
#         define TCL_WIDE_INT_IS_LONG	1
#      endif
#   endif /* _WIN32 */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */

#ifndef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE		long long
#endif /* !TCL_WIDE_INT_TYPE */

typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;

#ifndef TCL_LL_MODIFIER



#   define TCL_LL_MODIFIER	"ll"

#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
#   if defined(__GNUC__) && !defined(_WIN32)
#	define TCL_Z_MODIFIER	"z"


#   else
#	define TCL_Z_MODIFIER	""
#   endif
#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)))






<



<





>
>
>
>
>
>
>
















|
<
<
<
<

|
<
<
<
<
<
<
<
<
<




|
|
|
<
|
|









>
>
>
|
>




>
>







230
231
232
233
234
235
236

237
238
239

240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268




269
270









271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__
#   ifdef __LP64__

#	define TCL_WIDE_INT_IS_LONG 1
#	define TCL_CFG_DO64BIT 1
#    else /* !__LP64__ */

#	undef TCL_WIDE_INT_IS_LONG
#	undef TCL_CFG_DO64BIT
#    endif /* __LP64__ */
#    undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */

/* Cross-compiling 32-bit on a 64-bit platform? Then our
 * configure script does the wrong thing. Correct that here.
 */
#if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__)
#   undef TCL_WIDE_INT_IS_LONG
#endif

/*
 * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
 * Tcl_WideUInt to be the unsigned variant of that type (assuming that where
 * we have one, we can have the other.)
 *
 * Also defines the following macros:
 * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a
 *	LP64 system such as modern Solaris or Linux ... not including Win64)
 * Tcl_WideAsLong - forgetful converter from wideInt to long.
 * Tcl_LongAsWide - sign-extending converter from long to wideInt.
 * Tcl_WideAsDouble - converter from wideInt to double.
 * Tcl_DoubleAsWide - converter from double to wideInt.
 *
 * The following invariant should hold for any long value 'longVal':
 *	longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
 */





#if !defined(TCL_WIDE_INT_TYPE) && !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__GNUC__)









/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#   include <limits.h>
#   if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
#	define TCL_WIDE_INT_IS_LONG	1

#   endif
#endif

#ifndef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE		long long
#endif /* !TCL_WIDE_INT_TYPE */

typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;

#ifndef TCL_LL_MODIFIER
#   if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
#	define TCL_LL_MODIFIER	"I64"
#   else
#	define TCL_LL_MODIFIER	"ll"
#   endif
#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
#   if defined(__GNUC__) && !defined(_WIN32)
#	define TCL_Z_MODIFIER	"z"
#   elif defined(_WIN64)
#	define TCL_Z_MODIFIER	TCL_LL_MODIFIER
#   else
#	define TCL_Z_MODIFIER	""
#   endif
#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)))
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
/*
 * Definition for a number of bytes of buffer space sufficient to hold the
 * string representation of an integer in base 10 (assuming the existence of
 * 64-bit integers).
 */

#define TCL_INTEGER_SPACE	24

/*
 * Flag values passed to Tcl_ConvertElement.
 * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
 *	use backslash quoting instead.
 * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
 *	is safe to leave the hash unquoted when the element is not the first






|







797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
/*
 * Definition for a number of bytes of buffer space sufficient to hold the
 * string representation of an integer in base 10 (assuming the existence of
 * 64-bit integers).
 */

#define TCL_INTEGER_SPACE	(3*(int)sizeof(Tcl_WideInt))

/*
 * Flag values passed to Tcl_ConvertElement.
 * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
 *	use backslash quoting instead.
 * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
 *	is safe to leave the hash unquoted when the element is not the first
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_CHARS		15
#define TCL_LINK_BINARY		16
#define TCL_LINK_READ_ONLY	0x80

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE size_t






|







928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_CHARS		15
#define TCL_LINK_BINARY		16
#define TCL_LINK_READ_ONLY	0x80

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE size_t
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
			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.






|
|









|







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
			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 long long (Tcl_DriverWideSeekProc) (void *instanceData,
			long long 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,
			long long 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.

Changes to generic/tclAlloc.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclAlloc.c --
 *
 *	This is a very fast storage allocator. It allocates blocks of a small
 *	number of different sizes, and keeps free lists of each size. Blocks
 *	that don't exactly fit are passed up to the next larger size. Blocks
 *	over a certain size are directly allocated from the system.
 *
 * Copyright (c) 1983 Regents of the University of California.
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclAlloc.c --
 *
 *	This is a very fast storage allocator. It allocates blocks of a small
 *	number of different sizes, and keeps free lists of each size. Blocks
 *	that don't exactly fit are passed up to the next larger size. Blocks
 *	over a certain size are directly allocated from the system.
 *
 * Copyright © 1983 Regents of the University of California.
 * Copyright © 1996-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#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__)
typedef size_t caddr_t;
#endif

/*
 * The overhead on a block is at least 8 bytes. When free, this space contains
 * a pointer to the next free block, and the bottom two bits must be zero.
 * When in use, the first byte is set to MAGIC, and the second byte is the






|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
#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__)
typedef size_t caddr_t;
#endif

/*
 * The overhead on a block is at least 8 bytes. When free, this space contains
 * a pointer to the next free block, and the bottom two bits must be zero.
 * When in use, the first byte is set to MAGIC, and the second byte is the

Changes to generic/tclAssembly.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclAssembly.c --
 *
 *	Assembler for Tcl bytecodes.
 *
 * This file contains the procedures that convert Tcl Assembly Language (TAL)
 * to a sequence of bytecode instructions for the Tcl execution engine.
 *
 * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
 * Copyright (c) 2010 by Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*-
 *- THINGS TO DO:







|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclAssembly.c --
 *
 *	Assembler for Tcl bytecodes.
 *
 * This file contains the procedures that convert Tcl Assembly Language (TAL)
 * to a sequence of bytecode instructions for the Tcl execution engine.
 *
 * Copyright © 2010 Ozgur Dogan Ugurlu.
 * Copyright © 2010 Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*-
 *- THINGS TO DO:
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(objPtr, &sourceLen);
    TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
    status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
    if (status != TCL_OK) {
	/*
	 * Assembly failed. Clean up and report the error.
	 */
	TclFreeCompileEnv(&compEnv);






|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = Tcl_GetStringFromObj(objPtr, &sourceLen);
    TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
    status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
    if (status != TCL_OK) {
	/*
	 * Assembly failed. Clean up and report the error.
	 */
	TclFreeCompileEnv(&compEnv);
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");






|







1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

	    /*
	     * Assumes that PUSH is the first slot!
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);






|







1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

	    /*
	     * Assumes that PUSH is the first slot!
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
    const char* varNameStr;
    size_t varNameLen;
    int localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return -1;
    }
    varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == -1) {






|







2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
    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 = Tcl_GetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == -1) {

Changes to generic/tclAsync.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclAsync.c --
 *
 *	This file provides low-level support needed to invoke signal handlers
 *	in a safe way. The code here doesn't actually handle signals, though.
 *	This code is based on proposals made by Mark Diekhans and Don Libes.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclAsync.c --
 *
 *	This file provides low-level support needed to invoke signal handlers
 *	in a safe way. The code here doesn't actually handle signals, though.
 *	This code is based on proposals made by Mark Diekhans and Don Libes.
 *
 * Copyright © 1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclBasic.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclBasic.c --
 *
 *	Contains the basic facilities for TCL command interpretation,
 *	including interpreter creation and deletion, command creation and
 *	deletion, and command/script execution.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 Miguel Sofer <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclOOInt.h"






|
|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclBasic.c --
 *
 *	Contains the basic facilities for TCL command interpretation,
 *	including interpreter creation and deletion, command creation and
 *	deletion, and command/script execution.
 *
 * Copyright © 1987-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2001, 2002 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2007 Daniel A. Steffen <[email protected]>
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 * Copyright © 2008 Miguel Sofer <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclOOInt.h"
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137
1138
1139
1140
1141
    /*
     * 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));






>







1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
    /*
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
    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));
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
            message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
        } else {
            length = 0;
        }

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {






|







3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
            message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
        } else {
            length = 0;
        }

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * 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;
    }






|







4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = Tcl_GetStringFromObj(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;
    }
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
	cmdString = TclGetStringFromObj(listPtr, &cmdLen);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
	Tcl_DecrRefCount(listPtr);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    return result;
}







|







4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
	cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
	Tcl_DecrRefCount(listPtr);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    return result;
}

4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
    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.
     */






|







4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
    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 = Tcl_GetStringFromObj(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.
     */
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    size_t length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_DYING)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {






|







4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
    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 = Tcl_GetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_DYING)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

	script = TclGetStringFromObj(objPtr, &numSrcBytes);
	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }






|







5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
	}
	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);
	}

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */






|







6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
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.






|







6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    const char *message = Tcl_GetStringFromObj(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.
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
	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;
		    }
		    bytes++; numBytes--;






|







7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
	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 = Tcl_GetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++; numBytes--;

Changes to generic/tclBinary.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclBinary.c --
 *
 *	This file contains the implementation of the "binary" Tcl built-in
 *	command and the Tcl binary data object.
 *
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516
517
    }
    return baPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
 *
 *	Attempt to get the array of bytes from the Tcl object. If the object
 *	is not already a ByteArray object, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	Pointer to array of bytes representing the ByteArray object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new internal rep.
 *
 *----------------------------------------------------------------------
 */


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







|














>

|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
    }
    return baPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj/TclGetByteArrayFromObj --
 *
 *	Attempt to get the array of bytes from the Tcl object. If the object
 *	is not already a ByteArray object, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	Pointer to array of bytes representing the ByteArray object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new internal rep.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetByteArrayFromObj
unsigned char *
TclGetByteArrayFromObj(
    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);

527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544


























545
546
547
548
549
550
551
    }

    /* 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 --
 *
 *	This procedure changes the length of the byte array for this object.






|
<
<








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







528
529
530
531
532
533
534
535


536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
    }

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


	    *lengthPtr = 0;
	    return NULL;
	} else {
	    *lengthPtr = (int) numBytes;
	}
    }
    return bytes;
}

unsigned char *
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t *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;
    }

    if (lengthPtr) {
	*lengthPtr = numBytes;
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
    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)) {






|







658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = Tcl_GetStringFromObj(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)) {
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') {






|







1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		(void)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') {
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
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
	    unsigned char *bytes;

	    bytes = TclGetByteArrayFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, count);
	    } else {
		memcpy(cursor, bytes, length);
		memset(cursor + length, pad, count - length);
	    }
	    cursor += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);






|



















|







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
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
	    unsigned char *bytes;

	    bytes = Tcl_GetByteArrayFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, count);
	    } else {
		memcpy(cursor, bytes, length);
		memset(cursor + length, pad, count - length);
	    }
	    cursor += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

	    str = Tcl_GetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);






|







1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

	    str = Tcl_GetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);
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
    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) {






|











>
|







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
    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) {
1536
1537
1538
1539
1540
1541
1542

1543
1544
1545
1546







1547
1548
1549
1550
1551
1552
1553
		}
	    }

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






>
|


|
>
>
>
>
>
>
>







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

	    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--;
		}
	    }
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
    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;






|







2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
    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;
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;






|







2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
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
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)TclGetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    if (count > 0) {
	unsigned char *cursor = NULL;

	size = (((count * 4) / 3) + 3) & ~3;	/* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));







|









|







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
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)TclGetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    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));

2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *) TclGetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		size_t numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {






|







2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *) Tcl_GetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		size_t numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
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;

    /*






|







2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
    /*
     * 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;

    /*
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;







|







3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;






|







3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) Tcl_GetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

Changes to generic/tclCkalloc.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclCkalloc.c --
 *
 *    Interface to malloc and free that provides support for debugging
 *    problems involving overwritten, double freeing memory and loss of
 *    memory.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */







|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclCkalloc.c --
 *
 *    Interface to malloc and free that provides support for debugging
 *    problems involving overwritten, double freeing memory and loss of
 *    memory.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */

Changes to generic/tclClock.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclClock.c --
 *
 *	Contains the time and date related commands. This code is derived from
 *	the time and date facilities of TclX, by Mark Diekhans and Karl
 *	Lehenbauer.
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclClock.c --
 *
 *	Contains the time and date related commands. This code is derived from
 *	the time and date facilities of TclX, by Mark Diekhans and Karl
 *	Lehenbauer.
 *
 * Copyright © 1991-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright © 1995 Sun Microsystems, Inc.
 * Copyright © 2004 Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclCmdAH.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters A to H.
 *
 * Copyright (c) 1987-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.
 */

#include "tclInt.h"
#ifdef _WIN32





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclCmdAH.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters A to H.
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
	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.
     */







|







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
	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.
     */

492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

    /*






|







492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
	return TCL_ERROR;
    }

    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = Tcl_GetStringFromObj(data, &length);
    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
    Tcl_SetObjResult(interp,
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

    /*
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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;

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

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    if (objc == 2) {
	objPtr = objv[1];
	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
    } else {
	objPtr = Tcl_ConcatObj(objc-1, objv+1);
	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
    }

    return Tcl_NRExprObj(interp, objPtr, resultPtr);
}

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];

    if (objPtr != NULL) {
	Tcl_DecrRefCount(objPtr);
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}






|
|





<
|
|
<
<
<
<











<
<
<
<
<







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
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);

    objPtr = objv[1];
    TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);





    return Tcl_NRExprObj(interp, objPtr, resultPtr);
}

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];






    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}

Changes to generic/tclCmdIL.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclCmdIL.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters I through L. It
 *	contains only commands in the generic core (i.e., those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"







|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * tclCmdIL.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters I through L. It
 *	contains only commands in the generic core (i.e., those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1993-1997 Lucent Technologies.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2005 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
     * bytecompiled - in that case, the return was a copy of the body's string
     * rep. In order to better isolate the implementation details of the
     * compiler/engine subsystem, we now always return a copy of the string
     * rep. It is important to return a copy so that later manipulations of
     * the object do not invalidate the internal rep.
     */

    bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *






|







541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
     * bytecompiled - in that case, the return was a copy of the body's string
     * rep. In order to better isolate the implementation details of the
     * compiler/engine subsystem, we now always return a copy of the string
     * rep. It is important to return a copy so that later manipulations of
     * the object do not invalidate the internal rep.
     */

    bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) TclGetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {






|







2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) Tcl_GetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
    patObj = objv[objc - 1];
    patternBytes = NULL;
    if (mode == EXACT || mode == SORTED) {
	switch ((enum datatypes) dataType) {
	case ASCII:
	case DICTIONARY:
	    patternBytes = TclGetStringFromObj(patObj, &length);
	    break;
	case INTEGER:
	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
	    if (result != TCL_OK) {
		goto done;
	    }







|







3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
    patObj = objv[objc - 1];
    patternBytes = NULL;
    if (mode == EXACT || mode == SORTED) {
	switch ((enum datatypes) dataType) {
	case ASCII:
	case DICTIONARY:
	    patternBytes = Tcl_GetStringFromObj(patObj, &length);
	    break;
	case INTEGER:
	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
	    if (result != TCL_OK) {
		goto done;
	    }

3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
	     * 1844789]
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	}
    } else {
	patternBytes = TclGetStringFromObj(patObj, &length);
    }

    /*
     * Set default index value to -1, indicating failure; if we find the item
     * in the course of our search, index will be set to the correct value.
     */







|







3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
	     * 1844789]
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	}
    } else {
	patternBytes = Tcl_GetStringFromObj(patObj, &length);
    }

    /*
     * Set default index value to -1, indicating failure; if we find the item
     * in the course of our search, index will be set to the correct value.
     */

3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
	    }

	    switch (mode) {
	    case SORTED:
	    case EXACT:
		switch ((enum datatypes) dataType) {
		case ASCII:
		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {






|







3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
	    }

	    switch (mode) {
	    case SORTED:
	    case EXACT:
		switch ((enum datatypes) dataType) {
		case ASCII:
		    bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {

Changes to generic/tclCmdMZ.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters M to Z. It
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003-2009 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"







|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters M to Z. It
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright © 1987-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2003-2009 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.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
/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
	"\x09\x0a\x0b\x0c\x0d " /* ASCII */
	"\xc0\x80" /*     nul (U+0000) */
	"\xc2\x85" /*     next line (U+0085) */
	"\xc2\xa0" /*     non-breaking space (U+00a0) */
	"\xe1\x9a\x80" /* ogham space mark (U+1680) */
	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
	"\xe2\x80\x80" /* en quad (U+2000) */
	"\xe2\x80\x81" /* em quad (U+2001) */
	"\xe2\x80\x82" /* en space (U+2002) */
	"\xe2\x80\x83" /* em space (U+2003) */
	"\xe2\x80\x84" /* three-per-em space (U+2004) */
	"\xe2\x80\x85" /* four-per-em space (U+2005) */
	"\xe2\x80\x86" /* six-per-em space (U+2006) */
	"\xe2\x80\x87" /* figure space (U+2007) */
	"\xe2\x80\x88" /* punctuation space (U+2008) */
	"\xe2\x80\x89" /* thin space (U+2009) */
	"\xe2\x80\x8a" /* hair space (U+200a) */
	"\xe2\x80\x8b" /* zero width space (U+200b) */
	"\xe2\x80\xa8" /* line separator (U+2028) */
	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
	"\xe2\x81\xa0" /* word joiner (U+2060) */
	"\xe3\x80\x80" /* ideographic space (U+3000) */
	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PwdObjCmd --
 *






|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
	"\x09\x0A\x0B\x0C\x0D " /* ASCII */
	"\xC0\x80" /*     nul (U+0000) */
	"\xC2\x85" /*     next line (U+0085) */
	"\xC2\xA0" /*     non-breaking space (U+00a0) */
	"\xE1\x9A\x80" /* ogham space mark (U+1680) */
	"\xE1\xA0\x8E" /* mongolian vowel separator (U+180e) */
	"\xE2\x80\x80" /* en quad (U+2000) */
	"\xE2\x80\x81" /* em quad (U+2001) */
	"\xE2\x80\x82" /* en space (U+2002) */
	"\xE2\x80\x83" /* em space (U+2003) */
	"\xE2\x80\x84" /* three-per-em space (U+2004) */
	"\xE2\x80\x85" /* four-per-em space (U+2005) */
	"\xE2\x80\x86" /* six-per-em space (U+2006) */
	"\xE2\x80\x87" /* figure space (U+2007) */
	"\xE2\x80\x88" /* punctuation space (U+2008) */
	"\xE2\x80\x89" /* thin space (U+2009) */
	"\xE2\x80\x8A" /* hair space (U+200a) */
	"\xE2\x80\x8B" /* zero width space (U+200b) */
	"\xE2\x80\xA8" /* line separator (U+2028) */
	"\xE2\x80\xA9" /* paragraph separator (U+2029) */
	"\xE2\x80\xAF" /* narrow no-break space (U+202f) */
	"\xE2\x81\x9F" /* medium mathematical space (U+205f) */
	"\xE2\x81\xA0" /* word joiner (U+2060) */
	"\xE3\x80\x80" /* ideographic space (U+3000) */
	"\xEF\xBB\xBF" /* zero width no-break space (U+feff) */
;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PwdObjCmd --
 *
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
	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.






|
|
|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
	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 = 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.
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






|






|







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 = 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
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
	    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






|







823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
	    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
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    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.
	 */






|





|







1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
    size_t splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

    stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
    end = stringPtr + stringLen;
    listPtr = Tcl_NewObj();

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
    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;






|







1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if (!TclHasIntRep(objPtr, &tclBooleanType)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = Tcl_GetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if ((objPtr->internalRep.wideValue != 0)
		? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
	    result = 0;
	}
	break;
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;






|







1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
	break;
    case STR_IS_DOUBLE: {
	if (TclHasIntRep(objPtr, &tclDoubleType) ||
		TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;






|







1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
	break;
    case STR_IS_DOUBLE: {
	if (TclHasIntRep(objPtr, &tclDoubleType) ||
		TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;






|







1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	result = 0;






|







1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	result = 0;
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
	     */

	    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) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;






|







1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
	     */

	    const char *elemStart, *nextElem;
	    size_t lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = Tcl_GetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
	break;
    case STR_IS_XDIGIT:
	chcomp = UniCharIsHexDigit;
	break;
    }

    if (chcomp != NULL) {
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;






|







1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
	break;
    case STR_IS_XDIGIT:
	chcomp = UniCharIsHexDigit;
	break;
    }

    if (chcomp != NULL) {
	string1 = Tcl_GetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));






|







1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	const char *string = Tcl_GetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
    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;
    }






|







2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
    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;
    }
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
	 * 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) {






|








|







2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
	 * larger strings.
	 */

	size_t mapLen;
	int 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,
				length2) == 0)) {
		    if (p != ustring1) {
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
	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) {






|







2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
	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] = 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) {
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
    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(
		    "bad option \"%s\": must be -nocase", string));






|







2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
    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 = Tcl_GetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
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
StringStartCmd(
    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;
	}
    }






|
|







|
<
|


<
|
|



|

|


|





|


|







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
StringStartCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const Tcl_UniChar *p, *string;
    size_t cur, index, length;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = Tcl_GetUnicodeFromObj(objv[1], &length);

    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index + 1 >= length + 1) {
	index = length - 1;
    }
    cur = 0;
    if (index + 1 > 1) {
	p = &string[index];

	(void)TclUniCharToUCS4(p, &ch);
	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
	    int delta = 0;
	    const Tcl_UniChar *next;

	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }

	    next = TclUCS4Prev(p, string);
	    do {
		next += delta;
		delta = TclUniCharToUCS4(next, &ch);
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }
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
StringEndCmd(
    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;
}

/*






|
|







|
<
|


<



|
|


|








|







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
StringEndCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    const Tcl_UniChar *p, *end, *string;
    size_t cur, index, length;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = Tcl_GetUnicodeFromObj(objv[1], &length);

    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
    if (index + 1 <= length + 1) {
	p = &string[index];
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUniCharToUCS4(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = length;
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }






|







2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }






|







2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string = Tcl_GetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
    size_t length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *






|







2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
    size_t length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    (void) Tcl_GetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
    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);






|







2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = Tcl_GetStringFromObj(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);
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
	    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);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));






|







2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
    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);






|







3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = Tcl_GetStringFromObj(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);
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
	    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);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));






|







3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
    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);






|







3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
    char *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = Tcl_GetStringFromObj(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);
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
	    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);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));






|







3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
	    last = length1;
	}
	if (last + 1 < first + 1) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = Tcl_GetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
    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 {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}






|







|







3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
    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 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
    return TCL_OK;
}
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
    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 {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimLeft(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
    return TCL_OK;
}







|







|







3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    trim = TclTrimLeft(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
    return TCL_OK;
}

3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
    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 {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimRight(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}







|







|







3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;

    if (objc == 3) {
	string2 = Tcl_GetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = Tcl_GetStringFromObj(objv[1], &length1);

    trim = TclTrimRight(string1, length1, string2, length2);

    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}

3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

	pattern = TclGetStringFromObj(objv[i], &patternLength);

	if ((i == objc - 2) && (*pattern == 'd')
		&& (strcmp(pattern, "default") == 0)) {
	    Tcl_Obj *emptyObj = NULL;

	    /*
	     * If either indexVarObj or matchVarObj are non-NULL, we're in






|







3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

	pattern = Tcl_GetStringFromObj(objv[i], &patternLength);

	if ((i == objc - 2) && (*pattern == 'd')
		&& (strcmp(pattern, "default") == 0)) {
	    Tcl_Obj *emptyObj = NULL;

	    /*
	     * If either indexVarObj or matchVarObj are non-NULL, we're in

Changes to generic/tclCompCmds.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands into a sequence of instructions ("bytecodes").
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"





|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands into a sequence of instructions ("bytecodes").
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
	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.






|







892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
	const char *bytes;
	int len;
	size_t slen;

	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = Tcl_GetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);
	return TCL_OK;
    }

    /*
     * General case: runtime concat.
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
	Tcl_DecrRefCount(valueObj);
    }

    /*
     * We did! Excellent. The "verifyDict" is to do type forcing.
     */

    bytes = TclGetStringFromObj(dictObj, &len);
    PushLiteral(envPtr, bytes, len);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Tcl_DecrRefCount(dictObj);
    return TCL_OK;

    /*






|







1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
	Tcl_DecrRefCount(valueObj);
    }

    /*
     * We did! Excellent. The "verifyDict" is to do type forcing.
     */

    bytes = Tcl_GetStringFromObj(dictObj, &len);
    PushLiteral(envPtr, bytes, len);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Tcl_DecrRefCount(dictObj);
    return TCL_OK;

    /*
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;

    if (parsePtr->numWords == 1) {
	return TCL_ERROR;
    }

    /*
     * TIP #280: Use the per-word line information of the current command.
     */







|







2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * TIP #280: Use the per-word line information of the current command.
     */

2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
	    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;
	}






|







2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int varIndex;
	    size_t length;


	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = Tcl_GetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
    }

    /*
     * Not an error, always a constant result, so just push the result as a
     * literal. Job done.
     */

    bytes = TclGetStringFromObj(tmpObj, &len);
    PushLiteral(envPtr, bytes, len);
    Tcl_DecrRefCount(tmpObj);
    return TCL_OK;

  checkForStringConcatCase:
    /*
     * See if we can generate a sequence of things to concatenate. This






|







3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
    }

    /*
     * Not an error, always a constant result, so just push the result as a
     * literal. Job done.
     */

    bytes = Tcl_GetStringFromObj(tmpObj, &len);
    PushLiteral(envPtr, bytes, len);
    Tcl_DecrRefCount(tmpObj);
    return TCL_OK;

  checkForStringConcatCase:
    /*
     * See if we can generate a sequence of things to concatenate. This
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
		const char *b = TclGetStringFromObj(tmpObj, &len);

		/*
		 * If there is a non-empty literal from the format string,
		 * push it and reset.
		 */

		if (len > 0) {






|







3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
		const char *b = Tcl_GetStringFromObj(tmpObj, &len);

		/*
		 * If there is a non-empty literal from the format string,
		 * push it and reset.
		 */

		if (len > 0) {
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
    }

    /*
     * Handle the case of a trailing literal.
     */

    Tcl_AppendToObj(tmpObj, start, bytes - start);
    bytes = TclGetStringFromObj(tmpObj, &len);
    if (len > 0) {
	PushLiteral(envPtr, bytes, len);
	i++;
    }
    Tcl_DecrRefCount(tmpObj);
    Tcl_DecrRefCount(formatObj);







|







3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
    }

    /*
     * Handle the case of a trailing literal.
     */

    Tcl_AppendToObj(tmpObj, start, bytes - start);
    bytes = Tcl_GetStringFromObj(tmpObj, &len);
    if (len > 0) {
	PushLiteral(envPtr, bytes, len);
	i++;
    }
    Tcl_DecrRefCount(tmpObj);
    Tcl_DecrRefCount(formatObj);

Changes to generic/tclCompCmdsGR.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclCompCmdsGR.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 'g' through 'r') into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"






|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclCompCmdsGR.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 'g' through 'r') into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
    }

    /*
     * Next, higher-level checks. Is the RE a very simple glob? Is the
     * replacement "simple"?
     */

    bytes = TclGetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;






|







2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
    }

    /*
     * Next, higher-level checks. Is the RE a very simple glob? Is the
     * replacement "simple"?
     */

    bytes = Tcl_GetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

    result = TCL_OK;
    bytes = Tcl_DStringValue(&pattern) + 1;
    PushLiteral(envPtr,	bytes, len);
    bytes = TclGetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {






|







2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

    result = TCL_OK;
    bytes = Tcl_DStringValue(&pattern) + 1;
    PushLiteral(envPtr,	bytes, len);
    bytes = Tcl_GetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
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);
}






|







2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    size_t numBytes;
    const char *bytes = Tcl_GetStringFromObj(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);
}
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */







|







2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = Tcl_GetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */

Changes to generic/tclCompCmdsSZ.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclCompCmdsSZ.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 's' through 'z', except for
 *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
 *	Also includes the operator command compilers.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2010 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"







|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclCompCmdsSZ.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 's' through 'z', except for
 *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
 *	Also includes the operator command compilers.
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 * Copyright © 2002 ActiveState Corporation.
 * Copyright © 2004-2010 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		size_t len;
		const char *bytes = TclGetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
	    numArgs ++;
	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	size_t len;
	const char *bytes = TclGetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
    if (numArgs > 1) {






|

















|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		size_t len;
		const char *bytes = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
    if (numArgs > 1) {
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
    /*
     * 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;
}






|




|







947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
    /*
     * 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 = Tcl_GetStringFromObj(objv[0], &slen);
    if (slen == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, slen);
	bytes = Tcl_GetStringFromObj(objv[1], &slen);
	PushLiteral(envPtr, bytes, slen);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}
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
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		size_t len;
		const char *varname = TclGetStringFromObj(objv[0], &len);

		resultVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (resultVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
		resultVarIndices[i] = -1;
	    }
	    if (objc == 2) {
		size_t len;
		const char *varname = TclGetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {






|











|







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
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		size_t len;
		const char *varname = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
	     */

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






|







3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = Tcl_GetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
	     */

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






|







3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = Tcl_GetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    size_t len;

	    bytes = TclGetStringFromObj(leadingWord, &len);
	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
		flags = 0;
		haveFlags++;
	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
		haveFlags++;
	    } else {
		varCount++;






|







3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    size_t len;

	    bytes = Tcl_GetStringFromObj(leadingWord, &len);
	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
		flags = 0;
		haveFlags++;
	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
		haveFlags++;
	    } else {
		varCount++;

Changes to generic/tclCompExpr.c.

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 */
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 *) 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;
704
705
706
707
708
709
710




711
712
713
714
715
716
717
	 * 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\"",






>
>
>
>







707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
	 * 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\"",
			(int)scanned, start);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
738
739
740
741
742
743
744


























745
746
747
748
749
750
751
		     * 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,






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







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






|













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







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
    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;
    int ch;
    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.
	 */
	size_t size;

	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;
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
     * 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';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {






|
|

|



|







2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
     * 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 (TclUCS4Complete(start, numBytes)) {
	    scanned = TclUtfToUCS4(start, &ch);
	} else {
	    char utfBytes[8];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUCS4(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
	    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,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
		Tcl_DStringFree(&cmdName);







|







2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		size_t length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		p = Tcl_GetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
		Tcl_DStringFree(&cmdName);

2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
	    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 idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *






|







2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		size_t length;
		const char *bytes = Tcl_GetStringFromObj(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:
		     *
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			size_t numBytes;
			const char *bytes
				= TclGetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.






|







2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			size_t 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.

Changes to generic/tclCompile.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts of
 *	commands (like quoted strings or nested sub-commands) into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclCompile.c --
 *
 *	This file contains procedures that compile Tcl commands or parts of
 *	commands (like quoted strings or nested sub-commands) into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
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.
     */







|







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

1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
	    Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	size_t numBytes;
	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);






|







1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
	    Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	size_t numBytes;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
    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);
}






|







1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
    size_t length;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = Tcl_GetStringFromObj(cmdObj, &length);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);

    if (cmdPtr && TclRoutineHasName(cmdPtr)) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
	     *
	     * 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;
	}






|







2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
	     *
	     * 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 = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
	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;
    }






|







3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
	if (!cachePtr || !name) {
	    return -1;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = Tcl_GetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return -1;
    }

Changes to generic/tclConfig.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclConfig.c --
 *
 *	This file provides the facilities which allow Tcl and other packages
 *	to embed configuration information into their binary libraries.
 *
 * Copyright (c) 2002 Andreas Kupries <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclConfig.c --
 *
 *	This file provides the facilities which allow Tcl and other packages
 *	to embed configuration information into their binary libraries.
 *
 * Copyright © 2002 Andreas Kupries <[email protected]>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
		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:






|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
		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:

Changes to generic/tclDate.c.

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"






|







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

Changes to generic/tclDecls.h.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif /* MACOSX */
/* 11 */
EXTERN void		Tcl_SetTimer(const Tcl_Time *timePtr);
/* 12 */
EXTERN void		Tcl_Sleep(int ms);
/* 13 */
EXTERN int		Tcl_WaitForEvent(const Tcl_Time *timePtr);
/* 14 */






<



<
<
<
<
<
<
<


<
<
<
<
<







68
69
70
71
72
73
74

75
76
77







78
79





80
81
82
83
84
85
86
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);

/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);







/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);





/* 11 */
EXTERN void		Tcl_SetTimer(const Tcl_Time *timePtr);
/* 12 */
EXTERN void		Tcl_Sleep(int ms);
/* 13 */
EXTERN int		Tcl_WaitForEvent(const Tcl_Time *timePtr);
/* 14 */
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
/* 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);
/* 44 */
EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,






|




















|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
/* 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 *	TclGetByteArrayFromObj(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 *		TclGetStringFromObj(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);
/* 44 */
EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
				Tcl_Interp *childInterp);
/* 164 */
EXTERN Tcl_Interp *	Tcl_GetParent(Tcl_Interp *interp);
/* 165 */
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 */






<




<
<
<
<
<
<
<







472
473
474
475
476
477
478

479
480
481
482







483
484
485
486
487
488
489
				Tcl_Interp *childInterp);
/* 164 */
EXTERN Tcl_Interp *	Tcl_GetParent(Tcl_Interp *interp);
/* 165 */
EXTERN const char *	Tcl_GetNameOfExecutable(void);
/* 166 */
EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);

/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);







/* 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 */
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
				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,






|
<







1122
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
				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 *	TclGetUnicodeFromObj(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,
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
/* 489 */
EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
				Tcl_WideInt wideValue);
/* 490 */
EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
/* 491 */
EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
				int mode);
/* 492 */
EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
/* 493 */
EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
				const Tcl_ChannelType *chanTypePtr);
/* 494 */
EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
/* 495 */






|


|







1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
/* 489 */
EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
				Tcl_WideInt wideValue);
/* 490 */
EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
/* 491 */
EXTERN long long	Tcl_Seek(Tcl_Channel chan, long long offset,
				int mode);
/* 492 */
EXTERN long long	Tcl_Tell(Tcl_Channel chan);
/* 493 */
EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
				const Tcl_ChannelType *chanTypePtr);
/* 494 */
EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
/* 495 */
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
/* 559 */
EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
/* 560 */
EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
				Tcl_WideInt length);
/* 561 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
				const Tcl_ChannelType *chanTypePtr);
/* 562 */
EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
				Tcl_Obj *msg);
/* 563 */






|







1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
/* 559 */
EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
/* 560 */
EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
				long long length);
/* 561 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
				const Tcl_ChannelType *chanTypePtr);
/* 562 */
EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
				Tcl_Obj *msg);
/* 563 */
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
/* 593 */
EXTERN int		Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
/* 594 */
EXTERN int		Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
/* 595 */
EXTERN int		Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
/* 596 */
EXTERN Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
				const Tcl_StatBuf *statPtr);
/* 598 */
EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
EXTERN Tcl_WideUInt	Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
/* 601 */
EXTERN unsigned		Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
/* 602 */
EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,






|

|


|

|

|







1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
/* 593 */
EXTERN int		Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
/* 594 */
EXTERN int		Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
/* 595 */
EXTERN int		Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
/* 596 */
EXTERN long long	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
EXTERN long long	Tcl_GetModificationTimeFromStat(
				const Tcl_StatBuf *statPtr);
/* 598 */
EXTERN long long	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
EXTERN unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
EXTERN unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
/* 601 */
EXTERN unsigned		Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
/* 602 */
EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
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
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 */






>
>
>
>
>
>
>
>
>
>
>




















<

<
<
<
<
<
<
<
<

<
<
<
<
<
<
<







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
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);
/* Slot 649 is reserved */
/* Slot 650 is reserved */
/* 651 */
EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 652 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 653 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
				size_t *lengthPtr);

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

    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */








    void (*tcl_DeleteFileHandler) (int fd); /* 10 */







    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 */
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
    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 */






|







|







1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
    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 * (*tclGetByteArrayFromObj) (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 * (*tclGetStringFromObj) (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 */
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
    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);






<

<
<
<
<
<
<
<







1914
1915
1916
1917
1918
1919
1920

1921







1922
1923
1924
1925
1926
1927
1928
    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 */

    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */







    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);
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
    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 */






|







2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
    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 * (*tclGetUnicodeFromObj) (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 */
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
    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 */
    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
    int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */






|
|







2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
    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 */
    long long (*tcl_Seek) (Tcl_Channel chan, long long offset, int mode); /* 491 */
    long long (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
    int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
    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 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */
    void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
    void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
    void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */
    void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */
    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */
    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */






|







2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
    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, long long length); /* 560 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */
    void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
    void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
    void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */
    void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */
    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */
    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
    unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
    unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
    unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
    int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
    int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
    int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
    int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
    Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
    Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
    Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
    Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
    Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
    unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
    int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
    int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */






|
|
|
|
|







2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
    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 */
    long long (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
    long long (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
    long long (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
    unsigned long long (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
    unsigned long long (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
    unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
    int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
    int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */
2431
2432
2433
2434
2435
2436
2437





2438
2439
2440
2441
2442
2443
2444
    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






>
>
>
>
>







2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 648 */
    void (*reserved649)(void);
    void (*reserved650)(void);
    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
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
	(tclStubsPtr->tcl_Realloc) /* 5 */
#define Tcl_DbCkalloc \
	(tclStubsPtr->tcl_DbCkalloc) /* 6 */
#define Tcl_DbCkfree \
	(tclStubsPtr->tcl_DbCkfree) /* 7 */
#define Tcl_DbCkrealloc \
	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif /* MACOSX */
#define Tcl_SetTimer \
	(tclStubsPtr->tcl_SetTimer) /* 11 */
#define Tcl_Sleep \
	(tclStubsPtr->tcl_Sleep) /* 12 */
#define Tcl_WaitForEvent \
	(tclStubsPtr->tcl_WaitForEvent) /* 13 */
#define Tcl_AppendAllObjTypes \






<


<
<
<
<
<
<


<
<
<
<
<







2433
2434
2435
2436
2437
2438
2439

2440
2441






2442
2443





2444
2445
2446
2447
2448
2449
2450
	(tclStubsPtr->tcl_Realloc) /* 5 */
#define Tcl_DbCkalloc \
	(tclStubsPtr->tcl_DbCkalloc) /* 6 */
#define Tcl_DbCkfree \
	(tclStubsPtr->tcl_DbCkfree) /* 7 */
#define Tcl_DbCkrealloc \
	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */

#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */






#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */





#define Tcl_SetTimer \
	(tclStubsPtr->tcl_SetTimer) /* 11 */
#define Tcl_Sleep \
	(tclStubsPtr->tcl_Sleep) /* 12 */
#define Tcl_WaitForEvent \
	(tclStubsPtr->tcl_WaitForEvent) /* 13 */
#define Tcl_AppendAllObjTypes \
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
	(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 \
	(tclStubsPtr->tcl_GetObjType) /* 40 */
#define Tcl_GetStringFromObj \
	(tclStubsPtr->tcl_GetStringFromObj) /* 41 */
#define Tcl_InvalidateStringRep \
	(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
#define Tcl_ListObjAppendList \
	(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
#define Tcl_ListObjAppendElement \
	(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
#define Tcl_ListObjGetElements \






|
|













|
|







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
	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#define TclFreeObj \
	(tclStubsPtr->tclFreeObj) /* 30 */
#define Tcl_GetBoolean \
	(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#define TclGetByteArrayFromObj \
	(tclStubsPtr->tclGetByteArrayFromObj) /* 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 \
	(tclStubsPtr->tcl_GetObjType) /* 40 */
#define TclGetStringFromObj \
	(tclStubsPtr->tclGetStringFromObj) /* 41 */
#define Tcl_InvalidateStringRep \
	(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
#define Tcl_ListObjAppendList \
	(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
#define Tcl_ListObjAppendElement \
	(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
#define Tcl_ListObjGetElements \
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
	(tclStubsPtr->tcl_GetInterpPath) /* 163 */
#define Tcl_GetParent \
	(tclStubsPtr->tcl_GetParent) /* 164 */
#define Tcl_GetNameOfExecutable \
	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
	(tclStubsPtr->tcl_GetObjResult) /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif /* MACOSX */
#define Tcl_GetPathType \
	(tclStubsPtr->tcl_GetPathType) /* 168 */
#define Tcl_Gets \
	(tclStubsPtr->tcl_Gets) /* 169 */
#define Tcl_GetsObj \
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \






<


<
<
<
<
<







2730
2731
2732
2733
2734
2735
2736

2737
2738





2739
2740
2741
2742
2743
2744
2745
	(tclStubsPtr->tcl_GetInterpPath) /* 163 */
#define Tcl_GetParent \
	(tclStubsPtr->tcl_GetParent) /* 164 */
#define Tcl_GetNameOfExecutable \
	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#define Tcl_GetObjResult \
	(tclStubsPtr->tcl_GetObjResult) /* 166 */

#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */





#define Tcl_GetPathType \
	(tclStubsPtr->tcl_GetPathType) /* 168 */
#define Tcl_Gets \
	(tclStubsPtr->tcl_Gets) /* 169 */
#define Tcl_GetsObj \
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#define Tcl_GetServiceMode \
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
	(tclStubsPtr->tcl_AttemptRealloc) /* 430 */
#define Tcl_AttemptDbCkrealloc \
	(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 \






|
|







3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
	(tclStubsPtr->tcl_AttemptRealloc) /* 430 */
#define Tcl_AttemptDbCkrealloc \
	(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
#define Tcl_AttemptSetObjLength \
	(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
#define Tcl_GetChannelThread \
	(tclStubsPtr->tcl_GetChannelThread) /* 433 */
#define TclGetUnicodeFromObj \
	(tclStubsPtr->tclGetUnicodeFromObj) /* 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 \
3697
3698
3699
3700
3701
3702
3703








3704
3705
3706
3707
3708
3709
3710
	(tclStubsPtr->tcl_GetIntForIndex) /* 645 */
#define Tcl_UtfToUniChar \
	(tclStubsPtr->tcl_UtfToUniChar) /* 646 */
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */









#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp






>
>
>
>
>
>
>
>







3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
	(tclStubsPtr->tcl_GetIntForIndex) /* 645 */
#define Tcl_UtfToUniChar \
	(tclStubsPtr->tcl_UtfToUniChar) /* 646 */
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */
/* Slot 649 is reserved */
/* Slot 650 is reserved */
#define Tcl_GetStringFromObj \
	(tclStubsPtr->tcl_GetStringFromObj) /* 651 */
#define Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 652 */
#define Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 653 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
3817
3818
3819
3820
3821
3822
3823

























3824
3825
3826
3827
3828
3829
3830
	    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) \






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







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
	    int intValue;
	    int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
#   endif
#endif

#undef Tcl_GetString
#undef Tcl_GetUnicode
#define Tcl_GetString(objPtr) \
	Tcl_GetStringFromObj(objPtr, (size_t *)NULL)
#define Tcl_GetUnicode(objPtr) \
	Tcl_GetUnicodeFromObj(objPtr, (size_t *)NULL)
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef Tcl_GetByteArrayFromObj
#if defined(USE_TCL_STUBS)
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)sizePtr))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)sizePtr))
#else
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (TclGetStringFromObj)(objPtr, (int *)sizePtr) : (Tcl_GetStringFromObj)(objPtr, (size_t *)sizePtr))
#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (TclGetByteArrayFromObj)(objPtr, (int *)sizePtr) : Tcl_GetByteArrayFromObj(objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
	(sizeof(*sizePtr) <= sizeof(int) ? (TclGetUnicodeFromObj)(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj(objPtr, (size_t *)sizePtr))
#endif

#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
#   define Tcl_Free(x) \
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
#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






<







3826
3827
3828
3829
3830
3831
3832

3833
3834
3835
3836
3837
3838
3839
#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_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

Changes to generic/tclDictObj.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 *
 * Copyright (c) 2002-2010 by Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 *
 * Copyright © 2002-2010 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	/*
	 * 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.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	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);






|



|













|





|







524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
	/*
	 * 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 = Tcl_GetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = Tcl_GetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = Tcl_GetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = Tcl_GetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
		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;






|







628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
		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 = Tcl_GetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    size_t elemSize;
	    int literal;

Changes to generic/tclDisassemble.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclDisassemble.c --
 *
 *	This file contains procedures that disassemble bytecode into either
 *	human-readable or Tcl-processable forms.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2013-2016 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"





|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclDisassemble.c --
 *
 *	This file contains procedures that disassemble bytecode into either
 *	human-readable or Tcl-processable forms.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2013-2016 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    size_t length;

    bytes = TclGetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --






|







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
    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 = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }






|







649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }

Changes to generic/tclEncoding.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclEncoding.c --
 *
 *	Contains the implementation of the encoding conversion package.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

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
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    } else {
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);


	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }






|











<
<


>
>







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
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    } else {


		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }
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:
 */






|












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 = Tcl_GetStringFromObj(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:
 */

Changes to generic/tclEnsemble.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclEnsemble.c --
 *
 *	Contains support for ensembles (see TIP#112), which provide simple
 *	mechanism for creating composite commands on top of namespaces.
 *
 * Copyright (c) 2005-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclEnsemble.c --
 *
 *	Contains support for ensembles (see TIP#112), which provide simple
 *	mechanism for creating composite commands on top of namespaces.
 *
 * Copyright © 2005-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	size_t stringLength, i;
	size_t tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {






|







1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
				 * 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 = Tcl_GetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
	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) {






|







2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
	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 = Tcl_GetStringFromObj(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) {
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
     * 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,






|







3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
     * 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 = Tcl_GetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
    /*
     * 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);






|







3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
    /*
     * 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 = Tcl_GetStringFromObj(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);

Changes to generic/tclEnv.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclEnv.c --
 *
 *	Tcl support for environment variables, including a setenv function.
 *	This file contains the generic portion of the environment module. It
 *	is primarily responsible for keeping the "env" arrays in sync with the
 *	system environment variables.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"








|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclEnv.c --
 *
 *	Tcl support for environment variables, including a setenv function.
 *	This file contains the generic portion of the environment module. It
 *	is primarily responsible for keeping the "env" arrays in sync with the
 *	system environment variables.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclEvent.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update" command
 *	functions.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclEvent.c --
 *
 *	This file implements some general event related interfaces including
 *	background errors, exit handlers, and the "vwait" and "update" command
 *	functions.
 *
 * Copyright © 1990-1994 The Regents of the University of California.
 * Copyright © 1994-1998 Sun Microsystems, Inc.
 * Copyright © 2004 Zoran Vasiljevic.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclExecute.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2002-2010 by Miguel Sofer.
 * Copyright (c) 2005-2007 by Donal K. Fellows.
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"




|
|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclExecute.c --
 *
 *	This file contains procedures that execute byte-compiled Tcl commands.
 *
 * Copyright © 1996-1997 Sun Microsystems, Inc.
 * Copyright © 1998-2000 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny. All rights reserved.
 * Copyright © 2002-2010 Miguel Sofer.
 * Copyright © 2005-2007 Donal K. Fellows.
 * Copyright © 2007 Daniel A. Steffen <[email protected]>
 * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
    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.






|







1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
    if (codePtr == NULL) {
	/*
	 * TIP #280: No invoker (yet) - Expression compilation.
	 */

	size_t length;
	const char *string = Tcl_GetStringFromObj(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.
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = TclGetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		if (o != NULL) {
		    s2 = TclGetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}






|

















|







4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
	NEXT_INST_F(9, 1, 1);

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	match = 0;
	if (length > 0) {
	    int i = 0;
	    Tcl_Obj *o;

	    /*
	     * An empty list doesn't match anything.
	     */

	    do {
		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
		if (o != NULL) {
		    s2 = Tcl_GetStringFromObj(o, &s2len);
		} else {
		    s2 = "";
		    s2len = 0;
		}
		if (s1len == s2len) {
		    match = (memcmp(s1, s2, s1len) == 0);
		}
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
	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));






|
















|
















|







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
	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 = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(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));
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
	}
	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);







|







5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
	}
	CACHE_STACK_INFO();

	if (index >= slength) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    TclGetByteArrayFromObj(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);

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






|




|











|







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
	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    goto doneStringMap;
	}
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
	if (slength == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = Tcl_GetUnicodeFromObj(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 = Tcl_GetUnicodeFromObj(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)
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
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	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)) {






|






|








|







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
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	objResultPtr = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);

	TRACE(("%.20s %.20s => %s\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
	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, &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)) {
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
	 * 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);
	}

	/*






|
|






|
|







5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
	 * both.
	 */

	if (TclHasIntRep(valuePtr, &tclStringType)
		|| TclHasIntRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
	    ustring2 = Tcl_GetUnicodeFromObj(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 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2);
	    match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
	} else {
	    match = Tcl_StringCaseMatch(TclGetString(valuePtr),
		    TclGetString(value2Ptr), nocase);
	}

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







|
|






|
|






|
|







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
    {
	const char *string1, *string2;
	size_t trim1, trim2;

    case INST_STR_TRIM_LEFT:
	valuePtr = OBJ_UNDER_TOS;	/* String */
	value2Ptr = OBJ_AT_TOS;		/* TrimSet */
	string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(value2Ptr, &length2);
	string1 = Tcl_GetStringFromObj(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]
	 */

9313
9314
9315
9316
9317
9318
9319
9320
9321
9322
9323
9324
9325
9326
9327
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EvalStatsCmd(
    ClientData unused,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int objc,			/* The number of arguments. */
    Tcl_Obj *const objv[])	/* The argument strings. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    ByteCodeStats *statsPtr = &iPtr->stats;






|







9313
9314
9315
9316
9317
9318
9319
9320
9321
9322
9323
9324
9325
9326
9327
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
EvalStatsCmd(
    TCL_UNUSED(void *),		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int objc,			/* The number of arguments. */
    Tcl_Obj *const objv[])	/* The argument strings. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    ByteCodeStats *statsPtr = &iPtr->stats;
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
9484
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) TclGetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {






|







9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
9484
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {
9607
9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619

9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
9638
9639
9640
9641
9642

9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
9665

9666
9667
9668
9669
9670
9671
9672
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
	if (statsPtr->srcCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i >= 0;  i--) {
	if (statsPtr->srcCount[i] > 0) {
	    maxSizeDecade = i;
	    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++) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i >= 0;  i--) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    maxSizeDecade = i;
	    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++) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i >= 0;  i--) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    maxSizeDecade = i;
	    break;
	}
    }

    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->lifetimeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
    }






|

|
|


>

















|

|
|


>

















|

|
|


>







9607
9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
9638
9639
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668
9669
9670
9671
9672
9673
9674
9675
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {
	if (statsPtr->srcCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->srcCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    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++) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->byteCodeCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    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++) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    minSizeDecade = i;
	    break;
	}
    }
    for (i = 31;  i != (size_t)-1;  i--) {
	if (statsPtr->lifetimeCount[i] > 0) {
	    break;		/* maxSizeDecade to consume 'i' value
				 * below... */
	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->lifetimeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
    }
9693
9694
9695
9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706
9707
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = TclGetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {






|







9696
9697
9698
9699
9700
9701
9702
9703
9704
9705
9706
9707
9708
9709
9710
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = Tcl_GetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {

Changes to generic/tclFCmd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclFileSystem.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright © 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclFileSystem.h"
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	size_t length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = TclGetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;






|







1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	size_t length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
	Tcl_WrongNumArgs(interp, 1, objv, "?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
	int length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = TclGetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {






|







1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
	Tcl_WrongNumArgs(interp, 1, objv, "?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
	int length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = Tcl_GetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {

Changes to generic/tclFileName.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen native
 *	and network form.
 *
 * Copyright © 1995-1998 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
		    && path[3] >= '1' && path[3] <= '9') {
		/*
		 * May have match for 'com[1-9]:?', which is a serial port.
		 */

		if (path[4] == '\0') {
		    abs = 4;
		} else if (path [4] == ':' && path[5] == '\0') {
		    abs = 5;
		}

	    } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
		/*
		 * Have match for 'con'.
		 */






|







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
		    && path[3] >= '1' && path[3] <= '9') {
		/*
		 * May have match for 'com[1-9]:?', which is a serial port.
		 */

		if (path[4] == '\0') {
		    abs = 4;
		} else if (path[4] == ':' && path[5] == '\0') {
		    abs = 5;
		}

	    } else if ((path[2] == 'n' || path[2] == 'N') && path[3] == '\0') {
		/*
		 * Have match for 'con'.
		 */
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
	    if (path[3] >= '1' && path[3] <= '9') {
		/*
		 * May have match for 'lpt[1-9]:?'
		 */

		if (path[4] == '\0') {
		    abs = 4;
		} else if (path [4] == ':' && path[5] == '\0') {
		    abs = 5;
		}
	    }

	} else if ((path[0] == 'p' || path[0] == 'P')
		&& (path[1] == 'r' || path[1] == 'R')
		&& (path[2] == 'n' || path[2] == 'N')






|







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
	    if (path[3] >= '1' && path[3] <= '9') {
		/*
		 * May have match for 'lpt[1-9]:?'
		 */

		if (path[4] == '\0') {
		    abs = 4;
		} else if (path[4] == ':' && path[5] == '\0') {
		    abs = 5;
		}
	    }

	} else if ((path[0] == 'p' || path[0] == 'P')
		&& (path[1] == 'r' || path[1] == 'R')
		&& (path[2] == 'n' || path[2] == 'N')
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
    /*
     * 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];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = TclGetStringFromObj(eltPtr, &len);
	memcpy(p, str, len + 1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */






|



















|







574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	(void)Tcl_GetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = (const char **)Tcl_Alloc(
	    ((((*argcPtr) + 1) * sizeof(char *)) + size));

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = Tcl_GetStringFromObj(eltPtr, &len);
	memcpy(p, str, len + 1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
{
    int needsSep;
    size_t length;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;






|







857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
{
    int needsSep;
    size_t length;
    char *dest;
    const char *p;
    const char *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
    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.
	 */







|







885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
	/*
	 * 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.
	 */







|







921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = TclGetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */







|







1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = Tcl_GetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */

1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
	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
	 */

	last = first + pathlength;
	for (; last != first; last--) {






|







1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	size_t pathlength;
	const char *last;
	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; last--) {
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
	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) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':






|







1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    size_t len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':
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
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = TclGetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */

	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    size_t len;
	    const char *oldStr = TclGetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {






|

















|







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
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */

	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    size_t len;
	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
		    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);
			repair++;
		    }
		    repair = -1;
		}






|







2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
		    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 = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) TclGetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {






|







2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
	    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),
		    Tcl_DStringLength(&append));






|







2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
	    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 = Tcl_GetStringFromObj(joinedPtr,&len);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
	     * 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);
		}
	    }
	}






|







2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
	     * 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 = Tcl_GetStringFromObj(joinedPtr,&len);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}
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
int
Tcl_GetDeviceTypeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int) statPtr->st_rdev;
}

Tcl_WideInt
Tcl_GetAccessTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_atime;
}

Tcl_WideInt
Tcl_GetModificationTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_mtime;
}

Tcl_WideInt
Tcl_GetChangeTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_ctime;
}

Tcl_WideUInt
Tcl_GetSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideUInt) statPtr->st_size;
}

Tcl_WideUInt
Tcl_GetBlocksFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    return (Tcl_WideUInt) statPtr->st_blocks;
#else
    unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);

    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
#endif
}

#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)






|



|


|



|


|



|


|



|


|




|



|







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
int
Tcl_GetDeviceTypeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int) statPtr->st_rdev;
}

long long
Tcl_GetAccessTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (long long) statPtr->st_atime;
}

long long
Tcl_GetModificationTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (long long) statPtr->st_mtime;
}

long long
Tcl_GetChangeTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (long long) statPtr->st_ctime;
}

unsigned long long
Tcl_GetSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (unsigned long long) statPtr->st_size;
}

unsigned long long
Tcl_GetBlocksFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    return (unsigned long long) statPtr->st_blocks;
#else
    unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);

    return ((unsigned long long) statPtr->st_size + blksize - 1) / blksize;
#endif
}

#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)

Changes to generic/tclGet.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclGet.c --
 *
 *	This file contains functions to convert strings into other forms, like
 *	integers or floating-point numbers or booleans, doing syntax checking
 *	along the way.
 *
 * Copyright (c) 1990-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.
 */

#include "tclInt.h"







|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
/*
 * tclGet.c --
 *
 *	This file contains functions to convert strings into other forms, like
 *	integers or floating-point numbers or booleans, doing syntax checking
 *	along the way.
 *
 * Copyright © 1990-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


Changes to generic/tclGetDate.y.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
/*
 * tclGetDate.y --
 *
 *	Contains yacc grammar for parsing date and time strings. The output of
 *	this file should be the file tclDate.c which is used directly in the
 *	Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
 *	only used when doing free-form date parsing, an ill-defined process
 *	anyway.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
%define api.pure
 /* %error-verbose would be nice, but our token names are meaningless */
%locations

%{
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"








|



















|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
/*
 * tclGetDate.y --
 *
 *	Contains yacc grammar for parsing date and time strings. The output of
 *	this file should be the file tclDate.c which is used directly in the
 *	Tcl sources. Note that this file is largely obsolete in Tcl 8.5; it is
 *	only used when doing free-form date parsing, an ill-defined process
 *	anyway.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
%define api.pure
 /* %error-verbose would be nice, but our token names are meaningless */
%locations

%{
/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

Changes to generic/tclHash.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 *
 * Copyright © 1991-1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclHistory.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclHistory.c --
 *
 *	This module and the Tcl library file history.tcl together implement
 *	Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
 *	commands ("events") before they are executed. Commands defined in
 *	history.tcl may be used to perform history substitutions.
 *
 * Copyright (c) 1990-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.
 */

#include "tclInt.h"








|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclHistory.c --
 *
 *	This module and the Tcl library file history.tcl together implement
 *	Tcl command history. Tcl_RecordAndEval(Obj) can be called to record
 *	commands ("events") before they are executed. Commands defined in
 *	history.tcl may be used to perform history substitutions.
 *
 * Copyright © 1990-1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclIO.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclIO.c --
 *
 *	This file provides the generic portions (those that are the same on
 *	all platforms and for all channel types) of Tcl's IO facilities.
 *
 * Copyright © 1998-2000 Ajuba Solutions
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Contributions from Don Porter, NIST, 2014. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
     */

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






|







4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
     */

    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;
}

/*
 *---------------------------------------------------------------------------
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
    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)






|


|







4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = Tcl_GetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
WillWrite(
    Channel *chanPtr)
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;
    }







|







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)Tcl_GetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
    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;
    }







|







4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
    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;
    }

6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
     * expand when converted to UTF-8 chars. This guess comes from analyzing
     * how many characters were produced by the previous pass.
     */

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) TclGetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	size_t size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {






|







6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
     * expand when converted to UTF-8 chars. This guess comes from analyzing
     * how many characters were produced by the previous pass.
     */

    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) Tcl_GetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    if (toRead == srcLen) {
	size_t size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
    } else {
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
 *
 * Side effects:
 *	May flush output on the channel. May discard queued input.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
Tcl_Seek(
    Tcl_Channel chan,		/* The channel on which to seek. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of device driver operations. */
    Tcl_WideInt curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }






|


|









|







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
 *
 * Side effects:
 *	May flush output on the channel. May discard queued input.
 *
 *----------------------------------------------------------------------
 */

long long
Tcl_Seek(
    Tcl_Channel chan,		/* The channel on which to seek. */
    long long offset,		/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of device driver operations. */
    long long curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideInt
Tcl_Tell(
    Tcl_Channel chan)		/* The channel to return pos for. */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    Tcl_WideInt curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but






|










|







7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140
7141
7142
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

long long
Tcl_Tell(
    Tcl_Channel chan)		/* The channel to return pos for. */
{
    Channel *chanPtr = (Channel *) chan;
				/* The real IO channel. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    long long curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_TruncateChannel(
    Tcl_Channel chan,		/* Channel to truncate. */
    Tcl_WideInt length)		/* Length to truncate it to. */
{
    Channel *chanPtr = (Channel *) chan;
    Tcl_DriverTruncateProc *truncateProc =
	    Tcl_ChannelTruncateProc(chanPtr->typePtr);
    int result;

    if (truncateProc == NULL) {






|







7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_TruncateChannel(
    Tcl_Channel chan,		/* Channel to truncate. */
    long long length)		/* Length to truncate it to. */
{
    Channel *chanPtr = (Channel *) chan;
    Tcl_DriverTruncateProc *truncateProc =
	    Tcl_ChannelTruncateProc(chanPtr->typePtr);
    int result;

    if (truncateProc == NULL) {
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
 */

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. */
{
    Channel *inPtr = (Channel *) inChan;
    Channel *outPtr = (Channel *) outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int readFlags, writeFlags;
    CopyState *csPtr;






|







9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
 */

int
TclCopyChannel(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    long long toRead,		/* Amount of data to copy, or -1 for all. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
{
    Channel *inPtr = (Channel *) inChan;
    Channel *outPtr = (Channel *) outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int readFlags, writeFlags;
    CopyState *csPtr;
9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
	 * Now write the buffer out.
	 */

	if (inBinary || sameEncoding) {
	    buffer = csPtr->buffer;
	    sizeb = size;
	} else {
	    buffer = TclGetStringFromObj(bufObj, &sizeb);
	}

	if (outBinary || sameEncoding) {
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}






|







9608
9609
9610
9611
9612
9613
9614
9615
9616
9617
9618
9619
9620
9621
9622
	 * Now write the buffer out.
	 */

	if (inBinary || sameEncoding) {
	    buffer = csPtr->buffer;
	    sizeb = size;
	} else {
	    buffer = Tcl_GetStringFromObj(bufObj, &sizeb);
	}

	if (outBinary || sameEncoding) {
	    sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb);
	} else {
	    sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb);
	}

Changes to generic/tclIOCmd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclIOCmd.c --
 *
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
     * 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);
    TclChannelRelease(chan);
    Tcl_DecrRefCount(resultPtr);






|







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	size_t length;

	result = Tcl_GetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    TclChannelRelease(chan);
    Tcl_DecrRefCount(resultPtr);
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
	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')) {
	    Tcl_SetObjLength(resultPtr, len - 1);
	}
	return TCL_ERROR;
    }

    return TCL_OK;






|







699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
	const char *string;
	size_t len;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = Tcl_GetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, len - 1);
	}
	return TCL_ERROR;
    }

    return TCL_OK;
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */

    if (keepNewline == 0) {
	string = TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (string[length - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    return result;






|







979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */

    if (keepNewline == 0) {
	string = Tcl_GetStringFromObj(resultPtr, &length);
	if ((length > 0) && (string[length - 1] == '\n')) {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);

    return result;

Changes to generic/tclIOGT.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API at the
 *	script level. Contributed by Andreas Kupries.
 *
 * Copyright (c) 2000 Ajuba Solutions
 * Copyright (c) 1999-2000 Andreas Kupries ([email protected])
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"





|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclIOGT.c --
 *
 *	Implements a generic transformation exposing the underlying API at the
 *	script level. Contributed by Andreas Kupries.
 *
 * Copyright © 2000 Ajuba Solutions
 * Copyright © 1999-2000 Andreas Kupries ([email protected])
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
static int		TransformGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(ClientData instanceData, int mask);
static int		TransformGetFileHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TransformNotifyProc(ClientData instanceData, int mask);
static Tcl_WideInt	TransformWideSeekProc(ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);

/*
 * Forward declarations of internal procedures. Secondly the procedures for
 * handling and generating fileeevents.
 */

static void		TransformChannelHandlerTimer(ClientData clientData);






|
|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
static int		TransformGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(ClientData instanceData, int mask);
static int		TransformGetFileHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TransformNotifyProc(ClientData instanceData, int mask);
static long long	TransformWideSeekProc(ClientData instanceData,
			    long long offset, int mode, int *errorCodePtr);

/*
 * Forward declarations of internal procedures. Secondly the procedures for
 * handling and generating fileeevents.
 */

static void		TransformChannelHandlerTimer(ClientData clientData);
436
437
438
439
440
441
442
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.
	 */






|









|





|







436
437
438
439
440
441
442
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 = 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.
	 */
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
 * Result:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    Tcl_WideInt offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    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.
	 */







|


|








|







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
 * Result:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static long long
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    long 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_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    void *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.
	 */

Changes to generic/tclIORChan.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORChan.c --
 *
 *	This file contains the implementation of Tcl's generic channel
 *	reflection code, which allows the implementation of Tcl channels in
 *	Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #219 for the specification of this functionality.
 *
 * Copyright © 2004-2005 ActiveState, a divison of Sophos
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#if TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		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);






|
|







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#if TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static long long ReflectSeekWide(ClientData clientData,
			    long long offset, int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static void     TimerRunRead(ClientData clientData);
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
            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;






|







1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if ((size_t)toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
    }

    *errorCodePtr = EOK;
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *offObj, *baseObj;
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;






|


|







1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static long long
ReflectSeekWide(
    ClientData clientData,
    long long offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *offObj, *baseObj;
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
	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;
    }






|







1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
	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 = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
	     *
	     * 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,
			cmdLen);






|







2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
	     *
	     * 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 = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
	    /*
	     * 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);






|







3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
	    /*
	     * Process a regular result.
	     */

	    size_t bytec = 0;		/* 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 = TCL_IO_FAILURE;
	    } else {
		if (bytec + 1 > 1) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
		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);
		}
	    }
	}






|







3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
		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 = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345

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







|







3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif


Changes to generic/tclIORTrans.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORTrans.c --
 *
 *	This file contains the implementation of Tcl's generic transformation
 *	reflection code, which allows the implementation of Tcl channel
 *	transformations in Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #230 for the specification of this functionality.
 *
 * Copyright (c) 2007-2008 ActiveState.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclIORTrans.c --
 *
 *	This file contains the implementation of Tcl's generic transformation
 *	reflection code, which allows the implementation of Tcl channel
 *	transformations in Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #230 for the specification of this functionality.
 *
 * Copyright © 2007-2008 ActiveState.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclIO.h"
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
			    Tcl_Interp *interp, int flags);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static int		ReflectHandle(ClientData clientData, int direction,






|
|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
			    Tcl_Interp *interp, int flags);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
static long long	ReflectSeekWide(ClientData clientData,
			    long long offset, int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static int		ReflectHandle(ClientData clientData, int direction,
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
 * Side effects:
 *	Allocates memory. Arbitrary, per the parent channel, and the called
 *	scripts.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Channel *parent = (Channel *) rtPtr->parent;
    Tcl_WideInt curPos;		/* Position on the device. */







|


|







1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
 * Side effects:
 *	Allocates memory. Arbitrary, per the parent channel, and the called
 *	scripts.
 *
 *----------------------------------------------------------------------
 */

static long long
ReflectSeekWide(
    ClientData clientData,
    long long offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Channel *parent = (Channel *) rtPtr->parent;
    Tcl_WideInt curPos;		/* Position on the device. */

2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		size_t cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);






|







2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
	     *
	     * 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 = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
	     * 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 {






|







2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* 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 *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
	     * 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 {






|







2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* 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 *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
	     * 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 {






|







2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
	     * 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 = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
	     * 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 {






|







2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* 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 *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780

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 */







|







2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */

3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
     * 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;






|







3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
     * 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;
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
    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






|







3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
    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
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
	    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) {






|







3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
	    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) {
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
	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;






|







3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
	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;
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
	    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 */
    }







|







3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
	    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.

1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"





|







1
2
3
4
5
6
7
8
9
10
11
12
13
/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

Changes to generic/tclIOUtil.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclIOUtil.c --
 *
 *	Provides an interface for managing filesystems in Tcl, and also for
 *	creating a filesystem interface in Tcl arbitrary facilities.  All
 *	filesystem operations are performed via this interface.  Vince Darley
 *	is the primary author.  Other signifiant contributors are Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32








|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclIOUtil.c --
 *
 *	Provides an interface for managing filesystems in Tcl, and also for
 *	creating a filesystem interface in Tcl arbitrary facilities.  All
 *	filesystem operations are performed via this interface.  Vince Darley
 *	is the primary author.  Other signifiant contributors are Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *
 * Copyright © 1991-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    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
	     * current structure in place of the old one.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);






|
|







520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	size_t len1, len2;
	const char *str1, *str2;

	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * The values are equal but the objects are different.  Cache the
	     * current structure in place of the old one.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
    ClientData clientData)
{
    size_t len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {






|







664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
    ClientData clientData)
{
    size_t len = 0;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
	     * i.e. the representation relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = TclGetStringFromObj(mElt, &mlen);
		path = TclGetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}






|
|







1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
	     * i.e. the representation relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = Tcl_GetStringFromObj(mElt, &mlen);
		path = Tcl_GetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
     * 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;
	}






|







1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
     * 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;
	}
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
    /*
     * 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);
    string = TclGetStringFromObj(objPtr, &length);

    /*
     * TIP #280:  Open a frame for the evaluated script.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);






|















|







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
    /*
     * 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);
    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280:  Open a frame for the evaluated script.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
    if (result == TCL_RETURN) {
	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)));






|







1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	const char *pathString = Tcl_GetStringFromObj(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)));
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
    /*
     * 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;
    }






|







1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
    /*
     * 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;
    }
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
	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)));






|







1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	size_t length;
	const char *pathString = Tcl_GetStringFromObj(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)));
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
	     * 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
		 * object which is probably already shared and free the
		 * normalized pathname that was just produced.
		 */
	    cdEqual:






|
|







2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
	     * 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 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname
		 * object which is probably already shared and free the
		 * normalized pathname that was just produced.
		 */
	    cdEqual:
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
				 * 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) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,






|







3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
				 * 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 = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
		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;






|







4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    size_t len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = Tcl_GetStringFromObj(vol,&len);
		    if ((size_t) pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
	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].
		     */







|
|







4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
	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 = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(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].
		     */

Changes to generic/tclIndexObj.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclIndexObj.c --
 *
 *	This file implements objects of type "index". This object type is used
 *	to lookup a keyword in a table of valid values and cache the index of
 *	the matching entry. Also provides table-based argv/argc processing.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 2006 Sam Bromley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"







|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * tclIndexObj.c --
 *
 *	This file implements objects of type "index". This object type is used
 *	to lookup a keyword in a table of valid values and cache the index of
 *	the matching entry. Also provides table-based argv/argc processing.
 *
 * Copyright © 1990-1994 The Regents of the University of California.
 * Copyright © 1997 Sun Microsystems, Inc.
 * Copyright © 2006 Sam Bromley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = TclGetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {






|


|







611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = Tcl_GetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = TclGetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||






|





|







668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = Tcl_GetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
	    if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		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);







|







845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
	    if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else {
		elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,






|







895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = TclGetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*






|







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = Tcl_GetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*

Changes to generic/tclInt.decls.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h
#	and tclStubInit.c files
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclInt

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.

# Replaced by Tcl_FSAccess in 8.4:
#declare 0 {
#    int TclAccess(const char *path, int mode)
#}
#declare 1 {
#    int TclAccessDeleteProc(TclAccessProc_ *proc)
#}
#declare 2 {
#    int TclAccessInsertProc(TclAccessProc_ *proc)
#}
declare 3 {
    void TclAllocateFreeObjects(void)
}
# Replaced by TclpChdir in 8.1:
#  declare 4 {
#      int TclChdir(Tcl_Interp *interp, char *dirName)
#  }
declare 5 {
    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)
}
declare 10 {
    int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
	    const char *procName,
	    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
}
declare 11 {
    void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
declare 12 {
    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
# 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)
}
# Removed in 8.4:
#declare 17 {
#    int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
#declare 18 {
#    int TclFileCopyCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 19 {
#    int TclFileDeleteCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#declare 20 {
#    int TclFileMakeDirsCmd(Tcl_Interp *interp, int argc, char **argv)
#}
#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)
#  }
# Removed in 8.5:
#declare 27 {
#    int TclGetDate(char *p, unsigned long now, long zone,
#	    unsigned long *timePtr)
#}
declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}
# Removed in 8.4b2:
#declare 29 {
#    Tcl_Obj *TclGetElementOfIndexedArray(Tcl_Interp *interp,
#	    int localIndex, Tcl_Obj *elemPtr, int flags)
#}
# Replaced by char *TclGetEnv(const char *name, Tcl_DString *valuePtr) in 8.1:
#  declare 30 {
#      char *TclGetEnv(const char *name)
#  }
declare 31 {
    const char *TclGetExtension(const char *name)
}
declare 32 {
    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 {
#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
declare 37 {
    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
}
declare 38 {
    int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
	    Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
	    Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
	    const char **simpleNamePtr)
}
declare 39 {
    TclObjCmdProcType TclGetObjInterpProc(void)
}
declare 40 {
    int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
    const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in 8.5a2:
#declare 43 {
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 44 {
    int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
}
declare 45 {
    int TclHideUnsafeCommands(Tcl_Interp *interp)
}
declare 46 {
    int TclInExit(void)
}
# Removed in 8.4b2:
#declare 47 {
#    Tcl_Obj *TclIncrElementOfIndexedArray(Tcl_Interp *interp,
#	    int localIndex, Tcl_Obj *elemPtr, long incrAmount)
#}
# Removed in 8.4b2:
#declare 48 {
#    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 {
#      int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#  	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#  	    Tcl_PackageInitProc **proc2Ptr)
#  }
# Signature changed to take a length in 8.1:
#  declare 57 {
#      int TclLooksLikeInt(char *p)
#  }
declare 58 {
    Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, const char *msg, int createPart1, int createPart2,
	    Var **arrayPtrPtr)
}
# Replaced by Tcl_FSMatchInDirectory in 8.4
#declare 59 {
#    int TclpMatchFiles(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *dirPtr, char *pattern, char *tail)
#}
declare 60 {
    int TclNeedSpace(const char *start, const char *end)
}
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:
#declare 65 {
#    int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
#	    Tcl_Obj *const objv[], int flags)
#}
#declare 66 {
#    int TclOpenFileChannelDeleteProc(TclOpenFileChannelProc_ *proc)
#}
#declare 67 {
#    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)
#}
# Removed in 8.1:
#  declare 84 {
#      int TclParseBraces(Tcl_Interp *interp, char *str, char **termPtr,
#  	    ParseValue *pvPtr)
#  }
#  declare 85 {
#      int TclParseNestedCmd(Tcl_Interp *interp, char *str, int flags,
#  	    char **termPtr, ParseValue *pvPtr)
#  }
#  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:
#declare 95 {
#    int TclpStat(const char *path, Tcl_StatBuf *buf)
#}
declare 96 {
    int TclRenameCommand(Tcl_Interp *interp, const char *oldName,
            const char *newName)
}
declare 97 {
    void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
}
declare 98 {
    int TclServiceIdle(void)
}
# Removed in 8.4b2:
#declare 99 {
#    Tcl_Obj *TclSetElementOfIndexedArray(Tcl_Interp *interp, int localIndex,
#	    Tcl_Obj *elemPtr, Tcl_Obj *objPtr, int flags)
#}
# 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)
#}
#declare 107 {
#    int TclStatInsertProc(TclStatProc_ *proc)
#}
declare 108 {
    void TclTeardownNamespace(Namespace *nsPtr)
}
declare 109 {
    int TclUpdateReturnInfo(Interp *iPtr)
}
declare 110 {






|
|
|















<
<
<
<
<
<
<
<
<
<



<
<
<
<










<
<
<
<
<
<

<
















<
<
<
<
<



<
<
<
<



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















<
<
<
<
<
<
<
<
<



<
<
<
<
<
<
<
<
<







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


















<
<
<
<
<
<
<
<






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



<
<
<
<
<











<
<
<
<
<
<
<
<
<
<





<
<
<
<
<

















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



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









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



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




<
<
<
<











<
<
<
<
<
<
<
<
<










<
<
<
<
<
<
<
<
<
<










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







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










26
27
28




29
30
31
32
33
34
35
36
37
38






39

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





56
57
58




59
60
61
















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









77
78
79









80
81
82
83
84
85
86





















87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104








105
106
107
108
109
110



















111
112
113





114
115
116
117
118
119
120
121
122
123
124










125
126
127
128
129





130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146















147
148
149













150
151
152
153
154
155
156
157
158


















159
160
161




























162
163
164
165




166
167
168
169
170
171
172
173
174
175
176









177
178
179
180
181
182
183
184
185
186










187
188
189
190
191
192
193
194
195
196














197
198
199
200
201
202
203
# tclInt.decls --
#
#	This file contains the declarations for all unsupported
#	functions that are exported by the Tcl library.  This file
#	is used to generate the tclIntDecls.h, tclIntPlatDecls.h
#	and tclStubInit.c files
#
# Copyright © 1998-1999 Scriptics Corporation.
# Copyright © 2001 Kevin B. Kenny.  All rights reserved.
# Copyright © 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclInt

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.











declare 3 {
    void TclAllocateFreeObjects(void)
}




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






# 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)
}
declare 10 {
    int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
	    const char *procName,
	    Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr)
}
declare 11 {
    void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
}
declare 12 {
    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}





declare 14 {
    int TclDumpMemoryInfo(void *clientData, int flags)
}




declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)
}
















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









declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}









declare 31 {
    const char *TclGetExtension(const char *name)
}
declare 32 {
    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}





















declare 38 {
    int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
	    Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
	    Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
	    const char **simpleNamePtr)
}
declare 39 {
    TclObjCmdProcType TclGetObjInterpProc(void)
}
declare 40 {
    int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
    const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}








declare 45 {
    int TclHideUnsafeCommands(Tcl_Interp *interp)
}
declare 46 {
    int TclInExit(void)
}



















declare 51 {
    int TclInterpInit(Tcl_Interp *interp)
}





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










declare 58 {
    Var *TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, const char *msg, int createPart1, int createPart2,
	    Var **arrayPtrPtr)
}





declare 60 {
    int TclNeedSpace(const char *start, const char *end)
}
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)
}















declare 69 {
    void *TclpAlloc(size_t size)
}













declare 74 {
    void TclpFree(void *ptr)
}
declare 75 {
    Tcl_WideUInt TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
}


















declare 81 {
    void *TclpRealloc(void *ptr, size_t size)
}




























declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}




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









declare 96 {
    int TclRenameCommand(Tcl_Interp *interp, const char *oldName,
            const char *newName)
}
declare 97 {
    void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
}
declare 98 {
    int TclServiceIdle(void)
}










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














declare 108 {
    void TclTeardownNamespace(Namespace *nsPtr)
}
declare 109 {
    int TclUpdateReturnInfo(Interp *iPtr)
}
declare 110 {
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
# 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)
#}

# Added in 8.1:

#declare 137 {
#   int TclpChdir(const char *dirName)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)






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












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




<
<
<
<
<


















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



<
<
<
<
<
<
<
<







212
213
214
215
216
217
218





























219
220
221
222
223
224
225
226
227
228
229
230






















231
232
233
234





235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252


















253
254
255








256
257
258
259
260
261
262
# 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 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 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}





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 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}








# 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)
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
}
declare 148 {
    TclHandle TclHandlePreserve(TclHandle handle)
}
declare 149 {
    void TclHandleRelease(TclHandle handle)
}

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr,
	    size_t *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}

# moved to tclTest.c (static) in 8.3.2/8.4a2
#declare 154 {
#    int TclTestChannelCmd(void *clientData,
#    Tcl_Interp *interp, int argc, char **argv)
#}
#declare 155 {
#    int TclTestChannelEventCmd(void *clientData,
#	     Tcl_Interp *interp, int argc, char **argv)
#}

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






<
<
<













<
<
<
<
<
<
<
<
<
<
<







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







280
281
282
283
284
285
286



287
288
289
290
291
292
293
294
295
296
297
298
299











300
301
302
303
304
305
306















307
308
309
310
311
312
313
}
declare 148 {
    TclHandle TclHandlePreserve(TclHandle handle)
}
declare 149 {
    void TclHandleRelease(TclHandle handle)
}



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











declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}















declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(void *clientData, int flags)
}
690
691
692
693
694
695
696
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
# 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)
#}

# Factoring out of trace code

declare 175 {
    int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr,
	    const char *part1, const char *part2, int flags, int leaveErrMsg)
}
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 {
#      void TclThreadStorageLockInit(void)
# }
# declare 185 {
#      void TclThreadStorageLock(void)
# }
# declare 186 {
#      void TclThreadStorageUnlock(void)
# }
# declare 187 {
#      void TclThreadStoragePrint(FILE *outFile, int flags)
# }
# declare 188 {
#      Tcl_HashTable *TclThreadStorageGetHashTable(Tcl_ThreadId id)
# }
# declare 189 {
#      Tcl_HashTable *TclThreadStorageInit(Tcl_ThreadId id, void *reserved)
# }
# declare 190 {
#      void TclThreadStorageDataKeyInit(Tcl_ThreadDataKey *keyPtr)
# }
# declare 191 {
#      void *TclThreadStorageDataKeyGet(Tcl_ThreadDataKey *keyPtr)
# }
# declare 192 {
#      void TclThreadStorageDataKeySet(Tcl_ThreadDataKey *keyPtr, void *data)
# }
# declare 193 {
#      void TclFinalizeThreadStorageThread(Tcl_ThreadId id)
# }
# declare 194 {
#      void TclFinalizeThreadStorage(void)
# }
# declare 195 {
#      void TclFinalizeThreadStorageData(Tcl_ThreadDataKey *keyPtr)
# }
# declare 196 {
#      void TclFinalizeThreadStorageDataKey(Tcl_ThreadDataKey *keyPtr)
# }

#
# Added in tcl8.5a5 for compiler/executor experimentation.
# Disabled in Tcl 8.5.1; experiments terminated. :/
#
#declare 197 {
#    int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
#		        const CmdFrame *invoker, int word)
#}
declare 198 {
    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CallFrame **framePtrPtr)
}

#declare 199 {
#    int TclMatchIsTrivial(const char *pattern)
#}

# 200-208 exported for use by the test suite [Bug 1054748]
declare 200 {
    int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive,
	Tcl_Obj **errorPtr)
}
declare 201 {
    int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,






<
<
<
<
<
<
<
<
<

















<
<
<




<
<
<
<
<
<
<
<
<
<











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




<
<
<
<
<







336
337
338
339
340
341
342









343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359



360
361
362
363










364
365
366
367
368
369
370
371
372
373
374
















































































375
376
377
378





379
380
381
382
383
384
385
# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int index, Tcl_Obj *valuePtr)
}










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



declare 173 {
    int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen,
	    const Tcl_UniChar *pattern, size_t ptnLen, int flags)
}










declare 175 {
    int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr,
	    const char *part1, const char *part2, int flags, int leaveErrMsg)
}
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 198 {
    int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CallFrame **framePtrPtr)
}





# 200-208 exported for use by the test suite [Bug 1054748]
declare 200 {
    int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive,
	Tcl_Obj **errorPtr)
}
declare 201 {
    int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
declare 207 {
    int TclpObjAccess(Tcl_Obj *pathPtr, int mode)
}
declare 208 {
    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr, int mode, int permissions)
}
# Made public by TIP 258
#declare 209 {
#    Tcl_Obj *TclGetEncodingSearchPath(void)
#}
#declare 210 {
#    int TclSetEncodingSearchPath(Tcl_Obj *searchPath)
#}
#declare 211 {
#    const char *TclpGetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
#}
declare 212 {
    void TclpFindExecutable(const char *argv0)
}
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {






<
<
<
<
<
<
<
<
<
<







403
404
405
406
407
408
409










410
411
412
413
414
415
416
declare 207 {
    int TclpObjAccess(Tcl_Obj *pathPtr, int mode)
}
declare 208 {
    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr, int mode, int permissions)
}










declare 212 {
    void TclpFindExecutable(const char *argv0)
}
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
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
    void TclPopStackFrame(Tcl_Interp *interp)
}

# for use in tclTest.c
declare 224 {
    TclPlatformType *TclGetPlatform(void)
}

#
declare 225 {
    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)
#  }
declare 229 {
    int	TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
	    const char *myName, int myFlags, int index)
}
declare 230 {
    Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    const char *part2, int flags, const char *msg,






<
<











<
<
<
<
<
<







430
431
432
433
434
435
436


437
438
439
440
441
442
443
444
445
446
447






448
449
450
451
452
453
454
    void TclPopStackFrame(Tcl_Interp *interp)
}

# for use in tclTest.c
declare 224 {
    TclPlatformType *TclGetPlatform(void)
}


declare 225 {
    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[])
}






declare 229 {
    int	TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
	    const char *myName, int myFlags, int index)
}
declare 230 {
    Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    const char *part2, int flags, const char *msg,
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
declare 232 {
    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
	    const CmdFrame *invoker, int word)
}
declare 233 {
    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}

# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
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 {






<








<
<
<
<
<
<
<




<







463
464
465
466
467
468
469

470
471
472
473
474
475
476
477







478
479
480
481

482
483
484
485
486
487
488
declare 232 {
    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
	    const CmdFrame *invoker, int word)
}
declare 233 {
    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
}

# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
declare 234 {
    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
             int *newPtr)
}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}







# 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 {
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
}

declare 249 {
    char *TclDoubleDigits(double dv, int ndigits, int flags,
			  int *decpt, int *signum, char **endPtr)
}
# TIP #285: Script cancellation support.






|







520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr)
}

declare 249 {
    char *TclDoubleDigits(double dv, int ndigits, int flags,
			  int *decpt, int *signum, char **endPtr)
}
# TIP #285: Script cancellation support.
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102



1103
1104
1105
1106

1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122


1123
1124
1125
1126

1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181



1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
    int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr,
	    Tcl_Obj *myNamePtr, int myFlags)
}
declare 256 {
    int	TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}

declare 257 {
    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}

# TIP 431: temporary directory creation function
declare 258 {
    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

declare 11 win {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 12 win {
    int TclpCloseFile(TclFile file)
}
declare 13 win {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 14 win {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 15 win {
    int TclpCreateProcess(Tcl_Interp *interp, int argc,
	    const char **argv, TclFile inputFile, TclFile outputFile,
	    TclFile errorFile, Tcl_Pid *pidPtr)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 16 win {
    int TclpIsAtty(int fd)
}
# Signature changed in 8.1:
#  declare 16 win {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }
#  declare 17 win {
#      char *TclpGetTZName(void)
#  }
# new for 8.5.12+ Cygwin only
declare 17 win {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
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 {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 1 unix {
    int TclpCloseFile(TclFile file)
}
declare 2 unix {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
declare 4 unix {
    int TclpCreateProcess(Tcl_Interp *interp, int argc,
	    const char **argv, TclFile inputFile, TclFile outputFile,
	    TclFile errorFile, Tcl_Pid *pidPtr)
}
declare 5 unix {
    int TclUnixWaitForFile_(int fd, int mask, int timeout)
}
declare 6 unix {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 unix {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 8 unix {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}

# Added in 8.1:

declare 9 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

# Added in 8.4:

# Removed in 9.0:
#declare 10 unix {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}
# Removed in 9.0:
#declare 11 unix {
#    struct tm *TclpLocaltime_unix(const time_t *clock)
#}
# 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)
}

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

declare 15 {unix macosx} {
    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
declare 16 {unix macosx} {
    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
declare 17 {unix macosx} {
    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr)
}
declare 18 {unix macosx} {
    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}
declare 19 {unix macosx} {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
declare 22 {unix macosx} {
    TclFile TclpCreateTempFile_(const char *contents)
}

declare 29 {win unix} {
    int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}

# Local Variables:
# mode: tcl
# End:






>




















<









|

|


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


<
|


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


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



|


|


|
|

|




<
|


<
<
<
<
<
<
<
<
|




|

>
>
>

|

|


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

<
<
<
<
|


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


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


<
|







563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590

591
592
593
594
595
596
597
598
599
600
601
602
603
604

605
606


607
608




609
610
611
612
613


614
615
616
617

618
619
620





621



622
623
624

625

626
627
628
629

630










631

632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650

651
652
653








654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669










670
671
672




673
674
675











676
677
678







































































































679
680
681

682
683
684
685
686
687
688
689
    int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr,
	    Tcl_Obj *myNamePtr, int myFlags)
}
declare 256 {
    int	TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}

declare 257 {
    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}

# TIP 431: temporary directory creation function
declare 258 {
    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

################################
# Platform specific functions

declare 0 {unix win} {
    void TclWinConvertError(int errCode)
}

declare 1 {unix win} {
    int TclpCloseFile(TclFile file)


}
declare 2 {unix win} {




    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 {unix win} {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)


}
declare 4 {unix win} {
    void *TclWinGetTclInstance(void)
}

declare 5 {unix win} {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}





declare 6 {unix win} {



    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 7 {unix win} {

    TclFile TclpOpenFile(const char *fname, int mode)

}
declare 8 {unix win} {
    size_t TclpGetPid(Tcl_Pid pid)
}

declare 9 {unix win} {










    TclFile TclpCreateTempFile(const char *contents)

}
declare 11 {unix win} {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 12 win {
    int TclpCloseFile_(TclFile file)
}
declare 13 win {
    Tcl_Channel TclpCreateCommandChannel_(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 14 {unix win} {
    int TclpCreatePipe_(TclFile *readPipe, TclFile *writePipe)
}
declare 15 {unix win} {
    int TclpCreateProcess(Tcl_Interp *interp, int argc,
	    const char **argv, TclFile inputFile, TclFile outputFile,
	    TclFile errorFile, Tcl_Pid *pidPtr)
}

declare 16 {unix win} {
    int TclpIsAtty(int fd)
}








declare 17 {unix win} {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}
declare 18 win {
    TclFile TclpMakeFile_(Tcl_Channel channel, int direction)
}
declare 19 unix {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
declare 19 win {
    TclFile TclpOpenFile_(const char *fname, int mode)
}
declare 20 {unix win} {
    void TclWinAddProcess(void *hProcess, size_t id)
}










declare 22 {unix win} {
    TclFile TclpCreateTempFile_(const char *contents)
}




declare 24 {unix win} {
    char *TclWinNoBackslash(char *path)
}











declare 27 {unix win} {
    void TclWinFlushDirtyChannels(void)
}







































































































declare 29 {unix win} {
    int TclWinCPUID(int index, int *regs)
}

declare 30 {unix win} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}

# Local Variables:
# mode: tcl
# End:

Changes to generic/tclInt.h.

3179
3180
3181
3182
3183
3184
3185

3186
3187
3188
3189
3190
3191

3192
3193
3194
3195
3196
3197
3198
			    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,






>




|
|
>







3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
			    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 TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
#   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 *, int *);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *, int *);
    MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
#   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,
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
			    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
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);

MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE 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,






|
|




|





|







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
			    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 long long TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(long long clicks);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#else
#   ifdef _WIN32
#	define TCL_WIDE_CLICKS 1
MODULE_SCOPE long long TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE long long TclpGetMicroseconds(void);

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,
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
 * 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:
 *
 * MODULE_SCOPE void	TclFreeIntRep(Tcl_Obj *objPtr);






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







4415
4416
4417
4418
4419
4420
4421

































4422
4423
4424
4425
4426
4427
4428
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))


































/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's internal
 * representation. Does not actually reset the rep's bytes. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclFreeIntRep(Tcl_Obj *objPtr);
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewIndexObj(objPtr, w) \
    (objPtr) = ((w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : 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 */






|







4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)

#define TclNewIndexObj(objPtr, w) \
    (objPtr) = (((size_t)w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : 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 */

Changes to generic/tclIntDecls.h.

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
/* 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 */






|
<
<


















|
<
<







107
108
109
110
111
112
113
114


115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133


134
135
136
137
138
139
140
/* 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 */
/* Slot 37 is reserved */


/* 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 */
/* Slot 44 is reserved */


/* 45 */
EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
/* 46 */
EXTERN int		TclInExit(void);
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
				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 */






|







533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
				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,
				long long 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 */
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
    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 */






|






|







621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
    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);
    void (*reserved37)(void);
    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);
    void (*reserved44)(void);
    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 */
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
    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 */






|







832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
    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, long long 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 */
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
	(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 \
	(tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
#define TclGetOpenMode \
	(tclIntStubsPtr->tclGetOpenMode) /* 40 */
#define TclGetOriginalCommand \
	(tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
#define TclpGetUserHome \
	(tclIntStubsPtr->tclpGetUserHome) /* 42 */
/* Slot 43 is reserved */
#define TclGuessPackageName \
	(tclIntStubsPtr->tclGuessPackageName) /* 44 */
#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */






|
<











|
<







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
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
/* Slot 33 is reserved */
/* Slot 34 is reserved */
/* Slot 35 is reserved */
/* Slot 36 is reserved */
/* Slot 37 is reserved */

#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#define TclGetObjInterpProc \
	(tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
#define TclGetOpenMode \
	(tclIntStubsPtr->tclGetOpenMode) /* 40 */
#define TclGetOriginalCommand \
	(tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
#define TclpGetUserHome \
	(tclIntStubsPtr->tclpGetUserHome) /* 42 */
/* Slot 43 is reserved */
/* Slot 44 is reserved */

#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */

Changes to generic/tclIntPlatDecls.h.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71


72
73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
98

99
100
101
102
103

104
105
106

107
108
109
110
111
112
113
114
115
116
117
118

119



120

121
122
123
124
125

126

127
128
129

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

142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205


206
207
208
209
210
211
212
213
214

215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231
232

233
234
235
236
237

238
239
240

241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

390
391
392
393
394
395
396
397
398
399

400
401
402
403
404
405
406
407
408
409

410
411
412


413
414
415
416
417
418
419
420
421
422
423
424



425
426
427
428

429

430
431
432
433


434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501
502
503

504
505
506
507
508
509
510
511
512
513

514
515
516


517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535



536



537


538
539



540
541
542
543
544
545
546
547
/*
 * Exported function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 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,

				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);

/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */

/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */

/* Slot 28 is reserved */
/* 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 /* 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,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);

/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				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 */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 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,

				Tcl_Obj **attributePtrPtr);
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);

/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 20 is reserved */

/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */

/* Slot 28 is reserved */
/* 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 /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    void *hooks;

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    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);
    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 /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(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 \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */

#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */


/* Slot 28 is reserved */
#define TclWinCPUID \
	(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 \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#define TclUnixWaitForFile_ \
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(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 \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */

#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */

/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */


/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */

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






|
<









|
<
<
<

|





|



|
>
>



|
|
<

|
|
>
|

|
<
<

<
|
|
>
|
<
<
<
<



|
>




|
>


|
>











|
>
|
>
>
>
|
>




|
>
|
>


|
>





|

|



|
>












|

|




|

















|
<









|
<
<
<

|





|



|
>
>



|
|
<

|
|
>
|

|
<
<

<
|
|
>
|
<
<
<
<



|
>




|
>


|
>














|



|
|


|


|


|
|
|
|
|

|



|


|






|
|
|


|
|

|


|
|
|



|
|


|










|



|
|


|


|


|
|
|
|
|

|



|


|



















|
|






|
|
|
|




|
|



|
>


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




|
>


<
>
>









|
|
|
>
>
>




>
|
>
|


<
>
>



|
|
|
|
|
|






|
|
|
|



|
|














|
|






|
|
|
|




|
|



|
>


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




|
>


<
>
>















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








38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54
55



56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81


82

83
84
85
86




87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191
192
193



194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212

213
214
215
216
217
218
219


220

221
222
223
224




225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
412

413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517

518
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542


543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
/*
 * Exported function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclWinConvertError(int errCode);

/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);



/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclpCreatePipe_(TclFile *readPipe,
				TclFile *writePipe);

/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);


/* 17 */

EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* Slot 18 is reserved */




/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 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 /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN void		TclWinConvertError(int errCode);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 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,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 14 */
EXTERN int		TclpCreatePipe_(TclFile *readPipe,
				TclFile *writePipe);
/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				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 */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void		TclWinConvertError(int errCode);

/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);



/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* Slot 12 is reserved */
/* Slot 13 is reserved */
/* 14 */
EXTERN int		TclpCreatePipe_(TclFile *readPipe,
				TclFile *writePipe);

/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* 16 */
EXTERN int		TclpIsAtty(int fd);


/* 17 */

EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* Slot 18 is reserved */




/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 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 /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    void *hooks;

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclWinConvertError) (int errCode); /* 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 */
    void * (*tclWinGetTclInstance) (void); /* 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 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    void (*reserved12)(void);
    void (*reserved13)(void);
    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 */
    void (*reserved18)(void);
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 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 /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*tclWinConvertError) (int errCode); /* 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 */
    void * (*tclWinGetTclInstance) (void); /* 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 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile_) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel_) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe_) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    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 (*tclWinConvertError) (int errCode); /* 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 */
    void * (*tclWinGetTclInstance) (void); /* 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 */
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    void (*reserved12)(void);
    void (*reserved13)(void);
    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 */
    void (*reserved18)(void);
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 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 /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclpCreatePipe_ \
	(tclIntPlatStubsPtr->tclpCreatePipe_) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
/* Slot 18 is reserved */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */

/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */

#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */

#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* 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 TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclpCreatePipe_ \
	(tclIntPlatStubsPtr->tclpCreatePipe_) /* 14 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
/* Slot 18 is reserved */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */

/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
/* Slot 26 is reserved */

#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#define TclWinConvertWSAError TclWinConvertError



#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */
MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
	int objIndex, Tcl_Obj *fileName,
	Tcl_Obj **attributePtrPtr);
/* 16 */
MODULE_SCOPE int TclMacOSXSetFileAttribute(Tcl_Interp *interp,
	int objIndex, Tcl_Obj *fileName,
	Tcl_Obj *attributePtr);
/* 17 */
MODULE_SCOPE int TclMacOSXCopyFileAttributes(const char *src,
	const char *dst,
	const Tcl_StatBuf *statBufPtr);
/* 18 */
MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
	const char *pathName, const char *fileName,
	Tcl_StatBuf *statBufPtr,
	Tcl_GlobTypeData *types);
#endif

#if !defined(_WIN32)
#   undef TclpGetPid
#   define TclpGetPid(pid) ((size_t)(pid))
#endif

#endif /* _TCLINTPLATDECLS */

Changes to generic/tclInterp.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation and
 *	manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation and
 *	manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 2004 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(scriptObj, &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {






|
















|







4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) Tcl_GetStringFromObj(scriptObj, &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
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
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds must be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {






|
















|

















|







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
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds must be at least 0", -1));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {

Changes to generic/tclLink.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 Rene Zaumseil
 * Copyright (c) 2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"







|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 *
 * Copyright © 1993 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2008 Rene Zaumseil
 * Copyright © 2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclTomMath.h"
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
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) {






|







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *str, *endPtr;

    str = Tcl_GetStringFromObj(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) {
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
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] == '+');






|







675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    size_t length;
    const char *str = Tcl_GetStringFromObj(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] == '+');
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 {






|







|














|







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 = Tcl_GetStringFromObj(valueObj, &valueLength);
	pp = (char **) linkPtr->addr;

	*pp = (char *)Tcl_Realloc(*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 {

Changes to generic/tclListObj.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

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




|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1998 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    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) {






|







536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
    ListGetIntRep(listPtr, listRepPtr);

    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
    }

    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;






|







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t 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;
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
    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;






|







835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    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;






|







892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *intPtr = 0;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
	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);






|







969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	size_t 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);
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
    }

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






|







1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
    }

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t 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);
	    }
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
	    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.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);






|







2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	int estCount;
	size_t length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);
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
	 */

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







|












|







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

	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = Tcl_GetStringFromObj(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 = Tcl_GetStringFromObj(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);

Changes to generic/tclLiteral.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclLiteral.c --
 *
 *	Implementation of the global and ByteCode-local literal tables used to
 *	manage the Tcl objects created for literal values during compilation
 *	of Tcl scripts. This implementation borrows heavily from the more
 *	general hashtable implementation of Tcl hash tables that appears in
 *	tclHash.c.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"








|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
/*
 * tclLiteral.c --
 *
 *	Implementation of the global and ByteCode-local literal tables used to
 *	manage the Tcl objects created for literal values during compilation
 *	of Tcl scripts. This implementation borrows heavily from the more
 *	general hashtable implementation of Tcl hash tables that appears in
 *	tclHash.c.
 *
 * Copyright © 1997-1998 Sun Microsystems, Inc.
 * Copyright © 2004 Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	     * 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
		 */






|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
	     * 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 = Tcl_GetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it
		 */
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
{
    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;
	}
    }






|







506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *entryPtr;
    const char *bytes;
    size_t globalHash, length;

    bytes = Tcl_GetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);
    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;






|







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

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = Tcl_GetStringFromObj(newObjPtr, &length);
    localHash = HashString(bytes, length) & localTablePtr->mask;
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
		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;






|







700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = Tcl_GetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
    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.
     */






|







829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
    size_t length, index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = Tcl_GetStringFromObj(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.
     */
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetStringFromObj(entryPtr->objPtr, &length);
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}






|







1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
    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");






|







1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
    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 = Tcl_GetStringFromObj(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");
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
    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");






|







1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
    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 = Tcl_GetStringFromObj(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");

Changes to generic/tclLoad.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same on all
 *	platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclLoad.c --
 *
 *	This file provides the generic portion (those that are the same on all
 *	platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

298
299
300
301
302
303
304

305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335












336
337
338
339
340
341
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
361
362
363
364
	/*
	 * 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 = TclGetString(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__ */
	    if ((pkgGuess[0] == 't') && (pkgGuess[1] == 'c')
		    && (pkgGuess[2] == 'l')) {
		pkgGuess += 3;
	    }
	    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.
	 */
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
	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






|

















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







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

Changes to generic/tclLoadNone.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclpDlopen for use in
 *	systems that don't support dynamic loading; it just returns an error.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
/*
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclpDlopen for use in
 *	systems that don't support dynamic loading; it just returns an error.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
    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.
 */

#ifdef TCL_LOAD_FROM_MEMORY

MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
    Tcl_Interp *interp,		/* Dummy: unused by this implementation */
    int size)			/* Dummy: unused by this implementation */
{
    return NULL;
}

MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Dummy: unused by this implementation */
    int size,			/* Dummy: unused by this implementation */
    int codeSize,		/* Dummy: unused by this implementation */
    Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
    Tcl_FSUnloadFileProc **unloadProcPtr,
				/* Dummy: unused by this implementation */
    int flags)
				/* Dummy: unused by this implementation */
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
		"is not available on this system", -1));
    }
    return TCL_ERROR;
}






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











|
|







|
|
|
|
|
<
|
<







48
49
50
51
52
53
54






























55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79

80

81
82
83
84
85
86
87
    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.
 */

#ifdef TCL_LOAD_FROM_MEMORY

MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int))
{
    return NULL;
}

MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    TCL_UNUSED(void *),
    TCL_UNUSED(int),
    TCL_UNUSED(int),
    TCL_UNUSED(Tcl_LoadHandle *),
    TCL_UNUSED(Tcl_FSUnloadFileProc **),

    TCL_UNUSED(int))

{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
		"is not available on this system", -1));
    }
    return TCL_ERROR;
}

Changes to generic/tclMain.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *	This file contains a generic main program for Tcl shells and other
 *	Tcl-based applications. It can be used as-is for many applications,
 *	just by supplying a different appInitProc function for each specific
 *	application. Or, it can be used as a template for creating new main
 *	programs for Tcl applications.
 *
 * Copyright (c) 1988-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2000 Ajuba Solutions.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * On Windows, this file needs to be compiled twice, once with UNICODE and









|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
/*
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *	This file contains a generic main program for Tcl shells and other
 *	Tcl-based applications. It can be used as-is for many applications,
 *	just by supplying a different appInitProc function for each specific
 *	application. Or, it can be used as a template for creating new main
 *	programs for Tcl applications.
 *
 * Copyright © 1988-1994 The Regents of the University of California.
 * Copyright © 1994-1997 Sun Microsystems, Inc.
 * Copyright © 2000 Ajuba Solutions.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * On Windows, this file needs to be compiled twice, once with UNICODE and
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).
 */

#if defined _MSC_VER && _MSC_VER < 1900
/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int	isatty(int fd);
#endif

/*
 * The thread-local variables for this file's functions.
 */

typedef struct {
    Tcl_Obj *path;		/* The filename of the script for *_Main()
				 * routines to [source] as a startup script,






<
<
<
<
<







60
61
62
63
64
65
66





67
68
69
70
71
72
73
/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).
 */






/*
 * The thread-local variables for this file's functions.
 */

typedef struct {
    Tcl_Obj *path;		/* The filename of the script for *_Main()
				 * routines to [source] as a startup script,
512
513
514
515
516
517
518
519
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);
	    }






|
















|







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    (void)Tcl_GetStringFromObj(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)Tcl_GetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
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.






|







768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    (void)T