Tcl Source Code

Check-in [4d59245e22]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | core-8-7-a3-rc
Files: files | file ages | folders
SHA3-256:4d59245e2227e9870e53923dbe7e869f4b653f85072b70f37d648ef590fb27fb
User & Date: dgp 2019-05-17 14:42:44
Context
2019-05-17
14:42
merge 8.7 Leaf check-in: 4d59245e22 user: dgp tags: core-8-7-a3-rc
10:40
merge 8.6 check-in: 645515e90f user: sebres tags: core-8-branch
2019-02-25
17:46
merge 8.7 check-in: cbfa90dcb2 user: dgp tags: core-8-7-a3-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to .fossil-settings/ignore-glob.

15
16
17
18
19
20
21


22
23
24
25
26

27
28
29

30
31
32
33
34
35
36
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc


html
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src

libtommath/*.pdf
libtommath/*.pl
libtommath/*.sh

libtommath/tombc/*
libtommath/pre_gen/*
libtommath/pics/*
libtommath/mtest/*
libtommath/logs/*
libtommath/etc/*
libtommath/demo/*







>
>





>



>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc
*/libtcl.vfs
*/libtcl_*.zip
html
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.log
libtommath/*.pdf
libtommath/*.pl
libtommath/*.sh
libtommath/doc/*
libtommath/tombc/*
libtommath/pre_gen/*
libtommath/pics/*
libtommath/mtest/*
libtommath/logs/*
libtommath/etc/*
libtommath/demo/*

Changes to .travis.yml.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62



































63
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
..
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
...
106
107
108
109
110
111
112
































































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




























































130
131
132
133
134
135
136
137
138
sudo: false
language: c

matrix:
  include:
    - os: linux
      dist: trusty
      compiler: clang
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: clang
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: gcc
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: gcc
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: gcc-4.9
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-4.9
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: gcc-5
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-5
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: trusty
      compiler: gcc-6
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-6
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: trusty



































      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix

    - os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=unix
    - os: osx
      osx_image: xcode8
      env:
................................................................................
        - NO_DIRECT_CONFIGURE=1
    - os: osx
      osx_image: xcode9
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
    - os: osx
      osx_image: xcode10
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
### C builds not currently supported on Windows instances
#    - os: windows
#      env:
#        - BUILD_DIR=win
### ... so proxy with a Mingw cross-compile
# Test with mingw-w64 (32 bit)
    - os: linux
      dist: trusty
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
................................................................................
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT=--host=i686-w64-mingw32
        - NO_DIRECT_TEST=1
































































# Test with mingw-w64 (64 bit)
    - os: linux
      dist: trusty
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1





























































before_install:
  - export ERROR_ON_FAILURES=1
  - cd ${BUILD_DIR}
install:
  - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
  - make
  # The styles=develop avoids some weird problems on OSX
  - test -n "$NO_DIRECT_TEST" || make test styles=develop






|




|





|




|





|










|










|










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









>







 







|










|







 







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


|













<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
sudo: false
language: c

matrix:
  include:
    - os: linux
      dist: xenial
      compiler: clang
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: clang
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc
      env:
        - CFGOPT=--disable-shared
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc-4.9
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-4.9
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc-5
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-5
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc-6
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-6
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
    - os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=6
    - os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_UTF_MAX=3
    - os: linux
      dist: xenial
      compiler: gcc-7
      addons:
        apt:
          sources:
            - ubuntu-toolchain-r-test
          packages:
            - g++-7
      env:
        - BUILD_DIR=unix
        - CFGOPT=CFLAGS=-DTCL_NO_DEPRECATED=1
    - os: osx
      osx_image: xcode8
      env:
        - BUILD_DIR=unix
    - os: osx
      osx_image: xcode8
      env:
................................................................................
        - NO_DIRECT_CONFIGURE=1
    - os: osx
      osx_image: xcode9
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
    - os: osx
      osx_image: xcode10.2
      env:
        - BUILD_DIR=macosx
        - NO_DIRECT_CONFIGURE=1
### C builds not currently supported on Windows instances
#    - os: windows
#      env:
#        - BUILD_DIR=win
### ... so proxy with a Mingw cross-compile
# Test with mingw-w64 (32 bit)
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
................................................................................
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT=--host=i686-w64-mingw32
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=3"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_NO_DEPRECATED=1"
        - NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1

    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
        - NO_DIRECT_TEST=1
before_install:
  - export ERROR_ON_FAILURES=1
  - cd ${BUILD_DIR}
install:
  - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
  - make
  # The styles=develop avoids some weird problems on OSX
  - test -n "$NO_DIRECT_TEST" || make test styles=develop

Changes to doc/LinkVar.3.

5
6
7
8
9
10
11
12
13
14
15
16
17
18





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





32

33
34
35
36
37
38










39
40




41
42
43
44
45
46
47
48
49
50
51
52
53
54







55

56
57
58
59

60
61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
78

79
80
81
82
83
84
85






86







87

88
89
90
91
92
93
94
95






96








97

98
99
100
101
102
103
104
105
106

107
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151
152
153
154


155
156
157
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198
199

200
201
202
203
204
205
206
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)





.sp
\fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
.sp
\fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
.SH ARGUMENTS
.AS Tcl_Interp writable
.AP Tcl_Interp *interp in
Interpreter that contains \fIvarName\fR.
Also used by \fBTcl_LinkVar\fR to return error messages.
.AP "const char" *varName in
Name of global variable.
.AP char *addr in
Address of C variable that is to be linked to \fIvarName\fR.





.AP int type in

Type of C variable.  Must be one of \fBTCL_LINK_INT\fR,
\fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
\fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
\fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR,
\fBTCL_LINK_DOUBLE\fR, \fBTCL_LINK_BOOLEAN\fR, or










\fBTCL_LINK_STRING\fR, optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR
to make Tcl variable read-only.




.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
named by \fIvarName\fR in sync with the C variable at the address
given by \fIaddr\fR.
Whenever the Tcl variable is read the value of the C variable will
be returned, and whenever the Tcl variable is written the C
variable will be updated to have the same value.
\fBTcl_LinkVar\fR normally returns \fBTCL_OK\fR;  if an error occurs
while setting up the link (e.g. because \fIvarName\fR is the
name of array) then \fBTCL_ERROR\fR is returned and the interpreter's result
contains an error message.
.PP







The \fItype\fR argument specifies the type of the C variable,

and must have one of the following values, optionally OR'ed with
\fBTCL_LINK_READ_ONLY\fR:
.TP
\fBTCL_LINK_INT\fR

The C variable is of type \fBint\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_UINT\fR

The C variable is of type \fBunsigned int\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned int\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_CHAR\fR

The C variable is of type \fBchar\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBchar\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.






.TP







\fBTCL_LINK_UCHAR\fR

The C variable is of type \fBunsigned char\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned char\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.






.TP








\fBTCL_LINK_SHORT\fR

The C variable is of type \fBshort\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBshort\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_USHORT\fR

The C variable is of type \fBunsigned short\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned short\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_LONG\fR

The C variable is of type \fBlong\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write
non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_ULONG\fR

The C variable is of type \fBunsigned long\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned long\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_DOUBLE\fR

The C variable is of type \fBdouble\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer or real representations (like the
empty string, '.', '+', '-' or the hex/octal/binary prefix) are
accepted as if they are valid too.
.TP
\fBTCL_LINK_FLOAT\fR

The C variable is of type \fBfloat\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
range acceptable for a \fBfloat\fR; attempts to
write non-real values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
or real representations (like the empty string, '.', '+', '-' or
the hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_WIDE_INT\fR


The C variable is of type \fBTcl_WideInt\fR (which is an integer type
at least 64-bits wide on all platforms that can support it.)
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_WIDE_UINT\fR

The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned
integer type at least 64-bits wide on all platforms that can support
it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR

The C variable is of type \fBint\fR.
If its value is zero then it will read from Tcl as
.QW 0 ;
otherwise it will read from Tcl as
.QW 1 .
Whenever \fIvarName\fR is
modified, the C variable will be set to a 0 or 1 value.
Any value written into the Tcl variable must have a proper boolean
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR

The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .

.PP
If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
variable will be read-only from Tcl, so that its value can only be
changed by modifying the C variable.
Attempts to write the variable from Tcl will be rejected with errors.
.PP
\fBTcl_UnlinkVar\fR removes the link previously set up for the







|






>
>
>
>
>





|





|

>
>
>
>
>

>
|



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














>
>
>
>
>
>
>

>




>
|








>
|









>
|






>
>
>
>
>
>

>
>
>
>
>
>
>

>
|







>
>
>
>
>
>

>
>
>
>
>
>
>
>

>
|








>
|









>
|








>
|









>
|








>
|









>
>
|









>
|
|
|










>
|












>









>







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LinkArray, Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)
.sp
.VS "TIP 312"
int
\fBTcl_LinkArray\fR(\fIinterp, varName, addr, type, size\fR)
.VE "TIP 312"
.sp
\fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
.sp
\fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
.SH ARGUMENTS
.AS Tcl_Interp varName in
.AP Tcl_Interp *interp in
Interpreter that contains \fIvarName\fR.
Also used by \fBTcl_LinkVar\fR to return error messages.
.AP "const char" *varName in
Name of global variable.
.AP void *addr in
Address of C variable that is to be linked to \fIvarName\fR.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, may be NULL to tell Tcl to create the storage
for the array in the variable.
.VE "TIP 312"
.AP int type in
Type of C variable for \fBTcl_LinkVar\fR or type of array element for
\fBTcl_LinkArray\fR.  Must be one of \fBTCL_LINK_INT\fR,
\fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
\fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
\fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR, \fBTCL_LINK_DOUBLE\fR,
\fBTCL_LINK_BOOLEAN\fR, or one of the extra ones listed below.
.sp
In \fBTcl_LinkVar\fR, the additional linked type \fBTCL_LINK_STRING\fR may be
used.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP int size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
named by \fIvarName\fR in sync with the C variable at the address
given by \fIaddr\fR.
Whenever the Tcl variable is read the value of the C variable will
be returned, and whenever the Tcl variable is written the C
variable will be updated to have the same value.
\fBTcl_LinkVar\fR normally returns \fBTCL_OK\fR;  if an error occurs
while setting up the link (e.g. because \fIvarName\fR is the
name of array) then \fBTCL_ERROR\fR is returned and the interpreter's result
contains an error message.
.PP
.VS "TIP 312"
\fBTcl_LinkArray\fR is similar, but for arrays of fixed size (given by
the \fIsize\fR argument). When asked to allocate the backing C array
storage (via the \fIaddr\fR argument being NULL), it writes the
address that it allocated to the Tcl interpreter result.
.VE "TIP 312"
.PP
The \fItype\fR argument specifies the type of the C variable,
or the type of the elements of the C array,
and must have one of the following values, optionally OR'ed with
\fBTCL_LINK_READ_ONLY\fR:
.TP
\fBTCL_LINK_INT\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_UINT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned int\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned int\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_CHAR\fR
.
The C variable, or each element of the C array, is of type \fBchar\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBchar\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_CHARS\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_CHARS\fR
.VS "TIP 312"
The C array is of type \fBchar *\fR and is mapped into Tcl as a string.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_UCHAR\fR
.
The C variable, or each element of the C array, is of type \fBunsigned char\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned char\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_BYTES\fR
.VS "TIP 312"
The C array is of type \fBunsigned char *\fR and is mapped into Tcl
as a bytearray.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_SHORT\fR
.
The C variable, or each element of the C array, is of type \fBshort\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBshort\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_USHORT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned short\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned short\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_LONG\fR
.
The C variable, or each element of the C array, is of type \fBlong\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write
non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_ULONG\fR
.
The C variable, or each element of the C array, is of type \fBunsigned long\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned long\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_DOUBLE\fR
.
The C variable, or each element of the C array, is of type \fBdouble\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer or real representations (like the
empty string, '.', '+', '-' or the hex/octal/binary prefix) are
accepted as if they are valid too.
.TP
\fBTCL_LINK_FLOAT\fR
.
The C variable, or each element of the C array, is of type \fBfloat\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
range acceptable for a \fBfloat\fR; attempts to
write non-real values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
or real representations (like the empty string, '.', '+', '-' or
the hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_WIDE_INT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideInt\fR
(which is an integer type
at least 64-bits wide on all platforms that can support it.)
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
If its value is zero then it will read from Tcl as
.QW 0 ;
otherwise it will read from Tcl as
.QW 1 .
Whenever \fIvarName\fR is
modified, the C variable will be set to a 0 or 1 value.
Any value written into the Tcl variable must have a proper boolean
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR
.
The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .
This is only supported by \fBTcl_LinkVar\fR.
.PP
If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
variable will be read-only from Tcl, so that its value can only be
changed by modifying the C variable.
Attempts to write the variable from Tcl will be rejected with errors.
.PP
\fBTcl_UnlinkVar\fR removes the link previously set up for the

Changes to doc/Tcl.n.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(see below) unless quoted.
.IP "[2] \fBEvaluation.\fR"
A command is evaluated in two steps.
First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.
These substitutions are performed in the same way for all
commands.
Secondly, the first word is used to locate a command procedure to
carry out the command, then all of the words of the command are
passed to the command procedure.
The command procedure is free to interpret each of its words
in any way it likes, such as an integer, variable name, list,
or Tcl script.
Different commands interpret their words differently.
.IP "[3] \fBWords.\fR"
Words of a command are separated by white space (except for
newlines, which are command separators).
.IP "[4] \fBDouble quotes.\fR"







|
|
|
|







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(see below) unless quoted.
.IP "[2] \fBEvaluation.\fR"
A command is evaluated in two steps.
First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.
These substitutions are performed in the same way for all
commands.
Secondly, the first word is used to locate a routine to
carry out the command, and the remaining words of the command are
passed to that routine.
The routine is free to interpret each of its words
in any way it likes, such as an integer, variable name, list,
or Tcl script.
Different commands interpret their words differently.
.IP "[3] \fBWords.\fR"
Words of a command are separated by white space (except for
newlines, which are command separators).
.IP "[4] \fBDouble quotes.\fR"

Changes to doc/ToUpper.3.

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
\fBTcl_UtfToLower\fR is the same as \fBTcl_UtfToUpper\fR except it
turns each character in the string into its lower-case equivalent.
.PP
\fBTcl_UtfToTitle\fR is the same as \fBTcl_UtfToUpper\fR except it
turns the first character in the string into its title-case equivalent
and all following characters into their lower-case equivalents.

.SH BUGS
.PP
At this time, the case conversions are only defined for the ISO8859-1
characters.  Unicode characters above 0x00ff are not modified by these
routines.

.SH KEYWORDS
utf, unicode, toupper, tolower, totitle, case







<
<
<
<
<
<


74
75
76
77
78
79
80






81
82
\fBTcl_UtfToLower\fR is the same as \fBTcl_UtfToUpper\fR except it
turns each character in the string into its lower-case equivalent.
.PP
\fBTcl_UtfToTitle\fR is the same as \fBTcl_UtfToUpper\fR except it
turns the first character in the string into its title-case equivalent
and all following characters into their lower-case equivalents.







.SH KEYWORDS
utf, unicode, toupper, tolower, totitle, case

Changes to doc/TraceVar.3.

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP
A trace procedure can be called at any time, even when there
is a partially formed result in the interpreter's result area.  If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must save the original values of
the interpreter's \fBresult\fR and \fBfreeProc\fR fields and restore
them before it returns.
.SH "UNDEFINED VARIABLES"
.PP
It is legal to set a trace on an undefined variable.
The variable will still appear to be undefined until the
first time its value is set.
If an undefined variable is traced and then unset, the unset will fail
with an error







|

|
|
|







327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP
A trace procedure can be called at any time, even when there
are partially formed results stored in the interpreter.  If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR
and related routines to save and restore the original state of
the interpreter before it returns.
.SH "UNDEFINED VARIABLES"
.PP
It is legal to set a trace on an undefined variable.
The variable will still appear to be undefined until the
first time its value is set.
If an undefined variable is traced and then unset, the unset will fail
with an error

Changes to doc/Utf.3.

129
130
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
.PP
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
represent one Unicode character in the UTF-8 representation.
.PP
\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
in starting at \fIbuf\fR.  The return value is the number of bytes stored
in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then
the return value will be 0 and nothing will be stored. If you still
want to produce UTF-8 output for it (even though knowing it's an illegal
code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.

.PP
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
number of bytes read from \fIsrc\fR.  The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen.  If the input is







|
|
|
>







129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
.PP
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
represent one Unicode character in the UTF-8 representation.
.PP
\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
in starting at \fIbuf\fR.  The return value is the number of bytes stored
in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then
the return value will be 1 and a single byte in the range 0xF0 - 0xF4
will be stored. If you still want to produce UTF-8 output for it (even
though knowing it's an illegal code-point on its own), just call
\fBTcl_UniCharToUtf\fR again specifying ch = -1.
.PP
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
number of bytes read from \fIsrc\fR.  The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen.  If the input is

Changes to doc/array.n.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray default \fIsubcommand arrayName args...\fR
.VS TIP508
Manages the default value of the array. Arrays initially have no default
value, but this command allows you to set one; the default value will be
returned when reading from an element of the array \farrayName\fR if the read
would otherwise result in an error. Note that this may cause the \fBappend\fR,
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
relation to non-existing array elements.
.RS
.PP
The \fIsubcommand\fR argument controls what exact operation will be performed
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray default \fIsubcommand arrayName args...\fR
.VS TIP508
Manages the default value of the array. Arrays initially have no default
value, but this command allows you to set one; the default value will be
returned when reading from an element of the array \fIarrayName\fR if the read
would otherwise result in an error. Note that this may cause the \fBappend\fR,
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
relation to non-existing array elements.
.RS
.PP
The \fIsubcommand\fR argument controls what exact operation will be performed
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:

Changes to doc/cookiejar.n.

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
\fB\-vacuumtrigger \fIdeletionCount\fR
.
A count of the number of persistent cookie deletions to go between vacuuming
the database.
.RE
.PP
Cookie jar instances may be made with any of the standard TclOO instance
creation methods (\fBcreate\fR or \fRnew\fR).
.TP
\fB::http::cookiejar new\fR ?\fIfilename\fR?
.
If a \fIfilename\fR argument is provided, it is the name of a file containing
an SQLite database that will contain the persistent cookies maintained by the
cookie jar; the database will be created if the file does not already
exist. If \fIfilename\fR is not supplied, the database will be held entirely within







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
\fB\-vacuumtrigger \fIdeletionCount\fR
.
A count of the number of persistent cookie deletions to go between vacuuming
the database.
.RE
.PP
Cookie jar instances may be made with any of the standard TclOO instance
creation methods (\fBcreate\fR or \fBnew\fR).
.TP
\fB::http::cookiejar new\fR ?\fIfilename\fR?
.
If a \fIfilename\fR argument is provided, it is the name of a file containing
an SQLite database that will contain the persistent cookies maintained by the
cookie jar; the database will be created if the file does not already
exist. If \fIfilename\fR is not supplied, the database will be held entirely within

Changes to doc/define.n.

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
...
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
...
432
433
434
435
436
437
438
439

440

441
442
443
444
445
446
447
...
451
452
453
454
455
456
457
458


459
460
461
462
463
464
465
466
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
omitted) promotes an existing method on the class object to be a class
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
the \fBmethod\fR definition, below.
.RS
.PP
Class methods can be called on either the class itself or on the instances of
that class. When they are called, the current object (see the \fBself\R and
\fBmy\fR commands) is the class on which they are called or the class of the
instance on which they are called, depending on whether they are called on the
class or an instance of the class, respectively. If called on a subclass or
instance of the subclass, the current object is the subclass.
.PP
In a private definition context, the methods as invoked on classes are
\fInot\fR private, but the methods as invoked on instances of classes are
................................................................................
.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified).

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified). Does

not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object. Does not affect the classes that

the object is an instance of.

.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the


method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500







|







 







|
>







 







|
>







 







|
>
|
>







 







|
>
>
|







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
...
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
omitted) promotes an existing method on the class object to be a class
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
the \fBmethod\fR definition, below.
.RS
.PP
Class methods can be called on either the class itself or on the instances of
that class. When they are called, the current object (see the \fBsel\fR and
\fBmy\fR commands) is the class on which they are called or the class of the
instance on which they are called, depending on whether they are called on the
class or an instance of the class, respectively. If called on a subclass or
instance of the subclass, the current object is the subclass.
.PP
In a private definition context, the methods as invoked on classes are
\fInot\fR private, but the methods as invoked on instances of classes are
................................................................................
.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified) or the
class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
................................................................................
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified), or the
class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
................................................................................
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object (e.g., because it was created
through \fBoo::objdefine method\fR). Does not affect the classes that the
object is an instance of, or remove the exposure of those class-provided
methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
................................................................................
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of and cannot rename in an instance object the
methods provided by those classes (though a \fBoo::objdefine forward\fRed
method may provide an equivalent capability). Does not change the export
status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500

Changes to doc/dict.n.

115
116
117
118
119
120
121
















122
123
124
125
126
127
128
elements in a manner similar to \fBarray get\fR. That is, the first
element of each pair would be the key and the second element would be
the value for that key.
.PP
It is an error to attempt to retrieve a value for a key that is not
present in the dictionary.
.RE
















.TP
\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
.
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys







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







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
elements in a manner similar to \fBarray get\fR. That is, the first
element of each pair would be the key and the second element would be
the value for that key.
.PP
It is an error to attempt to retrieve a value for a key that is not
present in the dictionary.
.RE
.TP
\fBdict getdef \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.TP
\fBdict getwithdefault \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.VS "8.7, TIP342"
This behaves the same as \fBdict get\fR (with at least one \fIkey\fR
argument), returning the value that the key path maps to in the
dictionary \fIdictionaryValue\fR, except that instead of producing an
error because the \fIkey\fR (or one of the \fIkey\fRs on the key path)
is absent, it returns the \fIdefault\fR argument instead.
.RS
.PP
Note that there must always be at least one \fIkey\fR provided, and that
\fBdict getdef\fR and \fBdict getwithdefault\fR are aliases for each other.
.RE
.VE "8.7, TIP342"
.TP
\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
.
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys

Changes to doc/expr.n.

122
123
124
125
126
127
128
129

130
131
132
133
134
135
136
.
Unary minus, unary plus, bit-wise NOT, logical NOT.  These operators
may only be applied to numeric operands, and bit-wise NOT may only be
applied to integers.
.TP 20
\fB**\fR
.
Exponentiation.  Valid for numeric operands.

.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply and divide, which are valid for numeric operands, and remainder, which
is valid for integers.  The remainder, an absolute value smaller than the
absolute value of the divisor, has the same sign as the divisor.
.RS







|
>







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
.
Unary minus, unary plus, bit-wise NOT, logical NOT.  These operators
may only be applied to numeric operands, and bit-wise NOT may only be
applied to integers.
.TP 20
\fB**\fR
.
Exponentiation.  Valid for numeric operands.  The maximum exponent value
that Tcl can handle if the first number is an integer > 1 is 268435455.
.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply and divide, which are valid for numeric operands, and remainder, which
is valid for integers.  The remainder, an absolute value smaller than the
absolute value of the divisor, has the same sign as the divisor.
.RS

Changes to doc/info.n.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103


104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172
173
174
175
176
177


178
179
180
181
182
183

184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305

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


352
353
354
355
356

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



397
398

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
432



433
434
435
436
437
438
439
...
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
...
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
...
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
...
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
...
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
info \- Return information about the state of the Tcl interpreter
.SH SYNOPSIS
\fBinfo \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides information about various internals of the Tcl
interpreter.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBinfo args \fIprocname\fR
.
Returns a list containing the names of the arguments to procedure
\fIprocname\fR, in order.  \fIProcname\fR must be the name of a
Tcl command procedure.
.TP
\fBinfo body \fIprocname\fR
.
Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
.
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
\fBinfo cmdtype \fIcommandName\fR
.VS TIP426
Returns a description of the kind of command named by \fIcommandName\fR.  The
supported types are:
.RS
.IP \fBalias\fR
Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
safe interpreters can only see a subset of aliases (specifically those between
two commands within themselves).
.IP \fBcoroutine\fR
Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
.IP \fBensemble\fR
Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
.IP \fBimport\fR
Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
.IP \fBnative\fR
Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
interface directly without further registration of the type of command.
.IP \fBobject\fR
Indicates that \fIcommandName\fR is the public command that represents an
instance of \fBoo::object\fR or one of its subclasses.
.IP \fBprivateObject\fR
Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
Indicates that \fIcommandName\fR was created by \fBproc\fR.
.IP \fBslave\fR
Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
.PP
There may be other registered types as well; this is a set that is extensible
at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
.RE
.VE TIP426
.TP
\fBinfo commands \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and
the command procedures defined using the \fBproc\fR command.
If \fIpattern\fR is specified,
only those names matching \fIpattern\fR are returned.
Matching is determined using the same rules as for \fBstring match\fR.
\fIpattern\fR can be a qualified name like \fBFoo::print*\fR.
That is, it may specify a particular namespace
using a sequence of namespace names separated by double colons (\fB::\fR),
and may have pattern matching special characters
at the end to specify a set of commands in that namespace.
If \fIpattern\fR is a qualified name,
the resulting list of command names has each one qualified with the name
of the specified namespace, and only the commands defined in the named
namespace are returned.
.\" Technically, most of this hasn't changed; that's mostly just the
.\" way it always worked. Hardly anyone knew that though.


.TP
\fBinfo complete \fIcommand\fR
.
Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of
having no unclosed quotes, braces, brackets or array element names.
If the command does not appear to be complete then 0 is returned.
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).
.TP
\fBinfo default \fIprocname arg varname\fR
.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure.  If \fIarg\fR
does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
.RS
.PP
This form is an even-sized list alternating tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
introduced in the future. \fBCALL\fR indicates a procedure call, and its
parameter is the corresponding \fBinfo level\fR \fB0\fR. \fBUP\fR indicates a
shift in variable frames generated by \fBuplevel\fR or similar, and applies to
the previous \fBCALL\fR item. Its parameter is the level offset. \fBINNER\fR
identifies the
.QW "inner context" ,
which is the innermost atomic command or bytecode instruction that raised the
error, along with its arguments when available. While \fBCALL\fR and \fBUP\fR
allow to follow complex call paths, \fBINNER\fR homes in on the offending
operation in the innermost procedure call, even going to sub-expression
granularity.
.PP
This information is also present in the \fB\-errorstack\fR entry of the
options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
.TP
\fBinfo frame\fR ?\fInumber\fR?
.

This command provides access to all frames on the stack, even those
hidden from \fBinfo level\fR. If \fInumber\fR is not specified, this
command returns a number giving the frame level of the command. This
is 1 if the command is invoked at top-level. If \fInumber\fR is
specified, then the result is a dictionary containing the location
information for the command at the \fInumber\fRed level on the stack.
.RS
.PP
If \fInumber\fR is positive (> 0) then it selects a particular stack
level (1 refers to the outer-most active command, 2 to the command it
called, and so on, up to the current frame level which refers to
\fBinfo frame\fR itself); otherwise it gives a level relative to the
current command (0 refers to the current command, i.e., \fBinfo
frame\fR itself, -1 to its caller, and so on).


.PP
This is similar to how \fBinfo level\fR works, except that this
subcommand reports all frames, like \fBsource\fRd scripts,
\fBeval\fRs, \fBuplevel\fRs, etc.
.PP
Note that for nested commands, like

.QW "foo [bar [x]]" ,
only
.QW x
will be seen by an \fBinfo frame\fR invoked within
.QW x .
This is the same as for \fBinfo level\fR and error stack traces.
.PP
The result dictionary may contain the keys listed below, with the
specified meanings for their values:
.TP
\fBtype\fR
.
This entry is always present and describes the nature of the location
for the command. The recognized values are \fBsource\fR, \fBproc\fR,
\fBeval\fR, and \fBprecompiled\fR.
.RS
.TP
\fBsource\fR\0\0\0\0\0\0\0\0
.
means that the command is found in a script loaded by the \fBsource\fR
command.
.TP
\fBproc\fR\0\0\0\0\0\0\0\0
.
means that the command is found in dynamically created procedure body.

.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
means that the command is found in a pre-compiled script (loadable by
the package \fBtbcload\fR), and no further information will be
available.
.RE
.TP
\fBline\fR
.
This entry provides the number of the line the command is at inside of
the script it is a part of. This information is not present for type
\fBprecompiled\fR. For type \fBsource\fR this information is counted
relative to the beginning of the file, whereas for the last two types
the line is counted relative to the start of the script.
.TP
\fBfile\fR
.
This entry is present only for type \fBsource\fR. It provides the
normalized path of the file the command is in.
.TP
\fBcmd\fR
.
This entry provides the string representation of the command. This is
usually the unsubstituted form, however for commands which are a
canonically-constructed list (e.g., as produced by the \fBlist\fR command)
executed by \fBeval\fR it is the substituted form as they have no other
string representation. Care is taken that the canonicality property of
the latter is not spoiled.
.TP
\fBproc\fR
.
This entry is present only if the command is found in the body of a
regular Tcl procedure. It then provides the name of that procedure.
.TP
\fBlambda\fR
.
This entry is present only if the command is found in the body of an
anonymous Tcl procedure, i.e. a lambda. It then provides the entire
definition of the lambda in question.
.TP
\fBlevel\fR
.
This entry is present only if the queried frame has a corresponding
frame returned by \fBinfo level\fR. It provides the index of this
frame, relative to the current level (0 and negative numbers).
.PP
A thing of note is that for procedures statically defined in files the
locations of commands in their bodies will be reported with type
\fBsource\fR and absolute line numbers, and not as type
\fBproc\fR. The same is true for procedures nested in statically
defined procedures, and literal eval scripts in files or statically
defined procedures.
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
A different way of describing this behaviour is that file based
locations are tracked as deeply as possible, and where this is not
possible the lines are counted based on the smallest possible
\fBeval\fR or procedure body, as that scope is usually easier to find
than any dynamic outer scope.
.PP
The syntactic form \fB{*}\fR is handled like \fBeval\fR. I.e. if it
is given a literal list argument the system tracks the line number
within the list words as well, and otherwise all line numbers are
counted relative to the start of each word (smallest scope)
.RE
.TP
\fBinfo functions \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the math
functions currently defined.
If \fIpattern\fR is specified, only those functions whose name matches
\fIpattern\fR are returned.  Matching is determined using the same
rules as for \fBstring match\fR.
.TP
\fBinfo globals \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined global variables.
Global variables are variables in the global namespace.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo hostname\fR
.
Returns the name of the computer on which this invocation is being
executed.

Note that this name is not guaranteed to be the fully qualified domain
name of the host.  Where machines have several different names (as is
common on systems with both TCP/IP (DNS) and NetBIOS-based networking
installed,) it is the name that is suitable for TCP/IP networking that
is returned.
.TP
\fBinfo level\fR ?\fInumber\fR?
.
If \fInumber\fR is not specified, this command returns a number
giving the stack level of the invoking procedure, or 0 if the
command is invoked at top-level.  If \fInumber\fR is specified,
then the result is a list consisting of the name and arguments for the
procedure call at level \fInumber\fR on the stack.  If \fInumber\fR
is positive then it selects a particular stack level (1 refers
to the top-most active procedure, 2 to the procedure it called, and
so on); otherwise it gives a level relative to the current level
(0 refers to the current procedure, -1 to its caller, and so on).
See the \fBuplevel\fR command for more information on what stack
levels mean.
.TP
\fBinfo library\fR
.
Returns the name of the library directory in which standard Tcl
scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
.TP
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
.
Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR
is not specified, returns a list describing all of the packages
that have been loaded into \fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the
name of the file from which the package was loaded and the name of
the package.
For statically-loaded packages the file name will be an empty string.
If \fIinterp\fR is omitted then information is returned for all packages
loaded in any interpreter in the process.
To get a list of just the packages in the current interpreter, specify
an empty string for the \fIinterp\fR argument.
.TP
\fBinfo locals \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined local variables, including arguments to the
current procedure, if any.


Variables defined with the \fBglobal\fR, \fBupvar\fR  and
\fBvariable\fR commands will not be returned.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.

.TP
\fBinfo nameofexecutable\fR
.
Returns the full path name of the binary file from which the application
was invoked.  If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
described in \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, which holds
the exact version of the Tcl library by default.
.TP
\fBinfo procs \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the
names of Tcl command procedures in the current namespace.
If \fIpattern\fR is specified,
only those procedure names in the current namespace
matching \fIpattern\fR are returned.
Matching is determined using the same rules as for
\fBstring match\fR.
If \fIpattern\fR contains any namespace separators, they are used to
select a namespace relative to the current namespace (or relative to
the global namespace if \fIpattern\fR starts with \fB::\fR) to match
within; the matching pattern is taken to be the part after the last
namespace separator.
.TP
\fBinfo script\fR ?\fIfilename\fR?
.
If a Tcl script file is currently being evaluated (i.e. there is a
call to \fBTcl_EvalFile\fR active or there is an active invocation
of the \fBsource\fR command), then this command returns the name
of the innermost file being processed.  If \fIfilename\fR is specified,
then the return value of this command will be modified for the
duration of the active invocation to return that name.  This is



useful in virtual file system applications.
Otherwise the command returns an empty string.

.TP
\fBinfo sharedlibextension\fR
.
Returns the extension used on this platform for the names of files
containing shared libraries (for example, \fB.so\fR under Solaris).
If shared libraries are not supported on this platform then an empty
string is returned.
.TP
\fBinfo tclversion\fR
.
Returns the value of the global variable \fBtcl_version\fR, which holds the
major and minor version of the Tcl library by default.
.TP
\fBinfo vars\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
returns a list of all the names of currently-visible variables.
This includes locals and currently-visible globals.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.
\fIpattern\fR can be a qualified name like \fBFoo::option*\fR.
That is, it may specify a particular namespace
using a sequence of namespace names separated by double colons (\fB::\fR),
and may have pattern matching special characters
at the end to specify a set of variables in that namespace.

If \fIpattern\fR is a qualified name,
the resulting list of variable names
has each matching namespace variable qualified with the name
of its namespace.
Note that a currently-visible variable may not yet
.QW exist
if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).



.SS "CLASS INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.TP
\fBinfo class call\fI class method\fR
.
Returns a description of the method implementations that are used to provide a
................................................................................
\fIclass\fR, not \fIclass\fR itself. The \fIkind\fR can be either
\fB\-class\fR to return the definition namespace used for \fBoo::define\fR, or
\fB\-instance\fR to return the definition namespace used for
\fBoo::objdefine\fR; the \fB\-class\fR kind is default (though this is only
actually useful on classes that are subclasses of \fBoo::class\fR).
.RS
.PP
If \fIclass\fR does not provide a definition namespace of the specified kind,
this command returns the empty string. In those circumstances, the
\fBoo::define\fR and \fBoo::objdefine\fR commands look up which definition
namespace to use using the class inheritance hierarchy.
.RE
.VE TIP524
.TP
\fBinfo class destructor\fI class\fR
................................................................................
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
................................................................................
.TP
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
.TP
\fBinfo object call\fI object method\fR
................................................................................
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.
If \fIclassName\fR is unspecified, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
................................................................................
direct or indirect).
.RE
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
................................................................................
.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500
If the \fB\-private\fR option is specified, this lists the private variables
declared instead.
.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is







|





|
<
<



|
<
<



|
<



|
|



<
|



|
|


|
|
|

|

|

|

|


|


|


|

|

|

<
|





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



|
<
<
|
|
<
<



|
|
|

|

|
|
|
<
<



|
|
|


|

|







|
|





|




|
<
|

|

>
|
|
|
|
<
<


<
<
<
<
<
<
>
>

<
<
<
<
<
>



|

<

|
<



<
|





|




|
>



|



|
|
<




|
|
<
|
|



|
|



|
<
<
<
<
<



|
<



|
<
|



|
|
|
|
|
|
|
|
<
<







|













|

|
<
|



|


|





|
<
>
|
|

|


|

|
|
|
|
|
<
<
<
<
|
<



|
|
<
<



|
|
|
|
|
<
<
<
<
<
<



<
<
<
>
>
|
|
<
<
<
>



|
<
|



|
|



|
|



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



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



|
|
|
<



|
|



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







 







|







 







|







 







|







 







|







 







|







 







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22


23
24
25
26


27
28
29
30

31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
79











80





81
82
83
84
85
86


87
88


89
90
91
92
93
94
95
96
97
98
99
100


101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139
140


141
142






143
144
145





146
147
148
149
150
151

152
153

154
155
156

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178

179
180
181
182
183
184

185
186
187
188
189
190
191
192
193
194
195





196
197
198
199

200
201
202
203

204
205
206
207
208
209
210
211
212
213
214
215


216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
247
248
249
250
251
252
253

254
255
256
257
258
259
260
261
262
263
264
265
266
267




268

269
270
271
272
273


274
275
276
277
278
279
280
281






282
283
284



285
286
287
288



289
290
291
292
293

294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312







313
314
315






316
317
318
319

320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335
336



337





338
339







340
341
342
343
344
345
346
347
348
349
...
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
...
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
...
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
...
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
...
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
...
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
info \- Information about the state of the Tcl interpreter
.SH SYNOPSIS
\fBinfo \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
Available commands:


.TP
\fBinfo args \fIprocname\fR
.
Returns the names of the parameters to the procedure named \fIprocname\fR.


.TP
\fBinfo body \fIprocname\fR
.
Returns the body of the procedure named \fIprocname\fR.

.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
.
Returns information about the class named \fIclass\fR.
See \fBCLASS INTROSPECTION\fR below.
.TP
\fBinfo cmdcount\fR
.

Returns the total number of commands evaluated in this interpreter.
.TP
\fBinfo cmdtype \fIcommandName\fR
.VS TIP426
Returns a the type of the command named \fIcommandName\fR.
Built-in types are:
.RS
.IP \fBalias\fR
\fIcommandName\fR was created by \fBinterp alias\fR.
In a safe interpreter an alias is only visible if both the alias and the
target are visible.
.IP \fBcoroutine\fR
\fIcommandName\fR was created by \fBcoroutine\fR.
.IP \fBensemble\fR
\fIcommandName\fR was created by \fBnamespace ensemble\fR.
.IP \fBimport\fR
\fIcommandName\fR was created by \fBnamespace import\fR.
.IP \fBnative\fR
\fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
interface directly without further registration of the type of command.
.IP \fBobject\fR
\fIcommandName\fR is the public command that represents an
instance of \fBoo::object\fR or one of its subclasses.
.IP \fBprivateObject\fR
\fIcommandName\fR is the private command, \fBmy\fR by default,
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
\fIcommandName\fR was created by \fBproc\fR.
.IP \fBslave\fR
\fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
\fIcommandName\fR was created by \fBzlib stream\fR.
.PP

Other types may be also registered as well.  See \fBTcl_RegisterCommandTypeName\fR.
.RE
.VE TIP426
.TP
\fBinfo commands \fR?\fIpattern\fR?
.
Returns the names of all commands visible in the current namespace.  If
\fIpattern\fR is given, returns only those names that match according to











\fBstring match\fR.  Only the last component of \fIpattern\fR is a pattern.





Other components identify a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.
.TP
\fBinfo complete \fIcommand\fR
.
Returns 1 if \fIcommand\fR is a complete command, and \fB0\fR otherwise.


Typically used in line-oriented input environments
to allow users to type in commands that span multiple lines.


.TP
\fBinfo coroutine\fR
.
Returns the name of the current \fBcoroutine\fR, or the empty
string if there is no current coroutine or the current coroutine
has been deleted.
.TP
\fBinfo default \fIprocname parameter varname\fR
.
If the parameter \fIparameter\fR for the procedure named \fIprocname\fR has a
default value, stores that value in \fIvarname\fR and returns \fB1\fR.
Otherwise, returns \fB0\fR.


.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.
Returns a description of the active command at each level for the
last error in the current interpreter, or in the interpreter named
\fIinterp\fR if given.
.RS
.PP
The description is a dictionary of tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
introduced in the future. \fBCALL\fR indicates a command call, and its
parameter is the corresponding \fBinfo level\fR \fB0\fR. \fBUP\fR indicates a
shift in variable frames generated by \fBuplevel\fR or similar, and applies to
the previous \fBCALL\fR item. Its parameter is the level offset. \fBINNER\fR
identifies the
.QW "inner context" ,
which is the innermost atomic command or bytecode instruction that raised the
error, along with its arguments when available. While \fBCALL\fR and \fBUP\fR
provide a trail of the call path, \fBINNER\fR provides details of the offending
operation in the innermost procedure call, even to sub-expression
granularity.
.PP
This information is also present in the \fB\-errorstack\fR entry of the
options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBinterpreter\fR.
.RE
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if a variable named \fIvarName\fR is visible and has been

defined, and \fB0\fR otherwise.
.TP
\fBinfo frame\fR ?\fIdepth\fR?
.
Returns the depth of the call to \fBinfo frame\fR itself.  Otherwise, returns a
dictionary describing the active command at the \fIdepth\fR, which counts all
commands visible to \fBinfo level\fR, plus commands that don't create a new
level, such as \fBeval\fR, \fBsource\fR, or \fIuplevel\fR. The frame depth is
always greater than the current level.


.RS
.PP






If \fIdepth\fR is greater than \fB0\fR it is the frame at that depth.  Otherwise
it is the number of frames up from the current frame.
.PP





As with \fBinfo level\fR and error traces, for nested commands like
.QW "foo [bar [x]]" ,
only
.QW x
is seen by \fBinfo frame\fR invoked within
.QW x .

.PP
The dictionary may contain the following keys:

.TP
\fBtype\fR
.

Always present.  Possible values are \fBsource\fR, \fBproc\fR,
\fBeval\fR, and \fBprecompiled\fR.
.RS
.TP
\fBsource\fR\0\0\0\0\0\0\0\0
.
A script loaded via the \fBsource\fR
command.
.TP
\fBproc\fR\0\0\0\0\0\0\0\0
.
The body of a procedure that could not be traced back to a
line in a particular script.
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
The body of a script provided to \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
A pre-compiled script (loadable by the package
\fBtbcload\fR), and no further information is available.

.RE
.TP
\fBline\fR
.
The line number of of the command inside its script.  Not available for
\fBprecompiled\fR commands.  When the type is \fBsource\fR, the line number is

relative to the beginning of the file, whereas for the last two types it is
relative to the start of the script.
.TP
\fBfile\fR
.
For type \fBsource\fR, provides the normalized path of the file that contains
the command.
.TP
\fBcmd\fR
.
The command before substitutions were performed.





.TP
\fBproc\fR
.
For type \fBprod\fR, the name of the procedure containing the command.

.TP
\fBlambda\fR
.
For a command in a script evaluated as the body of an unnamed routine via the

\fBapply\fR command, the definition of that routine.
.TP
\fBlevel\fR
.
For a frame that corresponds to a level, (to be determined).
.PP
When a command can be traced to its literal definition in some script, e.g.
procedures nested in statically defined procedures, and literal eval scripts in
files or statically defined procedures, its type is \fBsource\fR and its
location is the absolute line number in the script.  Otherwise, its type is
\fBproc\fR and its location is its line number within the body of the
procedure.


.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
A different way of describing this behaviour is that file-based
locations are tracked as deeply as possible, and where this is not
possible the lines are counted based on the smallest possible
\fBeval\fR or procedure body, as that scope is usually easier to find
than any dynamic outer scope.
.PP
The syntactic form \fB{*}\fR is handled like \fBeval\fR. I.e. if it
is given a literal list argument the system tracks the line number
within the list words as well, and otherwise all line numbers are
counted relative to the start of each word (smallest scope)
.RE
.TP
\fBinfo functions \fR?\fIpattern\fR?
.
If \fIpattern\fR is not given, returns a list of all the math
functions currently defined.
If \fIpattern\fR is given, returns only those names that match

\fIpattern\fR according to \fBstring match\fR.
.TP
\fBinfo globals \fR?\fIpattern\fR?
.
If \fIpattern\fR is not given, returns a list of all the names
of currently-defined global variables.
Global variables are variables in the global namespace.
If \fIpattern\fR is given, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo hostname\fR
.
Returns the name of the current host.


This name is not guaranteed to be the fully-qualified domain
name of the host.  Where machines have several different names, as is
common on systems with both TCP/IP (DNS) and NetBIOS-based networking
installed, it is the name that is suitable for TCP/IP networking that
is returned.
.TP
\fBinfo level\fR ?\fIlevel\fR?
.
If \fInumber\fR is not given, the level this routine was called from.
Otherwise returns the complete command active at the given level.  If
\fInumber\fR is greater than \fB0\fR, it is the desired level.  Otherwise, it
is \fInumber\fR levels up from the current level.  A complete command is the
words in the command, with all subsitutions performed, meaning that it is a




list.  See \fBuplevel\fR for more information on levels.

.TP
\fBinfo library\fR
.
Returns the value of \fBtcl_library\fR, which is the name of the library
directory in which the scripts distributed with Tcl scripts are stored.


.TP
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
.
Returns the name of each file loaded in \fIinterp\fR va \fBload\fR as part of
\fIpackage\fR .  If \fIpackage\fR is not given, returns a list where each item
is the name of the loaded file and the name of the package for which the file
was loaded.  For a statically-loaded package the name of the file is the empty
string.  For \fInterp\fR, the empty string is the current interpreter.






.TP
\fBinfo locals \fR?\fIpattern\fR?
.



If \fIpattern\fR is given, returns the name of each local variable matching
\fIpattern\fR according to \fBstring match\fR.  Otherwise, returns the name of
each local variable.  A variables defined with the \fBglobal\fR, \fBupvar\fR or
\fBvariable\fR is not local.




.TP
\fBinfo nameofexecutable\fR
.
Returns the absolute pathname of the program for the current interpreter.  If

such a file can not be identified an empty string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
Returns information about the object named \fIobject\fR. \fIsubcommand\fR is
described \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, in which the
exact version of the Tcl library initially stored.
.TP
\fBinfo procs \fR?\fIpattern\fR?
.
Returns the names of all visible procedures. If \fIpattern\fR is given, returns
only those names that match according to \fBstring match\fR.  Only the final
component in \fIpattern\fR is actually considered a pattern.  Any qualifying
components simply select a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.







.TP
\fBinfo script\fR ?\fIfilename\fR?
.






Returns the pathname of the innermost script currently being evaluated, or the
empty string if no pathname can be determined.  If \fIfilename\fR is given,
sets the return value of any future calls to \fBinfo script\fR for the duration
of the innermost active script.  This is useful in virtual file system

applications.
.TP
\fBinfo sharedlibextension\fR
.
Returns the extension used on this platform for names of shared libraries, e.g.
\fB.so\fR under Solaris.  Returns the empty string if shared libraries are not
supported on this platform.

.TP
\fBinfo tclversion\fR
.
Returns the value of the global variable \fBtcl_version\fR, in which the
major and minor version of the Tcl library are stored.
.TP
\fBinfo vars\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not given, returns the names of all visible variables.  If
\fIpattern\fR is given, returns only those names that match according to



\fBstring match\fR.  Only the last component of \fIpattern\fR is a pattern.





Other components identify a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.  When \fIpattern\fR is a qualified name,







results are fully qualified.

A variable that has declared but not yet defined is included in the results.
.SS "CLASS INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.TP
\fBinfo class call\fI class method\fR
.
Returns a description of the method implementations that are used to provide a
................................................................................
\fIclass\fR, not \fIclass\fR itself. The \fIkind\fR can be either
\fB\-class\fR to return the definition namespace used for \fBoo::define\fR, or
\fB\-instance\fR to return the definition namespace used for
\fBoo::objdefine\fR; the \fB\-class\fR kind is default (though this is only
actually useful on classes that are subclasses of \fBoo::class\fR).
.RS
.PP
If \fIclass\fR does not provide a definition namespace of the given kind,
this command returns the empty string. In those circumstances, the
\fBoo::define\fR and \fBoo::objdefine\fR commands look up which definition
namespace to use using the class inheritance hierarchy.
.RE
.VE TIP524
.TP
\fBinfo class destructor\fI class\fR
................................................................................
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
given, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
................................................................................
.TP
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is given, this lists the private variables
declared instead.
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
.TP
\fBinfo object call\fI object method\fR
................................................................................
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.
If \fIclassName\fR is not given, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
................................................................................
direct or indirect).
.RE
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
given, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
................................................................................
.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
.VS TIP500
If the \fB\-private\fR option is given, this lists the private variables
declared instead.
.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is

Changes to doc/interp.n.

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
This only effects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
.PP
For example, with code like
.PP
.CS







|







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
slave interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fB\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
This only affects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
.PP
For example, with code like
.PP
.CS

Changes to doc/lrange.n.

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
% lindex $var 1
elements to
% \fBlrange\fR $var 1 1
{elements to}
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:







|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
% lindex $var 1
elements to
% \fBlrange\fR $var 1 1
{elements to}
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lremove(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Added doc/lremove.n.















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
'\"
'\" Copyright (c) 2019 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lremove n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbirary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES
.PP
Removing the third element of a list:
.PP
.CS
% \fBlremove\fR {a b c d e} 2
a b d e
.CE
.PP
Removing two elements from a list:
.PP
.CS
% \fBlremove\fR {a b c d e} end-1 1
a c e
.CE
.PP
Removing the same element indicated in two different ways:
.PP
.CS
% \fBlremove\fR {a b c d e} 2 end-2
a b d e
.CE
.SH "SEE ALSO"
list(n), lrange(n), lsearch(n), lsearch(n)
.SH KEYWORDS
element, list, remove
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lreplace.n.

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lremove(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/mathop.n.

147
148
149
150
151
152
153

154
155
156
157
158
159
160
161
162
163
164
Returns the result of raising each value to the power of the result of
recursively operating on the result of processing the following arguments, so
.QW "\fB** 2 3 4\fR"
is the same as
.QW "\fB** 2 [** 3 4]\fR" .
Each \fInumber\fR may be
any numeric value, though the second number must not be fractional if the

first is negative. If no arguments are given, the result will be one, and if
only one argument is given, the result will be that argument. The
result will have an integral value only when all arguments are
integral values.
.SS "COMPARISON OPERATORS"
.PP
The behaviors of the comparison operator commands (most of which operate
preferentially on numeric arguments) are as follows:
.TP
\fB==\fR ?\fIarg\fR ...?
.







>
|
|
|
|







147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Returns the result of raising each value to the power of the result of
recursively operating on the result of processing the following arguments, so
.QW "\fB** 2 3 4\fR"
is the same as
.QW "\fB** 2 [** 3 4]\fR" .
Each \fInumber\fR may be
any numeric value, though the second number must not be fractional if the
first is negative.  The maximum exponent value that Tcl can handle if the
first number is an integer > 1 is 268435455. If no arguments are given,
the result will be one, and if only one argument is given, the result will
be that argument. The result will have an integral value only when all
arguments are integral values.
.SS "COMPARISON OPERATORS"
.PP
The behaviors of the comparison operator commands (most of which operate
preferentially on numeric arguments) are as follows:
.TP
\fB==\fR ?\fIarg\fR ...?
.

Changes to doc/open.n.

162
163
164
165
166
167
168
169
170

171
172
173
174
175
176
177
...
244
245
246
247
248
249
250





































































251
252
253
254
255
256
257
...
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
...
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
...
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
...
404
405
406
407
408
409
410
















































411
412
413
414
415
416
417
418
419
420
421
















422
423
424
425
426
427
428
429
430
.SH "SERIAL COMMUNICATIONS"
.PP
If \fIfileName\fR refers to a serial port, then the specified serial port
is opened and initialized in a platform-dependent manner.  Acceptable
values for the \fIfileName\fR to use to open a serial port are described in
the PORTABILITY ISSUES section.
.PP
The \fBfconfigure\fR command can be used to query and set additional
configuration options specific to serial ports (where supported):

.TP
\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
.
This option is a set of 4 comma-separated values: the baud rate, parity,
number of data bits, and number of stop bits for this serial port.  The
\fIbaud\fR rate is a simple integer that specifies the connection speed.
\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,
................................................................................
.TP
\fB\-xchar\fR \fI{xonChar xoffChar}\fR
.
(Windows and Unix). This option is used to query or change the software
handshake characters. Normally the operating system default should be
DC1 (0x11) and DC3 (0x13) representing the ASCII standard
XON and XOFF characters.





































































.TP
\fB\-pollinterval\fR \fImsec\fR
.
(Windows only). This option is used to set the maximum time between
polling for fileevents.
This affects the time interval between checking for events throughout the Tcl
interpreter (the smallest value always wins).  Use this option only if
................................................................................
\fB\-lasterror\fR
.
(Windows only). This option is query only.
In case of a serial communication error, \fBread\fR or \fBputs\fR
returns a general Tcl file I/O error.
\fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details.
See below for an explanation of the various error codes.
.SH "SERIAL PORT SIGNALS"
.PP
RS-232 is the most commonly used standard electrical interface for serial
communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and
a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C).  The
following signals are specified for incoming and outgoing data, status
lines and handshaking. Here we are using the terms \fIworkstation\fR for
your computer and \fImodem\fR for the external device, because some signal
................................................................................
.IP \fBBREAK\fR
A BREAK condition is not a hardware signal line, but a logical zero on the
TXD or RXD lines for a long period of time, usually 250 to 500
milliseconds.  Normally a receive or transmit data signal stays at the mark
(on=1) voltage until the next character is transferred. A BREAK is sometimes
used to reset the communications line or change the operating mode of
communications hardware.
.SH "ERROR CODES (Windows only)"
.PP
A lot of different errors may occur during serial read operations or during
event polling in background. The external device may have been switched
off, the data lines may be noisy, system buffers may overrun or your mode
settings may be wrong.  That is why a reliable software should always
\fBcatch\fR serial read operations.  In cases of an error Tcl returns a
general file I/O error.  Then \fBfconfigure\fR \fB\-lasterror\fR may help to
................................................................................
A stop-bit error has been detected by your UART.
Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBBREAK\fR
.
A BREAK condition has been detected by your UART (see above).
.SH "PORTABILITY ISSUES"
.TP
\fBWindows \fR
.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9.  An attempt to open a serial port that
................................................................................
not accessing the console, or if the command pipeline does not use standard
input, but is redirected from a file, then the above problem does not occur.
.RE
.PP
See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
additional information not specific to command pipelines about executing
applications on the various platforms
















































.SH "EXAMPLE"
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
    puts "ls command failed: $err"
}
.CE
















.SH "SEE ALSO"
file(n), close(n), filename(n), fconfigure(n), gets(n), read(n),
puts(n), exec(n), pid(n), fopen(3)
.SH KEYWORDS
access mode, append, create, file, non-blocking, open, permissions,
pipeline, process, serial
'\"Local Variables:
'\"mode: nroff
'\"End:







|
|
>







 







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







 







|







 







|







 







|







 







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










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









162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
...
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
.SH "SERIAL COMMUNICATIONS"
.PP
If \fIfileName\fR refers to a serial port, then the specified serial port
is opened and initialized in a platform-dependent manner.  Acceptable
values for the \fIfileName\fR to use to open a serial port are described in
the PORTABILITY ISSUES section.
.PP
The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query
and set additional configuration options specific to serial ports (where
supported):
.TP
\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
.
This option is a set of 4 comma-separated values: the baud rate, parity,
number of data bits, and number of stop bits for this serial port.  The
\fIbaud\fR rate is a simple integer that specifies the connection speed.
\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,
................................................................................
.TP
\fB\-xchar\fR \fI{xonChar xoffChar}\fR
.
(Windows and Unix). This option is used to query or change the software
handshake characters. Normally the operating system default should be
DC1 (0x11) and DC3 (0x13) representing the ASCII standard
XON and XOFF characters.
.TP
\fB\-closemode\fR \fIcloseMode\fR
.VS "8.7, TIP 160"
(Windows and Unix). This option is used to query or change the close mode of
the serial channel, which defines how pending output in operating system
buffers is handled when the channel is closed. The following values for
\fIcloseMode\fR are supported:
.RS
.TP
\fBdefault\fR
.
indicates that a system default operation should be used; all serial channels
default to this.
.TP
\fBdiscard\fR
.
indicates that the contents of the OS buffers should be discarded.  Note that
this is \fInot recommended\fR when writing to a POSIX terminal, as it can
interact unexpectedly with handling of \fBstderr\fR.
.TP
\fBdrain\fR
.
indicates that Tcl should wait when closing the channel until all output has
been consumed. This may slow down \fBclose\fR noticeably.
.RE
.VE "8.7, TIP 160"
.TP
\fB\-inputmode\fR \fIinputMode\fR
.VS "8.7, TIP 160"
(Unix only; Windows has the equivalent option on console channels). This
option is used to query or change the input mode of the serial channel under
the assumption that it is talking to a terminal, which controls how interactive
input from users is handled. The following values for \fIinputMode\fR are
supported:
.RS
.TP
\fBnormal\fR
.
indicates that normal line-oriented input should be used, with standard
terminal editing capabilities enabled.
.TP
\fBpassword\fR
.
indicates that non-echoing input should be used, with standard terminal
editing capabilities enabled but no writing of typed characters to the
terminal (except for newlines). Some terminals may indicate this specially.
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
terminal doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
indicates that the terminal should be reset to what state it was in when the
terminal was opened.
.PP
Note that setting this option (technically, anything that changes the terminal
state from its initial value \fIvia this option\fR) will cause the channel to
turn on an automatic reset of the terminal when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
(Unix only; Windows has the equivalent option on console channels). This
option is query only. It retrieves a two-element list with the the current
width and height of the terminal.
.VE "8.7, TIP 160"
.TP
\fB\-pollinterval\fR \fImsec\fR
.
(Windows only). This option is used to set the maximum time between
polling for fileevents.
This affects the time interval between checking for events throughout the Tcl
interpreter (the smallest value always wins).  Use this option only if
................................................................................
\fB\-lasterror\fR
.
(Windows only). This option is query only.
In case of a serial communication error, \fBread\fR or \fBputs\fR
returns a general Tcl file I/O error.
\fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details.
See below for an explanation of the various error codes.
.SS "SERIAL PORT SIGNALS"
.PP
RS-232 is the most commonly used standard electrical interface for serial
communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and
a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C).  The
following signals are specified for incoming and outgoing data, status
lines and handshaking. Here we are using the terms \fIworkstation\fR for
your computer and \fImodem\fR for the external device, because some signal
................................................................................
.IP \fBBREAK\fR
A BREAK condition is not a hardware signal line, but a logical zero on the
TXD or RXD lines for a long period of time, usually 250 to 500
milliseconds.  Normally a receive or transmit data signal stays at the mark
(on=1) voltage until the next character is transferred. A BREAK is sometimes
used to reset the communications line or change the operating mode of
communications hardware.
.SS "ERROR CODES (Windows only)"
.PP
A lot of different errors may occur during serial read operations or during
event polling in background. The external device may have been switched
off, the data lines may be noisy, system buffers may overrun or your mode
settings may be wrong.  That is why a reliable software should always
\fBcatch\fR serial read operations.  In cases of an error Tcl returns a
general file I/O error.  Then \fBfconfigure\fR \fB\-lasterror\fR may help to
................................................................................
A stop-bit error has been detected by your UART.
Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBBREAK\fR
.
A BREAK condition has been detected by your UART (see above).
.SS "PORTABILITY ISSUES"
.TP
\fBWindows \fR
.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9.  An attempt to open a serial port that
................................................................................
not accessing the console, or if the command pipeline does not use standard
input, but is redirected from a file, then the above problem does not occur.
.RE
.PP
See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
additional information not specific to command pipelines about executing
applications on the various platforms
.SH "CONSOLE CHANNELS"
.VS "8.7, TIP 160"
On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR)
support the following options:
.TP
\fB\-inputmode\fR \fIinputMode\fR
.
This option is used to query or change the input mode of the console channel,
which controls how interactive input from users is handled. The following
values for \fIinputMode\fR are supported:
.RS
.TP
\fBnormal\fR
.
indicates that normal line-oriented input should be used, with standard
console editing capabilities enabled.
.TP
\fBpassword\fR
.
indicates that non-echoing input should be used, with standard console
editing capabilitied enabled but no writing of typed characters to the
terminal (except for newlines).
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
console doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
indicates that the console should be reset to what state it was in when the
console channel was opened.
.PP
Note that setting this option (technically, anything that changes the console
state from its default \fIvia this option\fR) will cause the channel to turn
on an automatic reset of the console when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
This option is query only.
It retrieves a two-element list with the the current width and height of the
console that this channel is talking to.
.PP
Note that the equivalent options exist on Unix, but are on the serial channel
type.
.VE "8.7, TIP 160"
.SH "EXAMPLES"
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
    puts "ls command failed: $err"
}
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
.PP
.CS
chan configure stdin \fB-inputmode password\fR
try {
    chan puts -nonewline "Password: "
    chan flush stdout
    set thePassword [chan gets stdin]
} finally {
    chan configure stdin \fB-inputmode reset\fR
}
.CE
.VE "8.7, TIP 160"
.SH "SEE ALSO"
file(n), close(n), filename(n), fconfigure(n), gets(n), read(n),
puts(n), exec(n), pid(n), fopen(3)
.SH KEYWORDS
access mode, append, create, file, non-blocking, open, permissions,
pipeline, process, serial
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/string.n.

83
84
85
86
87
88
89


















90
91
92
93
94
95
96
...
270
271
272
273
274
275
276
277


278
279
280
281
282
283
284
285
286
287


288
289
290
291
292
293

294
295
296
297
298
299
300
string.  \fIcharIndex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE


















.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function
................................................................................
\fIpattern\fR.
.RE
.TP
\fBstring range \fIstring first last\fR
.
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR. An index of 0 refers to the first


character of the string.  \fIfirst\fR and \fIlast\fR may be specified
as for the \fBindex\fR method.  If \fIfirst\fR is less than zero then
it is treated as if it were zero, and if \fIlast\fR is greater than or
equal to the length of the string then it is treated as if it were
\fBend\fR.  If \fIfirst\fR is greater than \fIlast\fR then an empty
string is returned.
.TP
\fBstring repeat \fIstring count\fR
.
Returns \fIstring\fR repeated \fIcount\fR number of times.


.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
.
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR.  An index of 0 refers to the

first character of the string.  \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method.  If \fInewstring\fR is
specified, then it is placed in the removed character range.  If
\fIfirst\fR is less than zero then it is treated as if it were zero,
and if \fIlast\fR is greater than or equal to the length of the string
then it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater
than \fIlast\fR or the length of the initial string, or \fIlast\fR is







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







 







|
>
>









|
>
>





|
>







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
string.  \fIcharIndex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
.TP
\fBstring insert \fIstring index insertString\fR
.VS "TIP 504"
Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
\fIindex\fR'th character.  The \fIindex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIindex\fR is start-relative, the first character inserted in the returned
string will be at the specified index.  If \fIindex\fR is end-relative, the last
character inserted in the returned string will be at the specified index.
.PP
If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR.  If \fIindex\fR is at
or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
\fIinsertString\fR is appended to \fIstring\fR.
.RE
.VE "TIP 504"
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function
................................................................................
\fIpattern\fR.
.RE
.TP
\fBstring range \fIstring first last\fR
.
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
\fBSTRING INDICES\fR). An index of \fB0\fR refers to the first
character of the string; an index of \fBend\fR refers to last
character of the string.  \fIfirst\fR and \fIlast\fR may be specified
as for the \fBindex\fR method.  If \fIfirst\fR is less than zero then
it is treated as if it were zero, and if \fIlast\fR is greater than or
equal to the length of the string then it is treated as if it were
\fBend\fR.  If \fIfirst\fR is greater than \fIlast\fR then an empty
string is returned.
.TP
\fBstring repeat \fIstring count\fR
.
Returns a string consisting of \fIstring\fR concatenated with itself
\fIcount\fR times. If \fIcount\fR is 0, the empty string will be
returned.
.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
.
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
\fBSTRING INDICES\fR).  An index of 0 refers to the
first character of the string.  \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method.  If \fInewstring\fR is
specified, then it is placed in the removed character range.  If
\fIfirst\fR is less than zero then it is treated as if it were zero,
and if \fIlast\fR is greater than or equal to the length of the string
then it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater
than \fIlast\fR or the length of the initial string, or \fIlast\fR is

Added doc/timerate.n.





































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Calibrated performance measurements of script execution time
.SH SYNOPSIS
\fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.BE
.SH DESCRIPTION
.PP
The \fBtimerate\fR command does calibrated performance measurement of a Tcl
command or script, \fIscript\fR. The \fIscript\fR should be written so that it
can be executed multiple times during the performance measurement process.
Time is measured in elapsed time using the finest timer resolution as possible,
not CPU time; if \fIscript\fR interacts with the OS, the cost of that
interaction is included.
This command may be used to provide information as to how well a script or
Tcl command is performing, and can help determine bottlenecks and fine-tune
application performance.
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])
.IP \(bu 3
the estimated rate per second ([\fBlindex\fR $result 4])
.IP \(bu 3
the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6])
.PP
The following options may be supplied to the \fBtimerate\fR command:
.TP
\fB\-calibrate\fR
.
To measure very fast scripts as exactly as possible, a calibration process
may be required.
The \fB\-calibrate\fR option is used to calibrate \fBtimerate\fR itself,
calculating the estimated overhead of the given script as the default overhead
for future invocations of the \fBtimerate\fR command. If the \fItime\fR
parameter is not specified, the calibrate procedure runs for up to 10 seconds.
.RS
.PP
Note that calibration is not thread safe in the current implementation.
.RE
.TP
\fB\-overhead \fIdouble\fR
.
The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
will be subtracted from the measured time prior to reporting results. This can
be useful for removing the cost of interpreter state reset commands from the
script being measured.
.TP
\fB\-direct\fR
.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the timerate command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to ten:
.PP
.CS
\fI# calibrate\fR
\fBtimerate\fR -calibrate {}

\fI# measure\fR
\fBtimerate\fR { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the
overhead of the management of the variable that controls the loop:
.PP
.CS
\fI# calibrate for overhead of variable operations\fR
set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000

\fI# measure\fR
\fBtimerate\fR {
    for {set i 0} {$i<10} {incr i} {}
} 5000
.CE
.PP
Estimate the speed of calculating the hour of the day using \fBclock format\fR only,
ignoring overhead of the portion of the script that prepares the time for it to
calculate:
.PP
.CS
\fI# calibrate\fR
\fBtimerate\fR -calibrate {}

\fI# estimate overhead\fR
set tm 0
set ovh [lindex [\fBtimerate\fR {
    incr tm [expr {24*60*60}]
}] 0]

\fI# measure using estimated overhead\fR
set tm 0
\fBtimerate\fR -overhead $ovh {
    clock format $tm -format %H
    incr tm [expr {24*60*60}]; # overhead for this is ignored
} 5000
.CE
.SH "SEE ALSO"
time(n)
.SH KEYWORDS
performance measurement, script, time
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/zipfs.n.

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
...
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .
.RE
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
................................................................................
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fbzipfs root\fR] myApp]

\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip

source [file join $base app.tcl]
# use the contents, load libraries from it, etc...

................................................................................
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fbzipfs root\fR] myApp]

# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password

# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE







<







 







|







 







|







106
107
108
109
110
111
112

113
114
115
116
117
118
119
...
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
...
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .

.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
................................................................................
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fBzipfs root\fR] myApp]

\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip

source [file join $base app.tcl]
# use the contents, load libraries from it, etc...

................................................................................
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fBzipfs root\fR] myApp]

# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password

# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE

Changes to generic/regc_locale.c.

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237

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

269
270
271
272
273
274

275
276
277
278
279
280
281
282
283
284
...
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
...
321
322
323
324
325
326
327
328

329
330
331
332
333
334
335
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
...
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
...
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
...
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
...
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
...
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
    {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61},
    {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
    {0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
    {0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
    {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c},
    {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61},
    {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
    {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97},
    {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4},
    {0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c},
    {0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070},
    {0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248},
    {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
    {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
    {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
    {0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
    {0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
    {0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
    {0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
    {0x1820, 0x1878}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
    {0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
    {0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
    {0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
    {0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba},
    {0x1cbd, 0x1cbf}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1}, {0x1d00, 0x1dbf},
    {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
    {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc},
    {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb},
    {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c},
    {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139},
    {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e},
    {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67},
    {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6},
    {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6},
    {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f},
    {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e},
    {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef},
    {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f},
    {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f},
    {0xa722, 0xa788}, {0xa78b, 0xa7b9}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
    {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
    {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
    {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
    {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
    {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
    {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
    {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65},
    {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
    {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
    {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
    {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
    {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
    {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
    {0xffda, 0xffdc}
................................................................................
    {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
    {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
    {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
    {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
    {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
    {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
    {0x10f30, 0x10f45}, {0x11003, 0x11037}, {0x11083, 0x110af}, {0x110d0, 0x110e8},
    {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2}, {0x111c1, 0x111c4},
    {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
    {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de}, {0x11305, 0x1130c},
    {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339}, {0x1135d, 0x11361},
    {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af}, {0x11580, 0x115ae},
    {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa}, {0x11700, 0x1171a},
    {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
    {0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
    {0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x11d60, 0x11d65},
    {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2}, {0x12000, 0x12399}, {0x12480, 0x12543},
    {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
    {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
    {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
    {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},

    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
    {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
    {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
    {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
    {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},

    {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03},
    {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
    {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
    {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
    {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
    {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}
#endif
};

#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))

static const chr alphaCharTable[] = {
    0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386,
................................................................................
    0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
    0x9f0, 0x9f1, 0x9fc, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
    0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1,
    0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71,
    0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0,
    0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1,
    0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84,
    0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2,
    0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e,
    0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae,
    0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
    0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
    0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
    0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe, 0xa9cf, 0xaa7a, 0xaab1,
    0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43,
    0xfb44

#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
    0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
    0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644,
    0x118ff, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d, 0x11c40, 0x11d08, 0x11d09, 0x11d46,
    0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2,

    0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
    0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
    0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};

#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))

/*
 * Unicode: control characters.
................................................................................
 */

static const crange controlRangeTable[] = {
    {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
    {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
    {0xfff9, 0xfffb}
#if CHRBITS > 16
    ,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
    {0x100000, 0x10fffd}
#endif
};

#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))

static const chr controlCharTable[] = {
    0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
................................................................................
    {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
    {0xff10, 0xff19}
#if CHRBITS > 16
    ,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
    {0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
    {0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
    {0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
    {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}

#endif
};

#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))

/*
 * no singletons of digit characters.
................................................................................
    {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9},
    {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4},
    {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6},
    {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad},
    {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
    {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
    {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
    {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4e},
    {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
    {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
    {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
    {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
    {0xff5f, 0xff65}
#if CHRBITS > 16
    ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
................................................................................
#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))

static const chr punctCharTable[] = {
    0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
    0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
    0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
    0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
    0x9fd, 0xa76, 0xaf0, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14,
    0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c,
    0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
    0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
    0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
    0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
    0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
    0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
    0xff5b, 0xff5d
#if CHRBITS > 16
    ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
    0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
    0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f,
    0x1e95e, 0x1e95f
#endif
};

#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))

/*
 * Unicode: white space characters.
................................................................................
    {0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
    {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
    {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
    {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
    {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
    {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
    {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
    {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab65},
    {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
    ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
    {0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
    {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
    {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
    {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
................................................................................
    0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727,
    0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d,
    0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
    0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
    0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
    0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
    0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
    0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7fa
#if CHRBITS > 16
    ,0x1d4bb, 0x1d7cb
#endif
};

#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))

................................................................................
    {0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
    {0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
    {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
    {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
    {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
    {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
    {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
    {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
#if CHRBITS > 16
    ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
    {0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
    {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
    {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
................................................................................
    0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e,
    0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
    0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
    0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
    0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
    0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
    0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
    0xa7b8
#if CHRBITS > 16
    ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
    0x1d539, 0x1d546, 0x1d7ca
#endif
};

#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
................................................................................
    {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
    {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
    {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
    {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
    {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
    {0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
    {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
    {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc8c},
    {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
    {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
    {0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
    {0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
    {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
    {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
    {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97},
    {0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd},
    {0xec0, 0xec4}, {0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf},
    {0xf00, 0xf47}, {0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc},
    {0xfbe, 0xfcc}, {0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248},
    {0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
    {0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
    {0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
    {0x1318, 0x135a}, {0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5},
    {0x13f8, 0x13fd}, {0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8},
    {0x1700, 0x170c}, {0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753},
    {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9},
    {0x17f0, 0x17f9}, {0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1878},
    {0x1880, 0x18aa}, {0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b},
    {0x1930, 0x193b}, {0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
    {0x19b0, 0x19c9}, {0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e},
    {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad},
    {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3},
    {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1c90, 0x1cba},
    {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cf9}, {0x1d00, 0x1df9}, {0x1dfb, 0x1f15},
    {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
    {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3},
    {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe},
    {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e}, {0x2090, 0x209c},
    {0x20a0, 0x20bf}, {0x20d0, 0x20f0}, {0x2100, 0x218b}, {0x2190, 0x2426},
    {0x2440, 0x244a}, {0x2460, 0x2b73}, {0x2b76, 0x2b95}, {0x2b98, 0x2bc8},
    {0x2bca, 0x2bfe}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
    {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
    {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
    {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4e},
    {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
    {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
    {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
    {0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
    {0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7b9},
    {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
    {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
    {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
    {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
    {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
    {0xab30, 0xab65}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
    {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
    {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
    {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
    {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
    {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
    {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
    {0xffe0, 0xffe6}, {0xffe8, 0xffee}
................................................................................
    {0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
    {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
    {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
    {0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
    {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
    {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
    {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x11000, 0x1104d},
    {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1}, {0x110d0, 0x110e8},
    {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146}, {0x11150, 0x11176},
    {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4}, {0x11200, 0x11211},
    {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d}, {0x1128f, 0x1129d},
    {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9}, {0x11300, 0x11303},
    {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
    {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363}, {0x11366, 0x1136c},
    {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7}, {0x114d0, 0x114d9},
    {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644}, {0x11650, 0x11659},

    {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9}, {0x11700, 0x1171a},
    {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x11800, 0x1183b}, {0x118a0, 0x118f2},
    {0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11aa2}, {0x11ac0, 0x11af8},
    {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
    {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
    {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
    {0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
    {0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
    {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
    {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
    {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
    {0x16e40, 0x16e9a}, {0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f},
    {0x17000, 0x187f1}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},


    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
    {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
    {0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
    {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
    {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
    {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
    {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},

    {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
    {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
    {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
    {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
    {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093},
    {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5},
    {0x1f100, 0x1f10c}, {0x1f110, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
    {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265}, {0x1f300, 0x1f6d4},
    {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f9}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d8},
    {0x1f800, 0x1f80b}, {0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887},
    {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b}, {0x1f910, 0x1f93e}, {0x1f940, 0x1f970},
    {0x1f973, 0x1f976}, {0x1f97c, 0x1f9a2}, {0x1f9b0, 0x1f9b9}, {0x1f9c0, 0x1f9c2},
    {0x1f9d0, 0x1f9ff}, {0x1fa60, 0x1fa6d}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},


    {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d},
    {0xe0100, 0xe01ef}
#endif
};

#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))

static const chr graphCharTable[] = {
    0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
    0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
    0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
    0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
    0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
    0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
    0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xe87,
    0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xec6, 0x10c7,
    0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59, 0x1f5b, 0x1f5d,
    0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41,
    0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
    0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
    0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x1145e, 0x118ff, 0x11d08,
    0x11d09, 0x11d3a, 0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e,
    0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
    0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
    0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
    0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
    0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f97a
#endif
};

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

/*
 *	End of auto-generated Unicode character ranges declarations.
................................................................................
    NOTE(REG_ULOCALE);

    /*
     * Search table.
     */

    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
    for (cn=cnames; cn->name!=NULL; cn++) {
	if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
	    break;			/* NOTE BREAK OUT */
	}
    }
    Tcl_DStringFree(&ds);
    if (cn->name != NULL) {







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






|







 







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







>
|
|
|
|
|
|







 







<
|
|
|
|
|
|
|
<
>



|
|
|
>
|
|
|







 







|
|







 







|
>







 







|







 







|
|










|
|







 







|







 







|







 







|







 







|







 







|






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


|



|
|





|







 







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




|
|
|
|
|
<
>
>








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












|
<
|
|
|



|
|
|
|
|
|
|







 







|







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
...
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
...
255
256
257
258
259
260
261

262
263
264
265
266
267
268

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
...
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
...
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
...
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
...
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653

654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
...
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
...
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
    {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61},
    {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
    {0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
    {0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
    {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c},
    {0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61},
    {0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
    {0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe86, 0xe8a},
    {0xe8c, 0xea3}, {0xea7, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf},
    {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a},
    {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081},
    {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d},
    {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
    {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
    {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
    {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c},
    {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8},
    {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
    {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1878},
    {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e},
    {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
    {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b},
    {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f},
    {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf},
    {0x1ce9, 0x1cec}, {0x1cee, 0x1cf3}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15},
    {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57},
    {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4},
    {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec},
    {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113},
    {0x2119, 0x211d}, {0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f},
    {0x2145, 0x2149}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4},
    {0x2ceb, 0x2cee}, {0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96},
    {0x2da0, 0x2da6}, {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe},
    {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde},
    {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa},
    {0x30fc, 0x30ff}, {0x3105, 0x312f}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
    {0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, {0xa000, 0xa48c},
    {0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
    {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
    {0xa78b, 0xa7bf}, {0xa7c2, 0xa7c6}, {0xa7f7, 0xa801}, {0xa803, 0xa805},
    {0xa807, 0xa80a}, {0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3},
    {0xa8f2, 0xa8f7}, {0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c},
    {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe},
    {0xaa00, 0xaa28}, {0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76},
    {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea},
    {0xaaf2, 0xaaf4}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
    {0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab67},
    {0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
    {0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
    {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
    {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
    {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
    {0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
    {0xffda, 0xffdc}
................................................................................
    {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
    {0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
    {0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
    {0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
    {0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
    {0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
    {0x10f30, 0x10f45}, {0x10fe0, 0x10ff6}, {0x11003, 0x11037}, {0x11083, 0x110af},
    {0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
    {0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
    {0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
    {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
    {0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
    {0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
    {0x11700, 0x1171a}, {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x119a0, 0x119a7},
    {0x119aa, 0x119d0}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a89}, {0x11ac0, 0x11af8},
    {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x11d00, 0x11d06},
    {0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2},
    {0x12000, 0x12399}, {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646},
    {0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f},
    {0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f},
    {0x16f00, 0x16f4a}, {0x16f93, 0x16f9f}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
    {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
    {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
    {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
    {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
    {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
    {0x1d7c4, 0x1d7cb}, {0x1e100, 0x1e12c}, {0x1e137, 0x1e13d}, {0x1e2c0, 0x1e2eb},
    {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f},
    {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a},
    {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89},
    {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb},
    {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1},
    {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}
#endif
};

#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))

static const chr alphaCharTable[] = {
    0xaa, 0xb5, 0xba, 0x2ec, 0x2ee, 0x376, 0x377, 0x37f, 0x386,
................................................................................
    0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
    0x9f0, 0x9f1, 0x9fc, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
    0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1,
    0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71,
    0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0,
    0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1,
    0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84,

    0xea5, 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065,
    0x1066, 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa,
    0x1aa7, 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1cfa, 0x1f59, 0x1f5b, 0x1f5d,
    0x1fbe, 0x2071, 0x207f, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128,
    0x214e, 0x2183, 0x2184, 0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f,
    0x3005, 0x3006, 0x303b, 0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa8fe,
    0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e,

    0xfb40, 0xfb41, 0xfb43, 0xfb44
#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
    0x109bf, 0x10a00, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
    0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x1145f, 0x114c4, 0x114c5, 0x114c7,
    0x11644, 0x116b8, 0x118ff, 0x119e1, 0x119e3, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d,
    0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0,
    0x16fe1, 0x16fe3, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
    0x1e14e, 0x1e94b, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
    0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
    0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
#endif
};

#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))

/*
 * Unicode: control characters.
................................................................................
 */

static const crange controlRangeTable[] = {
    {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
    {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
    {0xfff9, 0xfffb}
#if CHRBITS > 16
    ,{0x13430, 0x13438}, {0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f},
    {0xf0000, 0xffffd}, {0x100000, 0x10fffd}
#endif
};

#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))

static const chr controlCharTable[] = {
    0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
................................................................................
    {0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
    {0xff10, 0xff19}
#if CHRBITS > 16
    ,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {0x11066, 0x1106f}, {0x110f0, 0x110f9},
    {0x11136, 0x1113f}, {0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459},
    {0x114d0, 0x114d9}, {0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739},
    {0x118e0, 0x118e9}, {0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x11da0, 0x11da9},
    {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e140, 0x1e149},
    {0x1e2f0, 0x1e2f9}, {0x1e950, 0x1e959}
#endif
};

#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))

/*
 * no singletons of digit characters.
................................................................................
    {0x55a, 0x55f}, {0x66a, 0x66d}, {0x700, 0x70d}, {0x7f7, 0x7f9},
    {0x830, 0x83e}, {0xf04, 0xf12}, {0xf3a, 0xf3d}, {0xfd0, 0xfd4},
    {0x104a, 0x104f}, {0x1360, 0x1368}, {0x16eb, 0x16ed}, {0x17d4, 0x17d6},
    {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad},
    {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
    {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
    {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
    {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e4f},
    {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
    {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
    {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
    {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
    {0xff5f, 0xff65}
#if CHRBITS > 16
    ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
................................................................................
#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))

static const chr punctCharTable[] = {
    0x3a, 0x3b, 0x3f, 0x40, 0x5f, 0x7b, 0x7d, 0xa1, 0xa7,
    0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
    0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
    0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
    0x9fd, 0xa76, 0xaf0, 0xc77, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b,
    0xf14, 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 0x166e, 0x169b, 0x169c,
    0x1735, 0x1736, 0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3,
    0x207d, 0x207e, 0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc,
    0x29fd, 0x2cfe, 0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe,
    0xa4ff, 0xa673, 0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f,
    0xa9de, 0xa9df, 0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f,
    0xfe63, 0xfe68, 0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f,
    0xff5b, 0xff5d
#if CHRBITS > 16
    ,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
    0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
    0x119e2, 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x11fff, 0x16a6e, 0x16a6f, 0x16af5,
    0x16b44, 0x16fe2, 0x1bc9f, 0x1e95e, 0x1e95f
#endif
};

#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))

/*
 * Unicode: white space characters.
................................................................................
    {0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
    {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
    {0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
    {0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
    {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
    {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
    {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
    {0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab67},
    {0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
#if CHRBITS > 16
    ,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
    {0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
    {0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
    {0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
    {0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
................................................................................
    0xa691, 0xa693, 0xa695, 0xa697, 0xa699, 0xa69b, 0xa723, 0xa725, 0xa727,
    0xa729, 0xa72b, 0xa72d, 0xa733, 0xa735, 0xa737, 0xa739, 0xa73b, 0xa73d,
    0xa73f, 0xa741, 0xa743, 0xa745, 0xa747, 0xa749, 0xa74b, 0xa74d, 0xa74f,
    0xa751, 0xa753, 0xa755, 0xa757, 0xa759, 0xa75b, 0xa75d, 0xa75f, 0xa761,
    0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
    0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
    0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
    0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7bb, 0xa7bd, 0xa7bf, 0xa7c3, 0xa7fa
#if CHRBITS > 16
    ,0x1d4bb, 0x1d7cb
#endif
};

#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))

................................................................................
    {0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
    {0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
    {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
    {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
    {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
    {0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
    {0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
    {0xa7b0, 0xa7b4}, {0xa7c4, 0xa7c6}, {0xff21, 0xff3a}
#if CHRBITS > 16
    ,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
    {0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
    {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
    {0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
    {0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
................................................................................
    0xa698, 0xa69a, 0xa722, 0xa724, 0xa726, 0xa728, 0xa72a, 0xa72c, 0xa72e,
    0xa732, 0xa734, 0xa736, 0xa738, 0xa73a, 0xa73c, 0xa73e, 0xa740, 0xa742,
    0xa744, 0xa746, 0xa748, 0xa74a, 0xa74c, 0xa74e, 0xa750, 0xa752, 0xa754,
    0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
    0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
    0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
    0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
    0xa7b8, 0xa7ba, 0xa7bc, 0xa7be, 0xa7c2
#if CHRBITS > 16
    ,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
    0x1d539, 0x1d546, 0x1d7ca
#endif
};

#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
................................................................................
    {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff}, {0xb01, 0xb03},
    {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39},
    {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77},
    {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
    {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd},
    {0xbe6, 0xbfa}, {0xc00, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
    {0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
    {0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc77, 0xc8c},
    {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9},
    {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3},
    {0xce6, 0xcef}, {0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
    {0xd12, 0xd44}, {0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63},
    {0xd66, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
    {0xdc0, 0xdc6}, {0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef},
    {0xdf2, 0xdf4}, {0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe86, 0xe8a},

    {0xe8c, 0xea3}, {0xea7, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd},
    {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c},
    {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda},
    {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256},
    {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0},
    {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6},
    {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c},
    {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f},
    {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714},
    {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770},
    {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d},
    {0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18aa}, {0x18b0, 0x18f5},
    {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d},
    {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da},
    {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
    {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
    {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
    {0x1c4d, 0x1c88}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cfa},
    {0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
    {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
    {0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
    {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
    {0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
    {0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
    {0x2b76, 0x2b95}, {0x2b98, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
    {0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
    {0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
    {0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e4f},
    {0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
    {0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
    {0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
    {0x3220, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c}, {0xa490, 0xa4c6},
    {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7bf}, {0xa7c2, 0xa7c6},
    {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877}, {0xa880, 0xa8c5},
    {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c}, {0xa980, 0xa9cd},
    {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36}, {0xaa40, 0xaa4d},
    {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6}, {0xab01, 0xab06},
    {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
    {0xab30, 0xab67}, {0xab70, 0xabed}, {0xabf0, 0xabf9}, {0xac00, 0xd7a3},
    {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
    {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36}, {0xfb38, 0xfb3c},
    {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7},
    {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52}, {0xfe54, 0xfe66},
    {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff01, 0xffbe},
    {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc},
    {0xffe0, 0xffe6}, {0xffe8, 0xffee}
................................................................................
    {0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
    {0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
    {0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
    {0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
    {0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
    {0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
    {0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
    {0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x10fe0, 0x10ff6},
    {0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
    {0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146},
    {0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
    {0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
    {0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
    {0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
    {0x11335, 0x11339}, {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
    {0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x1145d, 0x1145f},
    {0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
    {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b8},
    {0x116c0, 0x116c9}, {0x11700, 0x1171a}, {0x1171d, 0x1172b}, {0x11730, 0x1173f},
    {0x11800, 0x1183b}, {0x118a0, 0x118f2}, {0x119a0, 0x119a7}, {0x119aa, 0x119d7},
    {0x119da, 0x119e4}, {0x11a00, 0x11a47}, {0x11a50, 0x11aa2}, {0x11ac0, 0x11af8},
    {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45}, {0x11c50, 0x11c6c},
    {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6}, {0x11d00, 0x11d06},
    {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59}, {0x11d60, 0x11d65},
    {0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
    {0x11fc0, 0x11ff1}, {0x11fff, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474},
    {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
    {0x16a40, 0x16a5e}, {0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5},
    {0x16b00, 0x16b45}, {0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77},
    {0x16b7d, 0x16b8f}, {0x16e40, 0x16e9a}, {0x16f00, 0x16f4a}, {0x16f4f, 0x16f87},

    {0x16f8f, 0x16f9f}, {0x16fe0, 0x16fe3}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
    {0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
    {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
    {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
    {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
    {0x1d360, 0x1d378}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
    {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
    {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
    {0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
    {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
    {0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e100, 0x1e12c},
    {0x1e130, 0x1e13d}, {0x1e140, 0x1e149}, {0x1e2c0, 0x1e2f9}, {0x1e800, 0x1e8c4},
    {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94b}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
    {0x1ed01, 0x1ed3d}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
    {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
    {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
    {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
    {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
    {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f16c}, {0x1f170, 0x1f1ac},
    {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265},
    {0x1f300, 0x1f6d5}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6fa}, {0x1f700, 0x1f773},
    {0x1f780, 0x1f7d8}, {0x1f7e0, 0x1f7eb}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
    {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},

    {0x1f90d, 0x1f971}, {0x1f973, 0x1f976}, {0x1f97a, 0x1f9a2}, {0x1f9a5, 0x1f9aa},
    {0x1f9ae, 0x1f9ca}, {0x1f9cd, 0x1fa53}, {0x1fa60, 0x1fa6d}, {0x1fa70, 0x1fa73},
    {0x1fa78, 0x1fa7a}, {0x1fa80, 0x1fa82}, {0x1fa90, 0x1fa95}, {0x20000, 0x2a6d6},
    {0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0},
    {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
#endif
};

#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))

static const chr graphCharTable[] = {
    0x38c, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8, 0x9d7, 0x9dc,
    0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38, 0xa39,
    0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3, 0xad0, 0xb0f,
    0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57, 0xb5c, 0xb5d,
    0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4,
    0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde, 0xcf1, 0xcf2,
    0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82, 0xe84, 0xea5,

    0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
    0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
    0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
#if CHRBITS > 16
    ,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
    0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
    0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x118ff, 0x11d08, 0x11d09, 0x11d3a,
    0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, 0x16a6f, 0x1d49e,
    0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e14e,
    0x1e14f, 0x1e2ff, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39,
    0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57,
    0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0,
    0x1eef1, 0x1f250, 0x1f251
#endif
};

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

/*
 *	End of auto-generated Unicode character ranges declarations.
................................................................................
    NOTE(REG_ULOCALE);

    /*
     * Search table.
     */

    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);
    for (cn=cnames; cn->name!=NULL; cn++) {
	if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
	    break;			/* NOTE BREAK OUT */
	}
    }
    Tcl_DStringFree(&ds);
    if (cn->name != NULL) {

Changes to generic/regcomp.c.

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
...
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
    const chr *stop;		/* end of string */
    const chr *savenow;		/* saved now and stop for "subroutine call" */
    const chr *savestop;
    int err;			/* error code (0 if none) */
    int cflags;			/* copy of compile flags */
    int lasttype;		/* type of previous token */
    int nexttype;		/* type of next token */
    chr nextvalue;		/* value (if any) of next token */
    int lexcon;			/* lexical context type (see lex.c) */
    int nsubexp;		/* subexpression count */
    struct subre **subs;	/* subRE pointer vector */
    size_t nsubs;		/* length of vector */
    struct subre *sub10[10];	/* initial vector, enough for most */
    struct nfa *nfa;		/* the NFA */
    struct colormap *cm;	/* character color map */
    color nlcolor;		/* color of newline */
    struct state *wordchrs;	/* state in nfa holding word-char outarcs */
    struct subre *tree;		/* subexpression tree */
    struct subre *treechain;	/* all tree nodes allocated */
................................................................................
    regex_t *re,
    const chr *string,
    size_t len,
    int flags)
{
    AllocVars(v);
    struct guts *g;
    int i;
    size_t j;
    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }

    /*
     * Sanity checks.
     */

................................................................................
 */
static void
moresubs(
    struct vars *v,
    int wanted)			/* want enough room for this one */
{
    struct subre **p;
    size_t n;

    assert(wanted > 0 && (size_t)wanted >= v->nsubs);
    n = (size_t)wanted * 3 / 2 + 1;
    if (v->subs == v->sub10) {
	p = (struct subre **) MALLOC(n * sizeof(struct subre *));
	if (p != NULL) {
	    memcpy(p, v->subs, v->nsubs * sizeof(struct subre *));
	}
    } else {
	p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *));
................................................................................
    }

    v->subs = p;
    for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) {
	*p = NULL;
    }
    assert(v->nsubs == n);
    assert((size_t)wanted < v->nsubs);
}
 
/*
 - freev - free vars struct's substructures where necessary
 * Optionally does error-number setting, and always returns error code (if
 * any), to make error-handling code terser.
 ^ static int freev(struct vars *, int);
................................................................................
	 */

    case '(':			/* value flags as capturing or non */
	cap = (type == LACON) ? 0 : v->nextvalue;
	if (cap) {
	    v->nsubexp++;
	    subno = v->nsubexp;
	    if ((size_t)subno >= v->nsubs) {
		moresubs(v, subno);
	    }
	    assert((size_t)subno < v->nsubs);
	} else {
	    atomtype = PLAIN;	/* something that's not '(' */
	}
	NEXT();

	/*
	 * Need new endpoints because tree will contain pointers.







|



|







 







|
<







 







|

|
|







 







|







 







|


|







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
...
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
...
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
...
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
    const chr *stop;		/* end of string */
    const chr *savenow;		/* saved now and stop for "subroutine call" */
    const chr *savestop;
    int err;			/* error code (0 if none) */
    int cflags;			/* copy of compile flags */
    int lasttype;		/* type of previous token */
    int nexttype;		/* type of next token */
    int nextvalue;		/* value (if any) of next token */
    int lexcon;			/* lexical context type (see lex.c) */
    int nsubexp;		/* subexpression count */
    struct subre **subs;	/* subRE pointer vector */
    int nsubs;			/* length of vector */
    struct subre *sub10[10];	/* initial vector, enough for most */
    struct nfa *nfa;		/* the NFA */
    struct colormap *cm;	/* character color map */
    color nlcolor;		/* color of newline */
    struct state *wordchrs;	/* state in nfa holding word-char outarcs */
    struct subre *tree;		/* subexpression tree */
    struct subre *treechain;	/* all tree nodes allocated */
................................................................................
    regex_t *re,
    const chr *string,
    size_t len,
    int flags)
{
    AllocVars(v);
    struct guts *g;
    int i, j;

    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }

    /*
     * Sanity checks.
     */

................................................................................
 */
static void
moresubs(
    struct vars *v,
    int wanted)			/* want enough room for this one */
{
    struct subre **p;
    int n;

    assert(wanted > 0 && wanted >= v->nsubs);
    n = wanted * 3 / 2 + 1;
    if (v->subs == v->sub10) {
	p = (struct subre **) MALLOC(n * sizeof(struct subre *));
	if (p != NULL) {
	    memcpy(p, v->subs, v->nsubs * sizeof(struct subre *));
	}
    } else {
	p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *));
................................................................................
    }

    v->subs = p;
    for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) {
	*p = NULL;
    }
    assert(v->nsubs == n);
    assert(wanted < v->nsubs);
}
 
/*
 - freev - free vars struct's substructures where necessary
 * Optionally does error-number setting, and always returns error code (if
 * any), to make error-handling code terser.
 ^ static int freev(struct vars *, int);
................................................................................
	 */

    case '(':			/* value flags as capturing or non */
	cap = (type == LACON) ? 0 : v->nextvalue;
	if (cap) {
	    v->nsubexp++;
	    subno = v->nsubexp;
	    if (subno >= v->nsubs) {
		moresubs(v, subno);
	    }
	    assert(subno < v->nsubs);
	} else {
	    atomtype = PLAIN;	/* something that's not '(' */
	}
	NEXT();

	/*
	 * Need new endpoints because tree will contain pointers.

Changes to generic/regexec.c.

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
...
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    rm_detail_t *details,
    size_t nmatch,
    regmatch_t pmatch[],
    int flags)
{
    AllocVars(v);
    int st, backref;
    size_t n;
    size_t i;
#define	LOCALMAT	20
    regmatch_t mat[LOCALMAT];
#define LOCALDFAS	40
    struct dfa *subdfas[LOCALDFAS];

    /*
     * Sanity checks.
................................................................................
	v->pmatch = pmatch;
    }
    v->details = details;
    v->start = (chr *)string;
    v->stop = (chr *)string + len;
    v->err = 0;
    assert(v->g->ntree >= 0);
    n = (size_t) v->g->ntree;
    if (n <= LOCALDFAS)
	v->subdfas = subdfas;
    else
	v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
    if (v->subdfas == NULL) {
	if (v->pmatch != pmatch && v->pmatch != mat)
	    FREE(v->pmatch);
................................................................................
    /*
     * Clean up.
     */

    if (v->pmatch != pmatch && v->pmatch != mat) {
	FREE(v->pmatch);
    }
    n = (size_t) v->g->ntree;
    for (i = 0; i < n; i++) {
	if (v->subdfas[i] != NULL)
	    freeDFA(v->subdfas[i]);
    }
    if (v->subdfas != subdfas)
	FREE(v->subdfas);
    FreeVars(v);







|
|







 







|







 







|







168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
...
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    rm_detail_t *details,
    size_t nmatch,
    regmatch_t pmatch[],
    int flags)
{
    AllocVars(v);
    int st, backref;
    int n;
    int i;
#define	LOCALMAT	20
    regmatch_t mat[LOCALMAT];
#define LOCALDFAS	40
    struct dfa *subdfas[LOCALDFAS];

    /*
     * Sanity checks.
................................................................................
	v->pmatch = pmatch;
    }
    v->details = details;
    v->start = (chr *)string;
    v->stop = (chr *)string + len;
    v->err = 0;
    assert(v->g->ntree >= 0);
    n = v->g->ntree;
    if (n <= LOCALDFAS)
	v->subdfas = subdfas;
    else
	v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
    if (v->subdfas == NULL) {
	if (v->pmatch != pmatch && v->pmatch != mat)
	    FREE(v->pmatch);
................................................................................
    /*
     * Clean up.
     */

    if (v->pmatch != pmatch && v->pmatch != mat) {
	FREE(v->pmatch);
    }
    n = v->g->ntree;
    for (i = 0; i < n; i++) {
	if (v->subdfas[i] != NULL)
	    freeDFA(v->subdfas[i]);
    }
    if (v->subdfas != subdfas)
	FREE(v->subdfas);
    FreeVars(v);

Changes to generic/tcl.decls.

663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
...
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
....
2374
2375
2376
2377
2378
2379
2380






2381
2382
2383
2384
2385
2386
2387
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
    char *Tcl_JoinPath(int argc, const char *const *argv,
	    Tcl_DString *resultPtr)
}
declare 187 {
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
	    int type)
}

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }
................................................................................
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 {
    int Tcl_StringMatch(const char *str, const char *pattern)
}
declare 246 {deprecated {}} {
    int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 {deprecated {No longer in use, changed to macro}} {
    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
................................................................................
declare 642 {
    void Tcl_DecrRefCount(Tcl_Obj *objPtr)
}

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}







# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.







|







 







|







 







>
>
>
>
>
>







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
...
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
....
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
    char *Tcl_JoinPath(int argc, const char *const *argv,
	    Tcl_DString *resultPtr)
}
declare 187 {
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr,
	    int type)
}

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }
................................................................................
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 {deprecated {No longer in use, changed to macro}} {
    int Tcl_StringMatch(const char *str, const char *pattern)
}
declare 246 {deprecated {}} {
    int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 {deprecated {No longer in use, changed to macro}} {
    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
................................................................................
declare 642 {
    void Tcl_DecrRefCount(Tcl_Obj *objPtr)
}

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}

# TIP#312 New Tcl_LinkArray() function
declare 644 {
    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
	    int type, int size)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

Changes to generic/tcl.h.

1089
1090
1091
1092
1093
1094
1095


1096
1097
1098
1099
1100
1101
1102
#define TCL_LINK_ULONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14


#define TCL_LINK_READ_ONLY	0x80
 
/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */








>
>







1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
#define TCL_LINK_ULONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_CHARS		15
#define TCL_LINK_BINARY		16
#define TCL_LINK_READ_ONLY	0x80
 
/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

Changes to generic/tclAlloc.c.

270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
................................................................................
	if (newPtr == NULL) {
	    return NULL;
	}
	maxSize -= OVERHEAD;
	if (maxSize < numBytes) {
	    numBytes = maxSize;
	}
	memcpy(newPtr, oldPtr, (size_t) numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

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







|
|







 







|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes, 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
................................................................................
	if (newPtr == NULL) {
	    return NULL;
	}
	maxSize -= OVERHEAD;
	if (maxSize < numBytes) {
	    numBytes = maxSize;
	}
	memcpy(newPtr, oldPtr, numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

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

Changes to generic/tclAssembly.c.

140
141
142
143
144
145
146


147
148
149
150
151
152
153
...
358
359
360
361
362
363
364

365
366
367
368
369
370
371
...
615
616
617
618
619
620
621
622

623
624
625



626
627
628
629
630
631
632
....
1392
1393
1394
1395
1396
1397
1398

1399
1400
1401
1402
1403
1404
1405
    ASSEM_BOOL_LVT4,		/* One Boolean, one 4-byte LVT ref. */
    ASSEM_CLOCK_READ,		/* 1-byte unsigned-integer case number, in the
				 * range 0-3 */
    ASSEM_CONCAT1,		/* 1-byte unsigned-integer operand count, must
				 * be strictly positive, consumes N, produces
				 * 1 */
    ASSEM_DICT_GET,		/* 'dict get' and related - consumes N+1


				 * operands, produces 1, N > 0 */
    ASSEM_DICT_SET,		/* specifies key count and LVT index, consumes
				 * N+1 operands, produces 1, N > 0 */
    ASSEM_DICT_UNSET,		/* specifies key count and LVT index, consumes
				 * N operands, produces 1, N > 0 */
    ASSEM_END_CATCH,		/* End catch. No args. Exception range popped
				 * from stack and stack pointer restored. */
................................................................................
    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
    {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
    {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,1},
    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},

    {"dictIncrImm",	ASSEM_SINT4_LVT4,
					INST_DICT_INCR_IMM,	1,	1},
    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
    {"dictUnset",	ASSEM_DICT_UNSET,
................................................................................
    int count)			/* Count of operands for variadic insts */
{
    int consumed = TalInstructionTable[tblIdx].operandsConsumed;
    int produced = TalInstructionTable[tblIdx].operandsProduced;

    if (consumed == INT_MIN) {
	/*
	 * The instruction is variadic; it consumes 'count' operands.

	 */

	consumed = count;



    }
    if (produced < 0) {
	/*
	 * The instruction leaves some of its variadic operands on the stack,
	 * with net stack effect of '-1-produced'
	 */

................................................................................
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_DICT_GET:

	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;







>
>







 







>







 







|
>



>
>
>







 







>







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
...
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
...
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
....
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
    ASSEM_BOOL_LVT4,		/* One Boolean, one 4-byte LVT ref. */
    ASSEM_CLOCK_READ,		/* 1-byte unsigned-integer case number, in the
				 * range 0-3 */
    ASSEM_CONCAT1,		/* 1-byte unsigned-integer operand count, must
				 * be strictly positive, consumes N, produces
				 * 1 */
    ASSEM_DICT_GET,		/* 'dict get' and related - consumes N+1
				 * operands, produces 1, N > 0 */
    ASSEM_DICT_GET_DEF,		/* 'dict getwithdefault' - consumes N+2
				 * operands, produces 1, N > 0 */
    ASSEM_DICT_SET,		/* specifies key count and LVT index, consumes
				 * N+1 operands, produces 1, N > 0 */
    ASSEM_DICT_UNSET,		/* specifies key count and LVT index, consumes
				 * N operands, produces 1, N > 0 */
    ASSEM_END_CATCH,		/* End catch. No args. Exception range popped
				 * from stack and stack pointer restored. */
................................................................................
    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
    {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
    {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,1},
    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
    {"dictGetDef",	ASSEM_DICT_GET_DEF, INST_DICT_GET_DEF,	INT_MIN,1},
    {"dictIncrImm",	ASSEM_SINT4_LVT4,
					INST_DICT_INCR_IMM,	1,	1},
    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
    {"dictUnset",	ASSEM_DICT_UNSET,
................................................................................
    int count)			/* Count of operands for variadic insts */
{
    int consumed = TalInstructionTable[tblIdx].operandsConsumed;
    int produced = TalInstructionTable[tblIdx].operandsProduced;

    if (consumed == INT_MIN) {
	/*
	 * The instruction is variadic; it consumes 'count' operands, or
	 * 'count+1' for ASSEM_DICT_GET_DEF.
	 */

	consumed = count;
	if (TalInstructionTable[tblIdx].instType == ASSEM_DICT_GET_DEF) {
	    consumed++;
	}
    }
    if (produced < 0) {
	/*
	 * The instruction leaves some of its variadic operands on the stack,
	 * with net stack effect of '-1-produced'
	 */

................................................................................
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_DICT_GET:
    case ASSEM_DICT_GET_DEF:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;

Changes to generic/tclBasic.c.

169
170
171
172
173
174
175

176
177
178
179
180
181
182
...
258
259
260
261
262
263
264

265
266
267
268
269
270
271
...
315
316
317
318
319
320
321

322
323
324
325
326
327
328
...
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
...
967
968
969
970
971
972
973

974
975









976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
....
2364
2365
2366
2367
2368
2369
2370

2371


2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
....
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
....
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
....
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
....
4593
4594
4595
4596
4597
4598
4599

4600


4601

4602


4603
4604
4605
4606
4607
4608

4609
4610
4611
4612
4613
4614
4615
....
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629

4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
....
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
....
4748
4749
4750
4751
4752
4753
4754

4755

4756
4757
4758
4759

4760
4761
4762
4763
4764
4765
4766
....
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
....
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
....
6960
6961
6962
6963
6964
6965
6966

6967


6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
....
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
....
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
....
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
....
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
....
8361
8362
8363
8364
8365
8366
8367


8368


8369
8370
8371
8372
8373


8374


8375
8376
8377
8378
8379
8380
8381
....
8721
8722
8723
8724
8725
8726
8727

8728
8729

8730
8731
8732
8733
8734
8735
8736
....
9173
9174
9175
9176
9177
9178
9179





































































9180
9181
9182
9183
9184
9185
9186
....
9403
9404
9405
9406
9407
9408
9409

9410


9411
9412
9413
9414
9415
9416
9417
9418
9419
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRCoroInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;


MODULE_SCOPE const TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */
................................................................................
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},

    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
................................................................................
    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},

    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
................................................................................
{
    Interp *iPtr;
    Tcl_Interp *interp;
    Command *cmdPtr;
    const BuiltinFuncDef *builtinFuncPtr;
    const OpCmdInfo *opcmdInfoPtr;
    const CmdInfo *cmdInfoPtr;
    Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    CancelInfo *cancelInfo;
    union {
	char c[sizeof(short)];
	short s;
    } order;
................................................................................

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


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










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

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

    /*
     * Register the builtin math functions.
     */

    mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    if (mathfuncNSPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
	Tcl_CreateObjCommand(interp, mathFuncName,
		builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
	Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
    }

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
    if (mathopNSPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, mathopNSPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
................................................................................
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}


	/* An existing command conflicts. Try to delete it.. */


	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve
	 * any existing import links so we can restore them down below. That
	 * way, you can redefine a command and its import status will remain
	 * intact.
	 */

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
	}

................................................................................
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {

	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
	 * compilation, the so-resolved command turns into a CmdName literal.
	 * Without invalidating a possible CmdName literal here explicitly,
	 * such literals keep being reused while pointing to overhauled
................................................................................
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}

	/*
         * An existing command conflicts. Try to delete it.
         */

	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
	 * behavior is kept under particular circumstances to accommodate
	 * deployed binaries of the "tclcompiler" program
	 *     http://sourceforge.net/projects/tclpro/
         * that crash if the bug is fixed.
	 */

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
................................................................................
     * 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 = ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;
    cancelInfo->flags = flags;
................................................................................
    /*
     * Lookup the Command to dispatch.
     */

    reresolve:
    assert(cmdPtr == NULL);
    if (preCmdPtr) {

	/* Caller gave it to us */


	if (!(preCmdPtr->flags & CMD_IS_DELETED)) {

	    /* So long as it exists, use it. */


	    cmdPtr = preCmdPtr;
	} else if (flags & TCL_EVAL_NORESOLVE) {
	    /*
	     * When it's been deleted, and we're told not to attempt
	     * resolving it ourselves, all we can do is raise an error.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
	    return TCL_ERROR;
	}
    }
    if (cmdPtr == NULL) {
................................................................................
	if (!cmdPtr) {
	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
	}
    }

    if (enterTracesDone || iPtr->tracePtr
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {

	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
		objc, objv);
	Tcl_IncrRefCount(commandPtr);


	if (!enterTracesDone) {

	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
		    objc, objv);

	    /*
	     * Send any exception from enter traces back as an exception
	     * raised by the traced command.
	     * TODO: Is this a bug?  Letting an execution trace BREAK or
	     * CONTINUE or RETURN in the place of the traced command?
	     * Would either converting all exceptions to TCL_ERROR, or
	     * just swallowing them be better?  (Swallowing them has the
	     * problem of permanently hiding program errors.)
	     */

	    if (code != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		return code;
	    }

	    /*
	     * If the enter traces made the resolved cmdPtr unusable, go
	     * back and resolve again, but next time don't run enter
	     * traces again.
	     */

	    if (cmdPtr == NULL) {
		enterTracesDone = 1;
		Tcl_DecrRefCount(commandPtr);
		goto reresolve;
	    }
	}

	/*
	 * Schedule leave traces.  Raise the refCount on the resolved
	 * cmdPtr, so that when it passes to the leave traces we know
	 * it's still valid.
	 */

	cmdPtr->refCount++;
	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
		    commandPtr, cmdPtr, objv);
    }

................................................................................
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Interp *iPtr = (Interp *) interp;
#endif /* !defined(TCL_NO_DEPRECATED) */
    NRE_callback *callbackPtr;
    Tcl_NRPostProc *procPtr;

    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
................................................................................

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
#endif /* !defined(TCL_NO_DEPRECATED) */


    /* This is the trampoline. */


    while (TOP_CB(interp) != rootPtr) {
	callbackPtr = TOP_CB(interp);
	procPtr = callbackPtr->procPtr;

	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
    return result;
}

................................................................................
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)){
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
................................................................................
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
................................................................................
                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);


    /* Avoid the exception-handling brain damage when numLevels == 0 . */


    iPtr->numLevels++;
    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);

    /*
     * Normal command resolution of objv[0] isn't going to find cmdPtr.
     * That's the whole point of **hidden** commands.  So tell the
     * Eval core machinery not to even try (and risk finding something wrong).
     */

    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
}

static int
NRPostInvoke(
................................................................................
	    }
	}
	break;
    case TCL_NUMBER_BIG:
	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (SIGN(&big) == MP_NEG) {
	    mp_clear(&big);
	    goto negarg;
	}
	break;
    default:
	if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > (Tcl_WideInt)0) {
	    goto unChanged;
	} else if (l == (Tcl_WideInt)0) {
	    if (TclHasStringRep(objv[1])) {
		int numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
................................................................................
	    goto unChanged;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_BIG) {
	if (mp_isneg((const mp_int *) ptr)) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	unChanged:
	    Tcl_SetObjResult(interp, objv[1]);
................................................................................

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
................................................................................
	kini("line");	kini("level");
#undef kini
    }
    for (i = 0; i < 6; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
	args[i] = val ? TclGetString(val) : NULL;
    }


    /* no "proc" -> use "lambda" */


    if (!args[2]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[2] = val ? TclGetString(val) : NULL;
    }
    k++;


    /* no "class" -> use "object" */


    if (!args[5]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[5] = val ? TclGetString(val) : NULL;
    }
    k++;
    for (i = 0; i < 2; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
................................................................................
     * at the proper time.
     */

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


        /* The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled. */


        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
................................................................................
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *





































































 * NRCoroInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

................................................................................
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);


    /* ensure that the command is looked up in the correct namespace */


    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
    iPtr->numLevels--;

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;

    /*







>







 







>







 







>







 







|







 







>


>
>
>
>
>
>
>
>
>













|
|









|






|
|


|







 







>
|
>
>



|
|
|
<







 







|
|
|






<







 







|





|
|
|
|
|







 







|







 







>
|
>
>

>
|
>
>



|
|

>







 







<



<

>

<







|
|
|
|








|
|
<










|
|
|







 







<
<







 







>
|
>


|
|
>







 







|







 







|







 







>
|
>
>





|
|







 







|







 







|

|







 







|







 







|







 







>
>
|
>
>





>
>
|
>
>







 







>
|
|
>







 







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







 







>
|
>
>

|







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
...
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
...
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
....
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393

2394
2395
2396
2397
2398
2399
2400
....
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421

2422
2423
2424
2425
2426
2427
2428
....
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
....
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
....
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
....
4638
4639
4640
4641
4642
4643
4644

4645
4646
4647

4648
4649
4650

4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671

4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
....
4747
4748
4749
4750
4751
4752
4753


4754
4755
4756
4757
4758
4759
4760
....
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
....
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
....
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
....
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
....
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
....
7799
7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
....
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
....
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
....
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
....
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
....
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
9215
9216
9217
9218
9219
9220
9221
9222
9223
9224
9225
9226
9227
9228
9229
9230
9231
9232
9233
9234
9235
9236
9237
9238
9239
9240
9241
9242
9243
9244
9245
9246
9247
9248
9249
9250
9251
9252
9253
9254
9255
9256
9257
9258
9259
9260
9261
9262
9263
9264
9265
9266
9267
9268
9269
9270
9271
9272
9273
9274
9275
9276
9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
....
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
9517
9518
9519
9520
9521
9522
9523
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

static Tcl_ObjCmdProc NRCoroInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;

MODULE_SCOPE const TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */
................................................................................
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
................................................................................
    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
................................................................................
{
    Interp *iPtr;
    Tcl_Interp *interp;
    Command *cmdPtr;
    const BuiltinFuncDef *builtinFuncPtr;
    const OpCmdInfo *opcmdInfoPtr;
    const CmdInfo *cmdInfoPtr;
    Tcl_Namespace *nsPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    CancelInfo *cancelInfo;
    union {
	char c[sizeof(short)];
	short s;
    } order;
................................................................................

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

    /* Coroutine monkeybusiness */
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRCoroInjectObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
            CoroTypeObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
    }


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

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

    /*
     * Register the builtin math functions.
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
	Tcl_CreateObjCommand(interp, mathFuncName,
		builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
	Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
    }

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
................................................................................
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve any existing import links so we can restore
	 * them down below. That way, you can redefine a command and its
	 * import status will remain intact.

	 */

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
	}

................................................................................
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {

	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
	 * compilation, the so-resolved command turns into a CmdName literal.
	 * Without invalidating a possible CmdName literal here explicitly,
	 * such literals keep being reused while pointing to overhauled
................................................................................
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * [***] This is wrong.  See Tcl Bug a16752c252.
	 * However, this buggy behavior is kept under particular circumstances
	 * to accommodate deployed binaries of the "tclcompiler" program
	 * <http://sourceforge.net/projects/tclpro/> that crash if the bug is
	 * fixed.
	 */

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
................................................................................
     * 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 = ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;
    cancelInfo->flags = flags;
................................................................................
    /*
     * Lookup the Command to dispatch.
     */

    reresolve:
    assert(cmdPtr == NULL);
    if (preCmdPtr) {
	/*
         * Caller gave it to us.
         */

	if (!(preCmdPtr->flags & CMD_IS_DELETED)) {
	    /*
             * So long as it exists, use it.
             */

	    cmdPtr = preCmdPtr;
	} else if (flags & TCL_EVAL_NORESOLVE) {
	    /*
	     * When it's been deleted, and we're told not to attempt resolving
	     * it ourselves, all we can do is raise an error.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
	    return TCL_ERROR;
	}
    }
    if (cmdPtr == NULL) {
................................................................................
	if (!cmdPtr) {
	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
	}
    }

    if (enterTracesDone || iPtr->tracePtr
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {

	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
		objc, objv);


	Tcl_IncrRefCount(commandPtr);
	if (!enterTracesDone) {

	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
		    objc, objv);

	    /*
	     * Send any exception from enter traces back as an exception
	     * raised by the traced command.
	     * TODO: Is this a bug?  Letting an execution trace BREAK or
	     * CONTINUE or RETURN in the place of the traced command?  Would
	     * either converting all exceptions to TCL_ERROR, or just
	     * swallowing them be better?  (Swallowing them has the problem of
	     * permanently hiding program errors.)
	     */

	    if (code != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		return code;
	    }

	    /*
	     * If the enter traces made the resolved cmdPtr unusable, go back
	     * and resolve again, but next time don't run enter traces again.

	     */

	    if (cmdPtr == NULL) {
		enterTracesDone = 1;
		Tcl_DecrRefCount(commandPtr);
		goto reresolve;
	    }
	}

	/*
	 * Schedule leave traces.  Raise the refCount on the resolved cmdPtr,
	 * so that when it passes to the leave traces we know it's still
	 * valid.
	 */

	cmdPtr->refCount++;
	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
		    commandPtr, cmdPtr, objv);
    }

................................................................................
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Interp *iPtr = (Interp *) interp;
#endif /* !defined(TCL_NO_DEPRECATED) */



    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
................................................................................

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
#endif /* !defined(TCL_NO_DEPRECATED) */

    /*
     * This is the trampoline.
     */

    while (TOP_CB(interp) != rootPtr) {
        NRE_callback *callbackPtr = TOP_CB(interp);
        Tcl_NRPostProc *procPtr = callbackPtr->procPtr;

	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
    return result;
}

................................................................................
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
................................................................................
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
................................................................................
                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Avoid the exception-handling brain damage when numLevels == 0
     */

    iPtr->numLevels++;
    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);

    /*
     * Normal command resolution of objv[0] isn't going to find cmdPtr.
     * That's the whole point of **hidden** commands.  So tell the Eval core
     * machinery not to even try (and risk finding something wrong).
     */

    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
}

static int
NRPostInvoke(
................................................................................
	    }
	}
	break;
    case TCL_NUMBER_BIG:
	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (big.sign != MP_ZPOS) {
	    mp_clear(&big);
	    goto negarg;
	}
	break;
    default:
	if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);

	if (l > 0) {
	    goto unChanged;
	} else if (l == 0) {
	    if (TclHasStringRep(objv[1])) {
		int numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
................................................................................
	    goto unChanged;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_BIG) {
	if (((const mp_int *) ptr)->sign != MP_ZPOS) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	unChanged:
	    Tcl_SetObjResult(interp, objv[1]);
................................................................................

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (TclHasIntRep(objv[1], &tclDoubleType)) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
................................................................................
	kini("line");	kini("level");
#undef kini
    }
    for (i = 0; i < 6; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
	args[i] = val ? TclGetString(val) : NULL;
    }

    /*
     * no "proc" -> use "lambda"
     */

    if (!args[2]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[2] = val ? TclGetString(val) : NULL;
    }
    k++;

    /*
     * no "class" -> use "object"
     */

    if (!args[5]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[5] = val ? TclGetString(val) : NULL;
    }
    k++;
    for (i = 0; i < 2; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
................................................................................
     * at the proper time.
     */

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

        /*
         * The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled.
         */

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
................................................................................
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * CoroTypeObjCmd --
 *
 *      Implementation of [::tcl::unsupported::corotype] command.
 *
 *----------------------------------------------------------------------
 */

static int
CoroTypeObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;

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

    /*
     * Look up the coroutine.
     */

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only get coroutine type of a coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

    /*
     * An active coroutine is "active". Can't tell what it might do in the
     * future.
     */

    corPtr = cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
        return TCL_OK;
    }

    /*
     * Inactive coroutines are classified by the (effective) command used to
     * suspend them, which matters when you're injecting a probe.
     */

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
        return TCL_OK;
    case COROUTINE_ARGUMENTS_ARBITRARY:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
        return TCL_OK;
    default:
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unknown coroutine type", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL);
        return TCL_ERROR;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * NRCoroInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

................................................................................
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);

    /*
     * Ensure that the command is looked up in the correct namespace.
     */

    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc - 2, objv + 2), 0);
    iPtr->numLevels--;

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;

    /*

Changes to generic/tclBinary.c.

287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
...
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
...
767
768
769
770
771
772
773

774


775
776
777
778
779
780
781
....
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
....
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
....
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
....
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
....
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return objPtr->typePtr == &properByteArrayType;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
................................................................................
	length = 0;
    }
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
    }
    SET_BYTEARRAY(&ir, byteArrayPtr);

    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}
 
/*
................................................................................
    int improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    Tcl_UniChar ch = 0;
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (objPtr->typePtr == &properByteArrayType) {
	return TCL_OK;
    }
    if (objPtr->typePtr == &tclByteArrayType) {
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

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

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}

static void
DupProperByteArrayInternalRep(
................................................................................

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {

	/* Append zero bytes is a no-op. */


	return;
    }

    length = (unsigned int)len;

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
................................................................................
    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls.
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, (size_t) length);

    /*
     * Pack the data into the result object. Note that we can skip the
     * error checking during this pass, since we have already parsed the
     * string once.
     */

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

	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, (size_t) count);
	    } else {
		memcpy(cursor, bytes, (size_t) length);
		memset(cursor + length, pad, (size_t) (count - length));
	    }
	    cursor += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;
................................................................................
	    }
	    break;
	}
	case 'x':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    memset(cursor, 0, (size_t) count);
	    cursor += count;
	    break;
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
................................................................................
 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[TCL_UTF_MAX + 1];

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }
................................................................................
 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[TCL_UTF_MAX + 1];

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }







|







 







|







 







|


|







 







|







 







|







 







>
|
>
>







 







|







 







|

|
|







 







|







 







|







 







|







287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
...
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
...
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
...
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
...
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
....
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
....
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
....
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
....
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
....
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return TclHasIntRep(objPtr, &properByteArrayType);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
................................................................................
	length = 0;
    }
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }
    SET_BYTEARRAY(&ir, byteArrayPtr);

    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}
 
/*
................................................................................
    int improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    Tcl_UniChar ch = 0;
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

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

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}

static void
DupProperByteArrayInternalRep(
................................................................................

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
	 * Append zero bytes is a no-op.
	 */

	return;
    }

    length = (unsigned int)len;

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
................................................................................
    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls.
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

    /*
     * Pack the data into the result object. Note that we can skip the
     * error checking during this pass, since we have already parsed the
     * string once.
     */

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

	    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;
................................................................................
	    }
	    break;
	}
	case 'x':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    memset(cursor, 0, count);
	    cursor += count;
	    break;
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
................................................................................
 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[TCL_UTF_MAX + 1] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }
................................................................................
 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[TCL_UTF_MAX + 1] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

Changes to generic/tclCkalloc.c.

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
...
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
...
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
...
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }
................................................................................

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	return NULL;
    }
................................................................................
    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}
 
char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
................................................................................
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

 
/*
 *----------------------------------------------------------------------







|







 







|







 







|







 







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
...
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
...
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
...
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc(size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }
................................................................................

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc(size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	return NULL;
    }
................................................................................
    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}
 
char *
Tcl_AttemptDbCkrealloc(
    char *ptr,
................................................................................
    if (copySize > memp->length) {
	copySize = memp->length;
    }
    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

 
/*
 *----------------------------------------------------------------------

Changes to generic/tclClock.c.

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
....
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
....
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (objv[1]->typePtr == &tclBignumType) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */
................................................................................
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
#endif
	break;
    case CLICKS_MICROS:
	Tcl_GetTime(&now);
	clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
    return TCL_OK;
}
 
................................................................................
int
ClockMicrosecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
	    ((Tcl_WideInt) now.sec * 1000000) + now.usec));
    return TCL_OK;
}
 
/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseformatargsObjCmd --







|







 







|
<







 







<
<




<
|
<







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
....
1768
1769
1770
1771
1772
1773
1774
1775

1776
1777
1778
1779
1780
1781
1782
....
1838
1839
1840
1841
1842
1843
1844


1845
1846
1847
1848

1849

1850
1851
1852
1853
1854
1855
1856
    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
     */

    if (TclHasIntRep(objv[1], &tclBignumType)) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */
................................................................................
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
#endif
	break;
    case CLICKS_MICROS:
	clicks = TclpGetMicroseconds();

	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
    return TCL_OK;
}
 
................................................................................
int
ClockMicrosecondsObjCmd(
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
{


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

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));

    return TCL_OK;
}
 
/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseformatargsObjCmd --

Changes to generic/tclCmdAH.c.

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int value;

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

    if (objc == 1) {
	value = 0;
    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit(value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *







|








|


|







928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
int
Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt value;

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

    if (objc == 1) {
	value = 0;
    } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit((int)value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclCmdIL.c.

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
....
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
....
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
....
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
....
2618
2619
2620
2621
2622
2623
2624

2625
2626
2627
2628
2629
2630
2631
2632
2633
2634

2635
2636
2637
2638
2639
2640
2641
2642
2643

2644
2645
2646
2647
2648
2649
2650
2651
....
2696
2697
2698
2699
2700
2701
2702






































































































































2703
2704
2705
2706
2707
2708
2709
....
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
....
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
....
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
....
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
....
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
....
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct SortInfo {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
................................................................................
     * 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;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    target = interp;
    if (objc == 2) {
	target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);
................................................................................
{
    Tcl_Command command;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe slave interpreters can't see aliases as
................................................................................
	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++) {
................................................................................
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    Tcl_Obj *elemPtr;
    Tcl_Obj *listPtr, **elemPtrs;

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

................................................................................
	}
    }
    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);

    /*
     * Second, remove the element.

     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclListObjCopy(NULL, listPtr);
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {
	    return result;
	}

    } else {
	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);

	if (listPtr == NULL) {
	    return TCL_ERROR;
	}
    }

    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);

    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
................................................................................
    if (result != TCL_OK) {
	return result;
    }

    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    return TCL_OK;
}






































































































































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
 *
 *	This procedure is invoked to process the "lrepeat" Tcl command. See
................................................................................
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first < 0) {
	first = 0;
    }
    if (first > listLen) {
	first = listLen;
    }

    if (last >= listLen) {
................................................................................

	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
			TCL_INDEX_NONE, &encoded) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if (encoded == TCL_INDEX_NONE) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", Tcl_GetString(indices[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
................................................................................
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	if (result != TCL_OK) {
	    goto done;
	}
	if (start < 0) {
	    start = 0;
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

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

	    for (j=0 ; j<indexc ; j++) {
		int encoded = 0;
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);

		if ((result == TCL_OK) && (encoded == TCL_INDEX_NONE)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", Tcl_GetString(indexv[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
................................................................................
    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elementArray = ckalloc(length * sizeof(SortElement));

    for (i=0; i < length; i++){
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */
	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
	    if (sortInfo.resultCode != TCL_OK) {
................................................................................

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element %d missing from sublist \"%s\"",







|







 







|







 







|







 







|







 







|







 







|







 







>










>








|
>
|







 







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







 







|







 







|


|







 







|
|







 







|


|







 







|







 







|







52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
....
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
....
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
....
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
....
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
....
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
....
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
....
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
....
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
....
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
....
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
....
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
................................................................................
     * 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;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    target = interp;
    if (objc == 2) {
	target = Tcl_GetSlave(interp, TclGetString(objv[1]));
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);
................................................................................
{
    Tcl_Command command;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe slave interpreters can't see aliases as
................................................................................
	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++) {
................................................................................
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;

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

................................................................................
	}
    }
    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);

    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclListObjCopy(NULL, listPtr);
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_IncrRefCount(listPtr);
    } else {
	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);

	if (listPtr == NULL) {
	    return TCL_ERROR;
	}
    }

    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(listPtr);
    if (stored == NULL) {
	return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
................................................................................
    if (result != TCL_OK) {
	return result;
    }

    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LremoveObjCmd --
 *
 *	This procedure is invoked to process the "lremove" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
LremoveIndexCompare(
    const void *el1Ptr,
    const void *el2Ptr)
{
    int idx1 = *((const int *) el1Ptr);
    int idx2 = *((const int *) el2Ptr);

    /*
     * This will put the larger element first.
     */

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc;
    int listLen, *idxv, prevIdx, first, num;
    Tcl_Obj *listObj;

    /*
     * Parse the arguments.
     */

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

    listObj = objv[1];
    if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
	return TCL_ERROR;
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = ckalloc((objc - 2) * sizeof(int));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    ckfree(idxv);
	    return TCL_ERROR;
	}
    }

    /*
     * Sort the indices, large to small so that when we remove an index we
     * don't change the indices still to be processed.
     */

    if (idxc > 1) {
	qsort(idxv, idxc, sizeof(int), LremoveIndexCompare);
    }

    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
	listObj = TclListObjCopy(NULL, listObj);
    }
    num = 0;
    first = listLen;
    for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
	int idx = idxv[i];

	/*
	 * Repeated index and sanity check.
	 */

	if (idx == prevIdx) {
	    continue;
	}
	prevIdx = idx;
	if (idx < 0 || idx >= listLen) {
	    continue;
	}

	/*
	 * Coalesce adjacent removes to reduce the number of copies.
	 */

	if (num == 0) {
	    num = 1;
	    first = idx;
	} else if (idx + 1 == first) {
	    num++;
	    first = idx;
	} else {
	    /*
	     * Note that this operation can't fail now; we know we have a list
	     * and we're only ever contracting that list.
	     */

	    (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
	    listLen -= num;
	    num = 1;
	    first = idx;
	}
    }
    if (num != 0) {
	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
    }
    ckfree(idxv);
    Tcl_SetObjResult(interp, listObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
 *
 *	This procedure is invoked to process the "lrepeat" Tcl command. See
................................................................................
    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    }
    if (first > listLen) {
	first = listLen;
    }

    if (last >= listLen) {
................................................................................

	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
			TCL_INDEX_NONE, &encoded) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if (encoded == (int)TCL_INDEX_NONE) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", TclGetString(indices[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
................................................................................
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	if (result != TCL_OK) {
	    goto done;
	}
	if (start == TCL_INDEX_NONE) {
	    start = TCL_INDEX_START;
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

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

	    for (j=0 ; j<indexc ; j++) {
		int encoded = 0;
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);

		if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", TclGetString(indexv[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
................................................................................
    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elementArray = ckalloc(length * sizeof(SortElement));

    for (i=0; i < length; i++) {
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */
	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
	    if (sortInfo.resultCode != TCL_OK) {
................................................................................

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == (int)TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element %d missing from sublist \"%s\"",

Changes to generic/tclCmdMZ.c.

13
14
15
16
17
18
19

20
21
22
23
24
25
26
....
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
....
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457

























































1458
1459
1460
1461
1462
1463
1464
....
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
....
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
....
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
....
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
....
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
....
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
....
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
....
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
....
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377

2378
2379
2380
2381
2382
2383
2384
2385
2386

2387
2388
2389
2390
2391
2392
2393
....
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
....
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
....
3264
3265
3266
3267
3268
3269
3270

3271
3272
3273
3274
3275
3276
3277
....
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
....
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
....
4062
4063
4064
4065
4066
4067
4068










































































































































































































































































































































































































































































































































































4069
4070
4071
4072
4073
4074
4075
 * 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 "tclRegexp.h"
#include "tclStringTrim.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
................................................................................

	for ( ; stringPtr < end; stringPtr += len) {
	    int fullchar;
	    len = TclUtfToUniChar(stringPtr, &ch);
	    fullchar = ch;

#if TCL_UTF_MAX <= 4
	    if (!len) {
		len += TclUtfToUniChar(stringPtr, &ch);
		fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif

	    /*
	     * Assume Tcl_UniChar is an integral type...
	     */
................................................................................
	 */

	if (TclIsPureByteArray(objv[1])) {
	    unsigned char uch = (unsigned char) ch;

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4];

	    length = Tcl_UniCharToUtf(ch, buf);
	    if (!length) {
		length = Tcl_UniCharToUtf(-1, buf);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
	}
    }
    return TCL_OK;
}

























































 
/*
 *----------------------------------------------------------------------
 *
 * StringIsCmd --
 *
 *	This procedure is invoked to process the "string is" Tcl command. See
................................................................................
	break;
    case STR_IS_ASCII:
	chcomp = UniCharIsAscii;
	break;
    case STR_IS_BOOL:
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if ((objPtr->typePtr != &tclBooleanType)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
................................................................................
	}
	break;
    }
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE: {
	if ((objPtr->typePtr == &tclDoubleType) ||
		(objPtr->typePtr == &tclIntType) ||
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
................................................................................
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
................................................................................
	}
	end = string1 + length1;
	for (; string1 < end; string1 += length2, failat++) {
	    int fullchar;
	    length2 = TclUtfToUniChar(string1, &ch);
	    fullchar = ch;
#if TCL_UTF_MAX <= 4
	    if (!length2) {
	    	length2 = TclUtfToUniChar(string1, &ch);
	    	fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif
	    if (!chcomp(fullchar)) {
		result = 0;
		break;
	    }
................................................................................
	return TCL_ERROR;
    }

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

	if ((length2 > 1) &&
		strncmp(string, "-nocase", (size_t) length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
................................................................................

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
	    && (objv[objc-2]->typePtr == &tclDictType)){
	int i, done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */
................................................................................

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
................................................................................
    }

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

	if ((length > 1) &&
	    strncmp(string, "-nocase", (size_t) length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
................................................................................
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as
     * candidates for replacement. When they are detected, no
     * replacement is done, and the result is the original string,
     */

    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */

	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	if (first < 0) {
	    first = 0;
	}
................................................................................
	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", (size_t)length)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", (size_t)length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
................................................................................
	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", (size_t)length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", (size_t)length)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
................................................................................
    static const EnsembleImplMap stringImplMap[] = {
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},

	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
................................................................................
     */

    splitObjs = 0;
    if (objc == 1) {
	Tcl_Obj **listv;

	blist = objv[0];
	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Ensure that the list is non-empty.
	 */

................................................................................
    i = count;
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&start);
#else
    start = TclpGetWideClicks();
#endif
    while (i-- > 0) {
	result = Tcl_EvalObjEx(interp, objPtr, 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&stop);
    totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
................................................................................
    TclNewLiteralStringObj(objs[1], "microseconds");
    TclNewLiteralStringObj(objs[2], "per");
    TclNewLiteralStringObj(objs[3], "iteration");
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));

    return TCL_OK;
}










































































































































































































































































































































































































































































































































































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TryObjCmd, TclNRTryObjCmd --
 *
 *	This procedure is invoked to process the "try" Tcl command. See the







>







 







|
|







 







|


|
|






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







 







|







 







|
|
|







 







|
|







 







|
|







 







|







 







|







 







|







 







|







 







|




|
|
|

>









>







 







|


|







 







|


|







 







>







 







|







 







|







 







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







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
....
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
....
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
....
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
....
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
....
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
....
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
....
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
....
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
....
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
....
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
....
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
....
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
....
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
....
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
....
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
....
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
....
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
 * 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"
#include "tclRegexp.h"
#include "tclStringTrim.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
................................................................................

	for ( ; stringPtr < end; stringPtr += len) {
	    int fullchar;
	    len = TclUtfToUniChar(stringPtr, &ch);
	    fullchar = ch;

#if TCL_UTF_MAX <= 4
	    if ((ch >= 0xD800) && (len < 3)) {
		len += TclUtfToUniChar(stringPtr + len, &ch);
		fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif

	    /*
	     * Assume Tcl_UniChar is an integral type...
	     */
................................................................................
	 */

	if (TclIsPureByteArray(objv[1])) {
	    unsigned char uch = (unsigned char) ch;

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4] = "";

	    length = Tcl_UniCharToUtf(ch, buf);
	    if ((ch >= 0xD800) && (length < 3)) {
		length += Tcl_UniCharToUtf(-1, buf + length);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
	}
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringInsertCmd --
 *
 *	This procedure is invoked to process the "string insert" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringInsertCmd(
    ClientData dummy,		/* Not used */
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int length;			/* String length */
    int index;			/* Insert index */
    Tcl_Obj *outObj;		/* Output object */

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

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

    if (index < 0) {
	index = 0;
    }
    if (index > length) {
	index = length;
    }

    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
	    TCL_STRING_IN_PLACE);

    if (outObj != NULL) {
	Tcl_SetObjResult(interp, outObj);
	return TCL_OK;
    }

    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringIsCmd --
 *
 *	This procedure is invoked to process the "string is" Tcl command. See
................................................................................
	break;
    case STR_IS_ASCII:
	chcomp = UniCharIsAscii;
	break;
    case STR_IS_BOOL:
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if (!TclHasIntRep(objPtr, &tclBooleanType)
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
................................................................................
	}
	break;
    }
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	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;
	    }
................................................................................
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
................................................................................
	}
	end = string1 + length1;
	for (; string1 < end; string1 += length2, failat++) {
	    int fullchar;
	    length2 = TclUtfToUniChar(string1, &ch);
	    fullchar = ch;
#if TCL_UTF_MAX <= 4
	    if ((ch >= 0xD800) && (length2 < 3)) {
	    	length2 += TclUtfToUniChar(string1 + length2, &ch);
	    	fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
	    }
#endif
	    if (!chcomp(fullchar)) {
		result = 0;
		break;
	    }
................................................................................
	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));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
................................................................................

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
	    && TclHasIntRep(objv[objc-2], &tclDictType)) {
	int i, done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */
................................................................................

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
................................................................................
    }

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

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
................................................................................
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.
     */

    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */

	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	if (first < 0) {
	    first = 0;
	}
................................................................................
	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;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
................................................................................
	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;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
................................................................................
    static const EnsembleImplMap stringImplMap[] = {
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
................................................................................
     */

    splitObjs = 0;
    if (objc == 1) {
	Tcl_Obj **listv;

	blist = objv[0];
	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Ensure that the list is non-empty.
	 */

................................................................................
    i = count;
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&start);
#else
    start = TclpGetWideClicks();
#endif
    while (i-- > 0) {
	result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&stop);
    totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
................................................................................
    TclNewLiteralStringObj(objs[1], "microseconds");
    TclNewLiteralStringObj(objs[2], "per");
    TclNewLiteralStringObj(objs[3], "iteration");
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TimeRateObjCmd --
 *
 *	This object-based procedure is invoked to process the "timerate" Tcl
 *	command.
 *
 *	This is similar to command "time", except the execution limited by
 *	given time (in milliseconds) instead of repetition count.
 *
 * Example:
 *	timerate {after 5} 1000; # equivalent to: time {after 5} [expr 1000/5]
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TimeRateObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static double measureOverhead = 0;
				/* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    register Tcl_Obj *objPtr;
    register int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    Tcl_WideUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt maxms = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
    Tcl_WideUInt maxcnt = WIDE_MAX;
				/* Maximal count of iterations. */
    Tcl_WideUInt threshold = 1;	/* Current threshold for check time (faster
				 * repeat count without time check) */
    Tcl_WideUInt maxIterTm = 1;	/* Max time of some iteration as max
				 * threshold, additionally avoiding divide to
				 * zero (i.e., never < 1) */
    unsigned short factor = 50;	/* Factor (4..50) limiting threshold to avoid
				 * growth of execution time. */
    register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;
    int codeOptimized = 0;

    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
	}
	if (index == TMRT_LAST) {
	    i++;
	    break;
	}
	switch (index) {
	case TMRT_EV_DIRECT:
	    direct = objv[i];
	    break;
	case TMRT_OVERHEAD:
	    if (++i >= objc - 1) {
		goto usage;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case TMRT_CALIBRATE:
	    calibrate = objv[i];
	    break;
	}
    }

    if (i >= objc || i < objc - 3) {
    usage:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-direct? ?-calibrate? ?-overhead double? "
		"command ?time ?max-count??");
	return TCL_ERROR;
    }
    objPtr = objv[i++];
    if (i < objc) {	/* max-time */
	result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms);
	if (result != TCL_OK) {
	    return result;
	}
	if (i < objc) {	/* max-count*/
	    Tcl_WideInt v;

	    result = Tcl_GetWideIntFromObj(interp, objv[i], &v);
	    if (result != TCL_OK) {
		return result;
	    }
	    maxcnt = (v > 0) ? v : 0;
	}
    }

    /*
     * If we are doing calibration.
     */

    if (calibrate) {
	/*
	 * If no time specified for the calibration.
	 */

	if (maxms == WIDE_MIN) {
	    Tcl_Obj *clobjv[6];
	    Tcl_WideInt maxCalTime = 5000;
	    double lastMeasureOverhead = measureOverhead;

	    clobjv[0] = objv[0];
	    i = 1;
	    if (direct) {
		clobjv[i++] = direct;
	    }
	    clobjv[i++] = objPtr;

	    /*
	     * Reset last measurement overhead.
	     */

	    measureOverhead = (double) 0;

	    /*
	     * Self-call with 100 milliseconds to warm-up, before entering the
	     * calibration cycle.
	     */

	    TclNewIntObj(clobjv[i], 100);
	    Tcl_IncrRefCount(clobjv[i]);
	    result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
	    Tcl_DecrRefCount(clobjv[i]);
	    if (result != TCL_OK) {
		return result;
	    }

	    i--;
	    clobjv[i++] = calibrate;
	    clobjv[i++] = objPtr;

	    /*
	     * Set last measurement overhead to max.
	     */

	    measureOverhead = (double) UWIDE_MAX;

	    /*
	     * Run the calibration cycle until it is more precise.
	     */

	    maxms = -1000;
	    do {
		lastMeasureOverhead = measureOverhead;
		TclNewIntObj(clobjv[i], (int) maxms);
		Tcl_IncrRefCount(clobjv[i]);
		result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
		Tcl_DecrRefCount(clobjv[i]);
		if (result != TCL_OK) {
		    return result;
		}
		maxCalTime += maxms;

		/*
		 * Increase maxms for more precise calibration.
		 */

		maxms -= -maxms / 4;

		/*
		 * As long as new value more as 0.05% better
		 */
	    } while ((measureOverhead >= lastMeasureOverhead
		    || measureOverhead / lastMeasureOverhead <= 0.9995)
		    && maxCalTime > 0);

	    return result;
	}
	if (maxms == 0) {
	    /*
	     * Reset last measurement overhead
	     */

	    measureOverhead = 0;
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
	    return TCL_OK;
	}

	/*
	 * If time is negative, make current overhead more precise.
	 */

	if (maxms > 0) {
	    /*
	     * Set last measurement overhead to max.
	     */

	    measureOverhead = (double) UWIDE_MAX;
	} else {
	    maxms = -maxms;
	}
    }

    if (maxms == WIDE_MIN) {
	maxms = 1000;
    }
    if (overhead == -1) {
	overhead = measureOverhead;
    }

    /*
     * Ensure that resetting of result will not smudge the further
     * measurement.
     */

    Tcl_ResetResult(interp);

    /*
     * Compile object if needed.
     */

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);
	/* 
	 * Replace last compiled done instruction with continue: it's a part of
	 * iteration, this way evaluation will be more similar to a cycle (also
	 * avoids extra overhead to set result to interp, etc.)
	 */
	if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
	    codeOptimized = 1;
	}
    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
    start = middle = TclpGetWideClicks();

    /*
     * Time to stop execution (in wide clicks).
     */

    stop = start + (maxms * 1000 / TclpWideClickInMicrosec());
#else
    Tcl_GetTime(&now);
    start = now.sec;
    start *= 1000000;
    start += now.usec;
    middle = start;

    /*
     * Time to stop execution (in microsecs).
     */

    stop = start + maxms * 1000;
#endif /* TCL_WIDE_CLICKS */

    /*
     * Start measurement.
     */

    if (maxcnt > 0) {
	while (1) {
	    /*
	     * Evaluate a single iteration.
	     */

	    count++;
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }
	    /*
	     * Allow break and continue from measurement cycle (used for
	     * conditional stop and flow control of iterations).
	     */

	    switch (result) {
		case TCL_OK:
		    break;
		case TCL_BREAK:
		    /*
		     * Force stop immediately.
		     */
		    threshold = 1;
		    maxcnt = 0;
		case TCL_CONTINUE:
		    result = TCL_OK;
		    break;
		default:
		    goto done;
	    }

	    /*
	     * Don't check time up to threshold.
	     */

	    if (--threshold > 0) {
		continue;
	    }

	    /*
	     * Check stop time reached, estimate new threshold.
	     */

#ifdef TCL_WIDE_CLICKS
	    middle = TclpGetWideClicks();
#else
	    Tcl_GetTime(&now);
	    middle = now.sec;
	    middle *= 1000000;
	    middle += now.usec;
#endif /* TCL_WIDE_CLICKS */

	    if (middle >= stop || count >= maxcnt) {
		break;
	    }

	    /*
	     * Don't calculate threshold by few iterations, because sometimes
	     * first iteration(s) can be too fast or slow (cached, delayed
	     * clean up, etc).
	     */

	    if (count < 10) {
		threshold = 1;
		continue;
	    }

	    /*
	     * Average iteration time in microsecs.
	     */

	    threshold = (middle - start) / count;
	    if (threshold > maxIterTm) {
		maxIterTm = threshold;

		/*
		 * Iterations seem to be longer.
		 */

		if (threshold > maxIterTm * 2) {
		    factor *= 2;
		    if (factor > 50) {
			factor = 50;
		    }
		} else {
		    if (factor < 50) {
			factor++;
		    }
		}
	    } else if (factor > 4) {
		/*
		 * Iterations seem to be shorter.
		 */

		if (threshold < (maxIterTm / 2)) {
		    factor /= 2;
		    if (factor < 4) {
			factor = 4;
		    }
		} else {
		    factor--;
		}
	    }

	    /*
	     * As relation between remaining time and time since last check,
	     * maximal some % of time (by factor), so avoid growing of the
	     * execution time if iterations are not consistent, e.g. was
	     * continuously on time).
	     */

	    threshold = ((stop - middle) / maxIterTm) / factor + 1;
	    if (threshold > 100000) {	/* fix for too large threshold */
		threshold = 100000;
	    }

	    /*
	     * Consider max-count
	     */

	    if (threshold > maxcnt - count) {
		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideInt val;
	int digits;

	middle -= start;		/* execution time in microsecs */

#ifdef TCL_WIDE_CLICKS
	/*
	 * convert execution time in wide clicks to microsecs.
	 */

	middle *= TclpWideClickInMicrosec();
#endif /* TCL_WIDE_CLICKS */

	if (!count) {		/* no iterations - avoid divide by zero */
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

	/*
	 * If not calibrating...
	 */

	if (!calibrate) {
	    /*
	     * Minimize influence of measurement overhead.
	     */

	    if (overhead > 0) {
		/*
		 * Estimate the time of overhead (microsecs).
		 */

		Tcl_WideUInt curOverhead = overhead * count;

		if (middle > (Tcl_WideInt) curOverhead) {
		    middle -= curOverhead;
		} else {
		    middle = 0;
		}
	    }
	} else {
	    /*
	     * Calibration: obtaining new measurement overhead.
	     */

	    if (measureOverhead > ((double) middle) / count) {
		measureOverhead = ((double) middle) / count;
	    }
	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = middle / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    objs[0] = Tcl_NewWideIntObj(val);
	} else {
	    if (val < 10) {
		digits = 6;
	    } else if (val < 100) {
		digits = 4;
	    } else if (val < 1000) {
		digits = 3;
	    } else if (val < 10000) {
		digits = 2;
	    } else {
		digits = 1;
	    }
	    objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) middle)/count);
	}

	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!middle) {
	    middle++;			/* Avoid divide by zero. */
	}
	if (count < (WIDE_MAX / 1000000)) {
	    val = (count * 1000000) / middle;
	    if (val < 100000) {
		if (val < 100) {
		    digits = 3;
		} else if (val < 1000) {
		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / middle);
	    } else {
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / middle) * 1000000);
	}

    retRes:
	/*
	 * Estimated net execution time (in millisecs).
	 */

	if (!calibrate) {
	    if (middle >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)middle / 1000);
	    } else {
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "nett-ms");
	}

	/*
	 * Construct the result as a list because many programs have always
	 * parsed as such (extracting the first element, typically).
	 */

	TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {
	if ( codeOptimized
	  && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
	) {
	    codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
	}
	TclReleaseByteCode(codePtr);
    }
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TryObjCmd, TclNRTryObjCmd --
 *
 *	This procedure is invoked to process the "try" Tcl command. See the

Changes to generic/tclCompCmds.c.

1171
1172
1173
1174
1175
1176
1177
































1178
1179
1180
1181
1182
1183
1184
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

































int
TclCompileDictExistsCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being







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







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
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

int
TclCompileDictGetWithDefaultCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least three arguments after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    for (i=1 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET_DEF, parsePtr->numWords-3, envPtr);
    TclAdjustStackDepth(-2, envPtr);
    return TCL_OK;
}

int
TclCompileDictExistsCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being

Changes to generic/tclCompCmdsGR.c.

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
...
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
....
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
....
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
....
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
....
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
....
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
....
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
....
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
....
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
....
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
....
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
....
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */
................................................................................
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	goto notCompilable;
    }
    bytes = Tcl_GetString(objPtr);

    /*
     * We require that the argument start with "::" and not have any of "*\[?"
     * in it. (Theoretically, we should look in only the final component, but
     * the difference is so slight given current naming practices.)
     */

................................................................................
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(			TCL_INDEX_END,		envPtr);

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
     * at this point. We use an [lrange ... 0 end] for this (instead of
     * [llength], as with literals) as we must drop any string representation
     * that might be hanging around.
     */

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			TCL_INDEX_END,	envPtr);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if ((TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &idx1) != TCL_OK) || (idx1 == TCL_INDEX_NONE)) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "first" indices
     * before the list same as the start of the list.
     */

................................................................................
     * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
     * this is a splice (== split, insert values as list, concat-3).
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (parsePtr->numWords == 3) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt4(		INST_LIST, i - 3,		envPtr);

    if (idx == TCL_INDEX_START) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else if (idx == TCL_INDEX_END) {
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else {
	/*
	 * Here we handle two ranges for idx. First when idx > 0, we
	 * want the first half of the split to end at index idx-1 and
	 * the second half to start at index idx.
	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
................................................................................
	 * we want the first half of the split to end at index end-N and
	 * the second half to start at index end-N+1. We accomplish this
	 * with a pre-adjustment of the end-N value.
	 * The root of this is that the commands [lrange] and [linsert]
	 * differ in their interpretation of the "end" index.
	 */

	if (idx < TCL_INDEX_END) {
	    idx++;
	}
	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx - 1,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    }

    return TCL_OK;
}
 
................................................................................
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */

    if (idx1 == TCL_INDEX_NONE) {
	suffixStart = TCL_INDEX_NONE;
    } else if (idx2 == TCL_INDEX_NONE) {
	suffixStart = idx1;
    } else if (idx2 == TCL_INDEX_END) {
	suffixStart = TCL_INDEX_NONE;
    } else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
	    || ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {
	return TCL_ERROR;
    }

    /* All paths start with computing/pushing the original value. */
    CompileWord(envPtr, listTokenPtr, interp, 1);
................................................................................
    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    if (idx1 != TCL_INDEX_START) {
	/* Prefix may not be empty; generate bytecode to push it */
	if (emptyPrefix) {
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	}
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
................................................................................
	emptyPrefix = 0;
    }

    if (!emptyPrefix) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    if (suffixStart == TCL_INDEX_NONE) {
	TclEmitOpcode(		INST_POP,			envPtr);
	if (emptyPrefix) {
	    PushStringLiteral(envPtr, "");
	}
    } else {
	/* Suffix may not be empty; generate bytecode to push it */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
	TclEmitInt4(			TCL_INDEX_END,		envPtr);
	if (!emptyPrefix) {
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
    }

    return TCL_OK;
}
................................................................................
	}
	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;
................................................................................

    Tcl_DStringInit(&pattern);
    tokenPtr = TokenAfter(tokenPtr);
    patternObj = Tcl_NewObj();
    if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
	goto done;
    }
    if (Tcl_GetString(patternObj)[0] == '-') {
	if (strcmp(Tcl_GetString(patternObj), "--") != 0
		|| parsePtr->numWords == 5) {
	    goto done;
	}
	tokenPtr = TokenAfter(tokenPtr);
	Tcl_DecrRefCount(patternObj);
	patternObj = Tcl_NewObj();
	if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
................................................................................
	    }
	case '\0': case '?': case '[': case '\\':
	    goto done;
	}
	bytes++;
    }
  isSimpleGlob:
    for (bytes = Tcl_GetString(replacementObj); *bytes; bytes++) {
	switch (*bytes) {
	case '\\': case '&':
	    goto done;
	}
    }

    /*







|







 







|







 







|







 







|







 







|







 







|









|


|







 







|







|







 







|
|
|

|
|
|
|







 







|



|







 







|







|







 







|







 







|
|







 







|







429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
...
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
....
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
....
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
....
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
....
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
....
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
....
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
....
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
....
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
....
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
....
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
....
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */
................................................................................
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	goto notCompilable;
    }
    bytes = TclGetString(objPtr);

    /*
     * We require that the argument start with "::" and not have any of "*\[?"
     * in it. (Theoretically, we should look in only the final component, but
     * the difference is so slight given current naming practices.)
     */

................................................................................
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
     * at this point. We use an [lrange ... 0 end] for this (instead of
     * [llength], as with literals) as we must drop any string representation
     * that might be hanging around.
     */

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,	envPtr);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if ((TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &idx1) != TCL_OK) || (idx1 == (int)TCL_INDEX_NONE)) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "first" indices
     * before the list same as the start of the list.
     */

................................................................................
     * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
     * this is a splice (== split, insert values as list, concat-3).
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (parsePtr->numWords == 3) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt4(		INST_LIST, i - 3,		envPtr);

    if (idx == (int)TCL_INDEX_START) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else if (idx == (int)TCL_INDEX_END) {
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else {
	/*
	 * Here we handle two ranges for idx. First when idx > 0, we
	 * want the first half of the split to end at index idx-1 and
	 * the second half to start at index idx.
	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
................................................................................
	 * we want the first half of the split to end at index end-N and
	 * the second half to start at index end-N+1. We accomplish this
	 * with a pre-adjustment of the end-N value.
	 * The root of this is that the commands [lrange] and [linsert]
	 * differ in their interpretation of the "end" index.
	 */

	if (idx < (int)TCL_INDEX_END) {
	    idx++;
	}
	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx - 1,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    }

    return TCL_OK;
}
 
................................................................................
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (idx2 == (int)TCL_INDEX_NONE) {
	suffixStart = idx1;
    } else if (idx2 == (int)TCL_INDEX_END) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (((idx2 < (int)TCL_INDEX_END) && (idx1 <= (int)TCL_INDEX_END))
	    || ((idx2 >= (int)TCL_INDEX_START) && (idx1 >= (int)TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {
	return TCL_ERROR;
    }

    /* All paths start with computing/pushing the original value. */
    CompileWord(envPtr, listTokenPtr, interp, 1);
................................................................................
    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    if (idx1 != (int)TCL_INDEX_START) {
	/* Prefix may not be empty; generate bytecode to push it */
	if (emptyPrefix) {
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	}
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
................................................................................
	emptyPrefix = 0;
    }

    if (!emptyPrefix) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    if (suffixStart == (int)TCL_INDEX_NONE) {
	TclEmitOpcode(		INST_POP,			envPtr);
	if (emptyPrefix) {
	    PushStringLiteral(envPtr, "");
	}
    } else {
	/* Suffix may not be empty; generate bytecode to push it */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	if (!emptyPrefix) {
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
    }

    return TCL_OK;
}
................................................................................
	}
	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str, "-nocase", len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;
................................................................................

    Tcl_DStringInit(&pattern);
    tokenPtr = TokenAfter(tokenPtr);
    patternObj = Tcl_NewObj();
    if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
	goto done;
    }
    if (TclGetString(patternObj)[0] == '-') {
	if (strcmp(TclGetString(patternObj), "--") != 0
		|| parsePtr->numWords == 5) {
	    goto done;
	}
	tokenPtr = TokenAfter(tokenPtr);
	Tcl_DecrRefCount(patternObj);
	patternObj = Tcl_NewObj();
	if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
................................................................................
	    }
	case '\0': case '?': case '[': case '\\':
	    goto done;
	}
	bytes++;
    }
  isSimpleGlob:
    for (bytes = TclGetString(replacementObj); *bytes; bytes++) {
	switch (*bytes) {
	case '\\': case '&':
	    goto done;
	}
    }

    /*

Changes to generic/tclCompCmdsSZ.c.

443
444
445
446
447
448
449

























































450
451
452
453
454
455
456
...
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
...
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
...
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
....
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
....
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
....
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
....
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}


























































int
TclCompileStringIsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
................................................................................

    if (parsePtr->numWords == 4) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	str = tokenPtr[1].start;
	length = tokenPtr[1].size;
	if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
	    /*
	     * Fail at run time, not in compilation.
	     */

	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	nocase = 1;
................................................................................
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == TCL_INDEX_NONE) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
................................................................................
	    &idx2) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == TCL_INDEX_NONE) {
	/* [string range $s $first -1] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    /*
................................................................................
     *		(last < 0)		OR
     *		(end < first)
     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

    if ((last == TCL_INDEX_NONE)		/* Know (last < 0) */
	    || (first == TCL_INDEX_NONE)	/* Know (first > end) */

	/*
	 * Tricky to determine when runtime (last < first) can be
	 * certainly known based on the encoded values. Consider the
	 * cases...
	 *
	 * (first <= TCL_INDEX_END) &&
	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
	 *	else => cannot tell REJECT
	 */
	    || ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END)
		&& (last < first))		/* Know (last < first) */
	/*
	 * (first == TCL_INDEX_NONE) &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else		=> (first < last) REJECT
	 *
	 * else [[first >= TCL_INDEX_START]] &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
	 */
	    || ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START)
		&& (last < first))) {		/* Know (last < first) */
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP(		POP);		/* Pop newString */
	}
	/* Original string argument now on TOS as result */
................................................................................
     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */

    if ((first == TCL_INDEX_START) && (last >= TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == INT_MAX) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }

    if ((last == TCL_INDEX_NONE) && (first <= TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	return TCL_OK;
    }

................................................................................
    } else {
	/*
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
	 * are harmless when they are replaced by another empty string.
	 */

	if (first == TCL_INDEX_START) {
	    /* empty prefix - build suffix only */

	    if (last == TCL_INDEX_END) {
		/* empty suffix too => empty result */
		OP(	POP);		/* Pop  original */
		PUSH	(	"");
		return TCL_OK;
	    }
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    return TCL_OK;
	} else {
	    if (last == TCL_INDEX_END) {
		/* empty suffix - build prefix only */
		OP44(	STR_RANGE_IMM, 0, first-1);
		return TCL_OK;
	    }
	    OP(		DUP);
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    OP4(	REVERSE, 2);
	    OP44(	STR_RANGE_IMM, last + 1, TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	    return TCL_OK;
	}
    }

    genericReplace:
	tokenPtr = TokenAfter(valueTokenPtr);
................................................................................
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	int length, literal, catchRange, breakJump;
	char buf[TCL_UTF_MAX];
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    literal = TclRegisterLiteral(envPtr,
		    tokenPtr->start, tokenPtr->size, 0);







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







 







|







 







|







 







|







 







|
|










|










|







 







|







|





|







 







|


|





|


|







|







 







|







443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
...
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
....
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
....
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
....
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
....
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
....
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
....
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}

int
TclCompileStringInsertCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx;

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

    /* Compute and push the string in which to insert */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /* See what can be discovered about index at compile time */
    tokenPtr = TokenAfter(tokenPtr);
    if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
	    TCL_INDEX_END, &idx)) {

	/* Nothing useful knowable - cease compile; let it direct eval */
	return TCL_OK;
    }

    /* Compute and push the string to be inserted */
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    if (idx == (int)TCL_INDEX_START) {
	/* Prepend the insertion string */
	OP4(	REVERSE, 2);
	OP1(	STR_CONCAT1, 2);
    } else  if (idx == (int)TCL_INDEX_END) {
	/* Append the insertion string */
	OP1(	STR_CONCAT1, 2);
    } else {
	/* Prefix + insertion + suffix */
	if (idx < (int)TCL_INDEX_END) {
	    /* See comments in compiler for [linsert]. */
	    idx++;
	}
	OP4(	OVER, 1);
	OP44(	STR_RANGE_IMM, 0, idx-1);
	OP4(	REVERSE, 3);
	OP44(	STR_RANGE_IMM, idx, TCL_INDEX_END);
	OP1(	STR_CONCAT1, 3);
    }

    return TCL_OK;
}

int
TclCompileStringIsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
................................................................................

    if (parsePtr->numWords == 4) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	str = tokenPtr[1].start;
	length = tokenPtr[1].size;
	if ((length <= 1) || strncmp(str, "-nocase", length)) {
	    /*
	     * Fail at run time, not in compilation.
	     */

	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	nocase = 1;
................................................................................
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
................................................................................
	    &idx2) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == (int)TCL_INDEX_NONE) {
	/* [string range $s $first -1] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    /*
................................................................................
     *		(last < 0)		OR
     *		(end < first)
     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

    if ((last == (int)TCL_INDEX_NONE)		/* Know (last < 0) */
	    || (first == (int)TCL_INDEX_NONE)	/* Know (first > end) */

	/*
	 * Tricky to determine when runtime (last < first) can be
	 * certainly known based on the encoded values. Consider the
	 * cases...
	 *
	 * (first <= TCL_INDEX_END) &&
	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
	 *	else => cannot tell REJECT
	 */
	    || ((first <= (int)TCL_INDEX_END) && (last <= (int)TCL_INDEX_END)
		&& (last < first))		/* Know (last < first) */
	/*
	 * (first == TCL_INDEX_NONE) &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else		=> (first < last) REJECT
	 *
	 * else [[first >= TCL_INDEX_START]] &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
	 */
	    || ((first >= (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)
		&& (last < first))) {		/* Know (last < first) */
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP(		POP);		/* Pop newString */
	}
	/* Original string argument now on TOS as result */
................................................................................
     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */

    if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == INT_MAX) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }

    if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	return TCL_OK;
    }

................................................................................
    } else {
	/*
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
	 * are harmless when they are replaced by another empty string.
	 */

	if (first == (int)TCL_INDEX_START) {
	    /* empty prefix - build suffix only */

	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix too => empty result */
		OP(	POP);		/* Pop  original */
		PUSH	(	"");
		return TCL_OK;
	    }
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    return TCL_OK;
	} else {
	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix - build prefix only */
		OP44(	STR_RANGE_IMM, 0, first-1);
		return TCL_OK;
	    }
	    OP(		DUP);
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    OP4(	REVERSE, 2);
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	    return TCL_OK;
	}
    }

    genericReplace:
	tokenPtr = TokenAfter(valueTokenPtr);
................................................................................
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	int length, literal, catchRange, breakJump;
	char buf[4] = "";
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    literal = TclRegisterLiteral(envPtr,
		    tokenPtr->start, tokenPtr->size, 0);

Changes to generic/tclCompExpr.c.

2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
....
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (literal->typePtr == &tclDoubleType) {
		const char *p = start;

		while (p < end) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we
			 * must treat it as a number.
................................................................................
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, start, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }







|







 







|

|







2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
....
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (TclHasIntRep(literal, &tclDoubleType)) {
		const char *p = start;

		while (p < end) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we
			 * must treat it as a number.
................................................................................
     * have no direct relevance here.
     */

    if (!TclIsBareword(*start) || *start == '_') {
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	} else {
	    char utfBytes[4];

	    memcpy(utfBytes, start, numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }

Changes to generic/tclCompile.c.

655
656
657
658
659
660
661








662
663
664
665
666
667
668
....
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
....
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
....
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
....
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
....
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
	 * Stack:  ... varName list => ... listVarContents */

    {"clockRead",	 2,	+1,	1,	{OPERAND_UINT1}},
        /* Read clock out to the stack. Operand is which clock to read
	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
	 * Stack: ... => ... time */









    {NULL, 0, 0, 0, {OPERAND_NONE}}
};
 
/*
 * Prototypes for procedures defined later in this file:
 */

................................................................................
	    if (tempPtr != NULL) {
		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[TCL_UTF_MAX];
		int length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

................................................................................
				 * compile. */
    int count,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
    char buffer[TCL_UTF_MAX];
    int i, numObjsToConcat, length, adjust;
    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

................................................................................
    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;

    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
    } else {
	codePtr->exceptArrayPtr = NULL;
    }

    p += TCL_ALIGN(exceptArrayBytes);	/* align AuxData array */
    if (auxDataArrayBytes > 0) {
	codePtr->auxDataArrayPtr = (AuxData *) p;
	memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
    } else {
	codePtr->auxDataArrayPtr = NULL;
    }

    p += auxDataArrayBytes;
#ifndef TCL_COMPILE_DEBUG
    EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
................................................................................

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
			(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

................................................................................
	if (name == NULL) {
	    localPtr->flags |= VAR_TEMPORARY;
	}
	localPtr->defValuePtr = NULL;
	localPtr->resolveInfo = NULL;

	if (name != NULL) {
	    memcpy(localPtr->name, name, (size_t) nameBytes);
	}
	localPtr->name[nameBytes] = '\0';
	procPtr->numCompiledLocals++;
    }
    return localVar;
}
 







>
>
>
>
>
>
>
>







 







|







 







|







 







|










|







|







 







|







 







|







655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
....
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
....
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
....
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
....
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
....
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
	 * Stack:  ... varName list => ... listVarContents */

    {"clockRead",	 2,	+1,	1,	{OPERAND_UINT1}},
        /* Read clock out to the stack. Operand is which clock to read
	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
	 * Stack: ... => ... time */

    {"dictGetDef",	  5,	INT_MIN,   1,	{OPERAND_UINT4}},
	/* The top word is the default, the next op4 words (min 1) are a key
	 * path into the dictionary just below the keys on the stack, and all
	 * those values are replaced by the value read out of that key-path
	 * (like [dict get]) except if there is no such key, when instead the
	 * default is pushed instead.
	 * Stack:  ... dict key1 ... keyN default => ... value */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};
 
/*
 * Prototypes for procedures defined later in this file:
 */

................................................................................
	    if (tempPtr != NULL) {
		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[4] = "";
		int length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

................................................................................
				 * compile. */
    int count,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
    char buffer[4] = "";
    int i, numObjsToConcat, length, adjust;
    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

................................................................................
    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;

    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes);
    } else {
	codePtr->exceptArrayPtr = NULL;
    }

    p += TCL_ALIGN(exceptArrayBytes);	/* align AuxData array */
    if (auxDataArrayBytes > 0) {
	codePtr->auxDataArrayPtr = (AuxData *) p;
	memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes);
    } else {
	codePtr->auxDataArrayPtr = NULL;
    }

    p += auxDataArrayBytes;
#ifndef TCL_COMPILE_DEBUG
    EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
................................................................................

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
			(strncmp(name, localName, nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

................................................................................
	if (name == NULL) {
	    localPtr->flags |= VAR_TEMPORARY;
	}
	localPtr->defValuePtr = NULL;
	localPtr->resolveInfo = NULL;

	if (name != NULL) {
	    memcpy(localPtr->name, name, nameBytes);
	}
	localPtr->name[nameBytes] = '\0';
	procPtr->numCompiledLocals++;
    }
    return localVar;
}
 

Changes to generic/tclCompile.h.

836
837
838
839
840
841
842


843
844
845
846
847
848
849
850
851
#define INST_LAPPEND_LIST		185
#define INST_LAPPEND_LIST_ARRAY		186
#define INST_LAPPEND_LIST_ARRAY_STK	187
#define INST_LAPPEND_LIST_STK		188

#define INST_CLOCK_READ			189



/* The last opcode */
#define LAST_INST_OPCODE		189
 
/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"







>
>

|







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
#define INST_LAPPEND_LIST		185
#define INST_LAPPEND_LIST_ARRAY		186
#define INST_LAPPEND_LIST_ARRAY_STK	187
#define INST_LAPPEND_LIST_STK		188

#define INST_CLOCK_READ			189

#define INST_DICT_GET_DEF		190

/* The last opcode */
#define LAST_INST_OPCODE		190
 
/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"

Changes to generic/tclDecls.h.

593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
...
750
751
752
753
754
755
756

757
758
759
760
761
762
763
764
....
1892
1893
1894
1895
1896
1897
1898




1899
1900
1901
1902
1903
1904
1905
....
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
....
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
....
2571
2572
2573
2574
2575
2576
2577

2578
2579
2580
2581
2582
2583
2584
....
3889
3890
3891
3892
3893
3894
3895


3896
3897
3898
3899
3900
3901
3902
....
3974
3975
3976
3977
3978
3979
3980


3981
3982
3983
3984
3985
3986
3987
....
4069
4070
4071
4072
4073
4074
4075


4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
/* 185 */
EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				char *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
................................................................................
				const char ***argvPtr);
/* 244 */
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 245 */

EXTERN int		Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
int			Tcl_TellOld(Tcl_Channel chan);
/* 247 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
				int flags, Tcl_VarTraceProc *proc,
................................................................................
EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);





typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
................................................................................
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
................................................................................
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */

} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_HasStringRep) /* 640 */
#define Tcl_IncrRefCount \
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */



#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
................................................................................
#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#ifdef TCL_NO_DEPRECATED


#undef Tcl_Eval
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
................................................................................
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#undef Tcl_GetUnicode
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
#undef Tcl_BackgroundError
#define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)



/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#endif /* _TCLDECLS */







|







 







>
|







 







>
>
>
>







 







|







 







|







 







>







 







>
>







 







>
>







 







>
>













593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
...
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
....
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
....
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
....
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
....
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
....
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
....
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
....
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
/* 185 */
EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				void *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
................................................................................
				const char ***argvPtr);
/* 244 */
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
/* 245 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
TCL_DEPRECATED("")
int			Tcl_TellOld(Tcl_Channel chan);
/* 247 */
TCL_DEPRECATED("No longer in use, changed to macro")
int			Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
				int flags, Tcl_VarTraceProc *proc,
................................................................................
EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				int size);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
................................................................................
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
    TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
................................................................................
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclStubsPtr->tcl_HasStringRep) /* 640 */
#define Tcl_IncrRefCount \
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
	(tclStubsPtr->tcl_LinkArray) /* 644 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
................................................................................
#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#ifdef TCL_NO_DEPRECATED
#undef Tcl_GetStringResult
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#undef Tcl_Eval
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult
................................................................................
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#undef Tcl_SetLongObj
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#undef Tcl_GetUnicode
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
#undef Tcl_BackgroundError
#define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)
#undef Tcl_StringMatch
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)

/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

#endif /* _TCLDECLS */

Changes to generic/tclDictObj.c.

30
31
32
33
34
35
36


37
38
39
40
41
42
43
..
85
86
87
88
89
90
91



92
93
94
95
96
97
98
...
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
....
1623
1624
1625
1626
1627
1628
1629

































































1630
1631
1632
1633
1634
1635
1636
....
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
			    int objc, Tcl_Obj *const *objv);
static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);


static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
................................................................................
static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },



    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
    {"info",	DictInfoCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    {"keys",	DictKeysCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
    {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
    {"merge",	DictMergeCmd,	TclCompileDictMergeCmd, NULL, NULL, 0 },
    {"remove",	DictRemoveCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
................................................................................

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (objPtr->typePtr == &tclListType) {
	int objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElements(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
................................................................................
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

































































 * DictReplaceCmd --
 *
 *	This function implements the "dict replace" Tcl command. See the user
 *	documentation for details on what it does, and TIP#111 for the formal
 *	specification.
 *
 * Results:
................................................................................
    Tcl_Obj *dictPtr, *valuePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
	    DICT_PATH_EXISTS);
    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
	    || Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
		    &valuePtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
    }
    return TCL_OK;
}
 







>
>







 







>
>
>







 







|







 







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







 







|
<
|
<
|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
..
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
...
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
....
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
....
2082
2083
2084
2085
2086
2087
2088
2089

2090

2091
2092
2093
2094
2095
2096
2097
2098
			    int objc, Tcl_Obj *const *objv);
static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetDefCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
................................................................................
static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
    {"getdef",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd, NULL,NULL,0},
    {"getwithdefault",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd,
	NULL, NULL, 0 },
    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
    {"info",	DictInfoCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    {"keys",	DictKeysCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
    {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
    {"merge",	DictMergeCmd,	TclCompileDictMergeCmd, NULL, NULL, 0 },
    {"remove",	DictRemoveCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
................................................................................

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasIntRep(objPtr, &tclListType)) {
	int objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElements(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
................................................................................
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DictGetDefCmd --
 *
 *	This function implements the "dict getdef" and "dict getwithdefault"
 *	Tcl commands. See the user documentation for details on what it does,
 *	and TIP#342 for the formal specification.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetDefCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
    Tcl_Obj *const *keyPath;
    int numKeys;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...? key default");
	return TCL_ERROR;
    }

    /*
     * Give the bits of arguments names for clarity.
     */

    dictPtr = objv[1];
    keyPath = &objv[2];
    numKeys = objc - 4;		/* Number of keys in keyPath; there's always
				 * one extra key afterwards too. */
    keyPtr = objv[objc - 2];
    defaultPtr = objv[objc - 1];

    /*
     * Implement the getting-with-default operation.
     */

    dictPtr = TclTraceDictPath(interp, dictPtr, numKeys, keyPath,
	    DICT_PATH_EXISTS);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr) != TCL_OK) {
	return TCL_ERROR;
    } else if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else {
	Tcl_SetObjResult(interp, valuePtr);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DictReplaceCmd --
 *
 *	This function implements the "dict replace" Tcl command. See the user
 *	documentation for details on what it does, and TIP#111 for the formal
 *	specification.
 *
 * Results:
................................................................................
    Tcl_Obj *dictPtr, *valuePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS);

    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT ||

	    Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
    }
    return TCL_OK;
}
 

Changes to generic/tclDisassemble.c.

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
....
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
....
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
....
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
	 */

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

	if ((objv[2]->typePtr != &tclByteCodeType) && (TCL_OK
		!= TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
	    return TCL_ERROR;
	}
	codeObjPtr = objv[2];
	break;

    case DISAS_CLASS_CONSTRUCTOR:
................................................................................
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

................................................................................
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

................................................................................
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */








|







 







|







 







|







 







|







1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
....
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
....
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
....
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
	 */

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

	if (!TclHasIntRep(objv[2], &tclByteCodeType) && (TCL_OK
		!= TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
	    return TCL_ERROR;
	}
	codeObjPtr = objv[2];
	break;

    case DISAS_CLASS_CONSTRUCTOR:
................................................................................
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

................................................................................
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

................................................................................
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

Changes to generic/tclEncoding.c.

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
....
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
....
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
....
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
....
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
....
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
....
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
....
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
....
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
....
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
....
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
....
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		TableToUtfProc(ClientData clientData, const char *src,
			    int srcLen, int flags, Tcl_EncodingState *statePtr,
			    char *dst, int dstLen, int *srcReadPtr,
			    int *dstWrotePtr, int *dstCharsPtr);
static size_t		unilen(const char *src);
static int		UnicodeToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUnicodeProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
................................................................................
    type.fromUtfProc	= UtfIntToUtfExtProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    type.encodingName   = "unicode";
    type.toUtfProc	= UnicodeToUtfProc;
    type.fromUtfProc    = UtfToUnicodeProc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    /*
     * Need the iso8859-1 encoding in order to process binary data, so force
................................................................................
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
................................................................................
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    *srcReadPtr = srcLen;
    *dstWrotePtr = srcLen;
    *dstCharsPtr = srcLen;
    memcpy(dst, src, (size_t) srcLen);
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UtfExtToUtfIntProc --
................................................................................
	    src += 1;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	} else {
	    int len = TclUtfToUniChar(src, chPtr);
	    src += len;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
#if TCL_UTF_MAX <= 4
	    if (!len) {
		src += TclUtfToUniChar(src, chPtr);
		dst += Tcl_UniCharToUtf(*chPtr, dst);
	    }
#endif
	}
    }

    *srcReadPtr = src - srcStart;
................................................................................
    *dstCharsPtr = numChars;
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UnicodeToUtfProc --
 *
 *	Convert from Unicode to UTF-8.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UnicodeToUtfProc(
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in Unicode. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
................................................................................
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;

    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    if ((srcLen % sizeof(Tcl_UniChar)) != 0) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen /= sizeof(Tcl_UniChar);
	srcLen *= sizeof(Tcl_UniChar);
    }

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;
................................................................................
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * Tcl_UniChar-size data.
	 */

	*chPtr = *(Tcl_UniChar *)src;
	if (*chPtr && *chPtr < 0x80) {
	    *dst++ = (*chPtr & 0xFF);
	} else {
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	}
	src += sizeof(Tcl_UniChar);
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UtfToUnicodeProc --
 *
 *	Convert from UTF-8 to Unicode.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUnicodeProc(
    ClientData clientData,	/* TableEncodingData that specifies
				 * encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
................................................................................
	/*
	 * Need to handle this in a way that won't cause misalignment by
	 * casting dst to a Tcl_UniChar. [Bug 1122671]
	 */

#ifdef WORDS_BIGENDIAN
#if TCL_UTF_MAX > 4

	*dst++ = (*chPtr >> 24);


	*dst++ = ((*chPtr >> 16) & 0xFF);
	*dst++ = ((*chPtr >> 8) & 0xFF);
	*dst++ = (*chPtr & 0xFF);



#else
	*dst++ = (*chPtr >> 8);
	*dst++ = (*chPtr & 0xFF);
#endif
#else
#if TCL_UTF_MAX > 4

	*dst++ = (*chPtr & 0xFF);
	*dst++ = ((*chPtr >> 8) & 0xFF);
	*dst++ = ((*chPtr >> 16) & 0xFF);



	*dst++ = (*chPtr >> 24);


#else
	*dst++ = (*chPtr & 0xFF);
	*dst++ = (*chPtr >> 8);
#endif
#endif
    }
    *srcReadPtr = src - srcStart;
................................................................................

	/*
	 * Check for illegal characters.
	 */

	if (ch > 0xff
#if TCL_UTF_MAX <= 4
		|| !len
#endif
		) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
#if TCL_UTF_MAX <= 4
	    if (!len) len = 4;
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?';
	}
................................................................................
    if (flags & TCL_ENCODING_START) {
	state = 0;
	if ((dst + dataPtr->initLen) > dstEnd) {
	    *srcReadPtr = 0;
	    *dstWrotePtr = 0;
	    return TCL_CONVERT_NOSPACE;
	}
	memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen);
	dst += dataPtr->initLen;
    } else {
	state = PTR2INT(*statePtr);
    }

    encodingPtr = GetTableEncoding(dataPtr, state);
    tableDataPtr = encodingPtr->clientData;
................................................................................
		     */

		    state = oldState;
		    result = TCL_CONVERT_NOSPACE;
		    break;
		}
		memcpy(dst, subTablePtr->sequence,
			(size_t) subTablePtr->sequenceLen);
		dst += subTablePtr->sequenceLen;
	    }
	}

	if (tablePrefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
................................................................................
	if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {
	    if (state) {
		memcpy(dst, dataPtr->subTables[0].sequence, len);
		dst += len;
	    }
	    memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
	    dst += dataPtr->finalLen;
	    state &= ~TCL_ENCODING_END;
	}
    }

    *statePtr = (Tcl_EncodingState) INT2PTR(state);
    *srcReadPtr = src - srcStart;







|




|







 







|
|







 







|

|







 







|







 







|
|







 







|













|







 







|

<
<
<




|

|
|







 







|


|
|
|

|

|











|













|







 







>
|
>
>
|
<
|
>
>
>






>
|
|
<
>
>
>
|
>
>







 







|







|







 







|







 







|







 







|







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
....
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
....
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
....
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
....
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
....
2440
2441
2442
2443
2444
2445
2446
2447
2448



2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
....
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
....
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580

2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593

2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
....
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
....
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
....
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
....
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		TableToUtfProc(ClientData clientData, const char *src,
			    int srcLen, int flags, Tcl_EncodingState *statePtr,
			    char *dst, int dstLen, int *srcReadPtr,
			    int *dstWrotePtr, int *dstCharsPtr);
static size_t		unilen(const char *src);
static int		UniCharToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUniCharProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
................................................................................
    type.fromUtfProc	= UtfIntToUtfExtProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    type.encodingName   = "unicode";
    type.toUtfProc	= UniCharToUtfProc;
    type.fromUtfProc    = UtfToUniCharProc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    /*
     * Need the iso8859-1 encoding in order to process binary data, so force
................................................................................
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
................................................................................
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    *srcReadPtr = srcLen;
    *dstWrotePtr = srcLen;
    *dstCharsPtr = srcLen;
    memcpy(dst, src, srcLen);
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UtfExtToUtfIntProc --
................................................................................
	    src += 1;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	} else {
	    int len = TclUtfToUniChar(src, chPtr);
	    src += len;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
#if TCL_UTF_MAX <= 4
	    if ((*chPtr >= 0xD800) && (len < 3)) {
		src += TclUtfToUniChar(src + len, chPtr);
		dst += Tcl_UniCharToUtf(*chPtr, dst);
	    }
#endif
	}
    }

    *srcReadPtr = src - srcStart;
................................................................................
    *dstCharsPtr = numChars;
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UniCharToUtfProc --
 *
 *	Convert from Unicode to UTF-8.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UniCharToUtfProc(
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in Unicode. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
................................................................................
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    unsigned short ch;




    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    if ((srcLen % sizeof(unsigned short)) != 0) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen /= sizeof(unsigned short);
	srcLen *= sizeof(unsigned short);
    }

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;
................................................................................
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

	ch = *(unsigned short *)src;
	if (ch && ch < 0x80) {
	    *dst++ = (ch & 0xFF);
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += sizeof(unsigned short);
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}
 
/*
 *-------------------------------------------------------------------------
 *
 * UtfToUniCharProc --
 *
 *	Convert from UTF-8 to Unicode.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUniCharProc(
    ClientData clientData,	/* TableEncodingData that specifies
				 * encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
................................................................................
	/*
	 * Need to handle this in a way that won't cause misalignment by
	 * casting dst to a Tcl_UniChar. [Bug 1122671]
	 */

#ifdef WORDS_BIGENDIAN
#if TCL_UTF_MAX > 4
	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
#else
#if TCL_UTF_MAX > 4
	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
#endif
    }
    *srcReadPtr = src - srcStart;
................................................................................

	/*
	 * Check for illegal characters.
	 */

	if (ch > 0xff
#if TCL_UTF_MAX <= 4
		|| ((ch >= 0xD800) && (len < 3))
#endif
		) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
#if TCL_UTF_MAX <= 4
	    if ((ch >= 0xD800) && (len < 3)) len = 4;
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?';
	}
................................................................................
    if (flags & TCL_ENCODING_START) {
	state = 0;
	if ((dst + dataPtr->initLen) > dstEnd) {
	    *srcReadPtr = 0;
	    *dstWrotePtr = 0;
	    return TCL_CONVERT_NOSPACE;
	}
	memcpy(dst, dataPtr->init, dataPtr->initLen);
	dst += dataPtr->initLen;
    } else {
	state = PTR2INT(*statePtr);
    }

    encodingPtr = GetTableEncoding(dataPtr, state);
    tableDataPtr = encodingPtr->clientData;
................................................................................
		     */

		    state = oldState;
		    result = TCL_CONVERT_NOSPACE;
		    break;
		}
		memcpy(dst, subTablePtr->sequence,
			subTablePtr->sequenceLen);
		dst += subTablePtr->sequenceLen;
	    }
	}

	if (tablePrefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
................................................................................
	if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {
	    if (state) {
		memcpy(dst, dataPtr->subTables[0].sequence, len);
		dst += len;
	    }
	    memcpy(dst, dataPtr->final, dataPtr->finalLen);
	    dst += dataPtr->finalLen;
	    state &= ~TCL_ENCODING_END;
	}
    }

    *statePtr = (Tcl_EncodingState) INT2PTR(state);
    *srcReadPtr = src - srcStart;

Changes to generic/tclEnsemble.c.

1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
....
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
................................................................................
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}
 
/*
 *----------------------------------------------------------------------
 *







|







 







|







1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
....
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
................................................................................
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclEnv.c.

115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
...
131
132
133
134
135
136
137












138
139
140
141
142
143
144
...
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
...
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

    if (environ[0] != NULL) {
	int i;

	Tcl_MutexLock(&envMutex);
	for (i = 0; environ[i] != NULL; i++) {
	    Tcl_Obj *obj1, *obj2;

	    char *p1, *p2;

	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
	    p2 = strchr(p1, '=');
	    if (p2 == NULL) {
		/*
		 * This condition seem to happen occasionally under some
		 * versions of Solaris, or when encoding accidents swallow the
................................................................................
		 */

		Tcl_DStringFree(&envString);
		continue;
	    }
	    p2++;
	    p2[-1] = '\0';












	    obj1 = Tcl_NewStringObj(p1, -1);
	    obj2 = Tcl_NewStringObj(p2, -1);
	    Tcl_DStringFree(&envString);

	    Tcl_IncrRefCount(obj1);
	    Tcl_IncrRefCount(obj2);
	    Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
................................................................................
	    Tcl_DStringFree(&envString);
	    Tcl_MutexUnlock(&envMutex);
	    return;
	}
	Tcl_DStringFree(&envString);

	oldValue = environ[index];
	nameLength = (unsigned) length;
    }

    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */
................................................................................
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

................................................................................
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = ckalloc(length + 2);
    memcpy(string, name, (size_t) length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = ckalloc(length + 1);
    memcpy(string, name, (size_t) length);
    string[length] = '\0';
#endif /* _WIN32 */

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
    memcpy(string, Tcl_DStringValue(&envString),
	    (unsigned) Tcl_DStringLength(&envString)+1);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the







>
|







 







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







 







|







 







|







 







|




|






|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
...
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
...
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477

    if (environ[0] != NULL) {
	int i;

	Tcl_MutexLock(&envMutex);
	for (i = 0; environ[i] != NULL; i++) {
	    Tcl_Obj *obj1, *obj2;
	    const char *p1;
	    char *p2;

	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
	    p2 = strchr(p1, '=');
	    if (p2 == NULL) {
		/*
		 * This condition seem to happen occasionally under some
		 * versions of Solaris, or when encoding accidents swallow the
................................................................................
		 */

		Tcl_DStringFree(&envString);
		continue;
	    }
	    p2++;
	    p2[-1] = '\0';
#if defined(_WIN32)
	    /*
	     * Enforce PATH and COMSPEC to be all uppercase. This eliminates
	     * additional trace logic otherwise required in init.tcl.
	     */

	    if (strcasecmp(p1, "PATH") == 0) {
		p1 = "PATH";
	    } else if (strcasecmp(p1, "COMSPEC") == 0) {
		p1 = "COMSPEC";
	    }
#endif
	    obj1 = Tcl_NewStringObj(p1, -1);
	    obj2 = Tcl_NewStringObj(p2, -1);
	    Tcl_DStringFree(&envString);

	    Tcl_IncrRefCount(obj1);
	    Tcl_IncrRefCount(obj2);
	    Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
................................................................................
	    Tcl_DStringFree(&envString);
	    Tcl_MutexUnlock(&envMutex);
	    return;
	}
	Tcl_DStringFree(&envString);

	oldValue = environ[index];
	nameLength = length;
    }

    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */
................................................................................
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

................................................................................
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = ckalloc(length + 2);
    memcpy(string, name, length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = ckalloc(length + 1);
    memcpy(string, name, length);
    string[length] = '\0';
#endif /* _WIN32 */

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
    memcpy(string, Tcl_DStringValue(&envString),
	    Tcl_DStringLength(&envString)+1);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the

Changes to generic/tclExecute.c.

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
....
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
....
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
....
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
....
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
....
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
....
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
....
6829
6830
6831
6832
6833
6834
6835






























































6836
6837
6838
6839
6840
6841
6842
....
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
....
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
....
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
....
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
....
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
....
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
....
8142
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
....
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
....
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
8358
....
8395
8396
8397
8398
8399
8400
8401

8402
8403
8404

8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
....
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
....
8720
8721
8722
8723
8724
8725
8726
8727
8728
8729
8730
8731
8732
8733
8734
....
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
....
9618
9619
9620
9621
9622
9623
9624
9625
9626
9627
9628
9629
9630
9631
9632
 * TclGetNumberFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    ((objPtr)->typePtr == &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
................................................................................
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& (value2Ptr->typePtr != &tclListType)
		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}
................................................................................
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4];
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {
		objResultPtr = Tcl_NewObj();
	    } else {
		length = Tcl_UniCharToUtf(ch, buf);
		if (!length) {
		    length = Tcl_UniCharToUtf(-1, buf);
		}
		objResultPtr = Tcl_NewStringObj(buf, length);
	    }
	}

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);
................................................................................
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */

	/*
	 * Check that at least one of the objects is Unicode before promoting
	 * both.
	 */

	if ((valuePtr->typePtr == &tclStringType)
		|| (value2Ptr->typePtr == &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
................................................................................
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

................................................................................
    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (valuePtr->typePtr == &tclBooleanType) {
	    objResultPtr = TCONST(1);
	} else {
	    int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(result);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);
................................................................................
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);

    case INST_DICT_GET:
    case INST_DICT_EXISTS: {
	register Tcl_Interp *interp2 = interp;
	register int found;

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);
	if (*pc == INST_DICT_EXISTS) {
	    interp2 = NULL;
	}
	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(interp2, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		if (*pc == INST_DICT_EXISTS) {
		    found = 0;
		    goto afterDictExists;
		}
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    }
	}
	if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {
	    if (*pc == INST_DICT_EXISTS) {
		found = (objResultPtr ? 1 : 0);
		goto afterDictExists;
	    }
	    if (!objResultPtr) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"key \"%s\" not known in dictionary",
			TclGetString(OBJ_AT_TOS)));
		DECACHE_STACK_INFO();
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			TclGetString(OBJ_AT_TOS), NULL);
		CACHE_STACK_INFO();
		TRACE_ERROR(interp);
		goto gotError;
	    }
	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	    NEXT_INST_V(5, opnd+1, 1);
	} else if (*pc != INST_DICT_EXISTS) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else {
	    found = 0;
	}
    afterDictExists:
	TRACE_APPEND(("%d\n", found));

	/*
................................................................................
	 * conditional jump, so we can take advantage of this to do some
	 * peephole optimization (note that we're careful to not close out
	 * someone doing something else).
	 */

	JUMP_PEEPHOLE_V(found, 5, opnd+1);
    }































































    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);

................................................................................
	    TclNewObj(statePtr);
	    ir.twoPtrValue.ptr1 = searchPtr;
	    ir.twoPtrValue.ptr2 = dictPtr;
	    Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
	}
	varPtr = LOCAL(opnd);
	if (varPtr->value.objPtr) {
	    if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
		Tcl_Panic("mis-issued dictFirst!");
	    }
	    TclDecrRefCount(varPtr->value.objPtr);
	}
	varPtr->value.objPtr = statePtr;
	Tcl_IncrRefCount(statePtr);
	goto pushDictIteratorResult;
................................................................................
		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wQuotient < (Tcl_WideInt) 0)
			|| ((wQuotient == (Tcl_WideInt) 0)
			&& ((w1 < (Tcl_WideInt)0 && w2 > (Tcl_WideInt)0)
			|| (w1 > (Tcl_WideInt)0 && w2 < (Tcl_WideInt)0))))
			&& (wQuotient * w2 != w1)) {
		    wQuotient -= (Tcl_WideInt) 1;
		}
		wRemainder = w1 - w2*wQuotient;
		WIDE_RESULT(wRemainder);
	    }

................................................................................
	    return NULL;
	}
	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	mp_init(&bigRemainder);
	mp_div(&big1, &big2, &bigResult, &bigRemainder);
	if (!mp_iszero(&bigRemainder) && (bigRemainder.sign != big2.sign)) {
	    /*
	     * Convert to Tcl's integer division rules.
	     */

	    mp_sub_d(&bigResult, 1, &bigResult);
	    mp_add(&bigRemainder, &big2, &bigRemainder);
	}
................................................................................
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_INT:
	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = mp_isneg(&big2);
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
................................................................................
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
................................................................................
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_INT:
		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (!mp_isneg(&big1));
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
................................................................................
	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_INT) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= (Tcl_WideInt)0) {
			return constants[0];
		    }
		    WIDE_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
	}
................................................................................
		return NULL;
	    }

	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	} else {
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = mp_isneg(&big2);
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = !mp_iszero(&big2);
	    mp_clear(&big2);
	}

	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (negativeExponent) {
................................................................................
	if (w1 == -2) {
	    int signum = oddExponent ? -1 : 1;

	    /*
	     * Reduce small powers of 2 to shifts.
	     */

	    if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
		WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
	    }
	    goto overflowExpon;
	}
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {
................................................................................

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	if (big2.used > 1) {
	    mp_clear(&big2);

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:
................................................................................
	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (mp_iszero(&big2)) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if (!mp_iszero(&bigRemainder)
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);
................................................................................
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (mp_isneg(&big2)) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
................................................................................
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
		if (mp_isneg(&big2)) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
	    }
................................................................................
    objBytesIfUnshared = 0.0;
    strBytesIfUnshared = 0.0;
    strBytesSharedMultX = 0.0;
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (entryPtr->objPtr->typePtr == &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) {







|



|







 







|







 







|











|
|







 







|
|







 







|







 







|







 







<

<





<
<
<

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

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







 







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







 







|







 







|
|







 







|







 







|



|







 







|







 







|



|







 







|







 







|

|







 







|







 







>
|
<
|
>






|

<







 







|








|







 







|







 







|







 







|







495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
....
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
....
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
....
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
....
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
....
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
....
6765
6766
6767
6768
6769
6770
6771

6772

6773
6774
6775
6776
6777



6778
6779
6780
6781

6782
6783
6784





6785

6786
6787

6788



















6789
6790
6791
6792
6793
6794
6795
....
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
....
7134
7135
7136
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
....
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
....
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
....
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
....
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
....
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
....
8172
8173
8174
8175
8176
8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
....
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
....
8374
8375
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
....
8425
8426
8427
8428
8429
8430
8431
8432
8433

8434
8435
8436
8437
8438
8439
8440
8441
8442
8443

8444
8445
8446
8447
8448
8449
8450
....
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616
8617
....
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
....
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
....
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662
 * TclGetNumberFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			ClientData *ptrPtr, int *tPtr);
 */

#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
    ((TclHasIntRep((objPtr), &tclIntType))					\
	?	(*(tPtr) = TCL_NUMBER_INT,				\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
    TclHasIntRep((objPtr), &tclDoubleType)				\
	?	(((TclIsNaN((objPtr)->internalRep.doubleValue))		\
		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
		*(ptrPtr) = (ClientData)				\
		    (&((objPtr)->internalRep.doubleValue)), TCL_OK) :	\
    (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))		\
	? TCL_ERROR :			\
................................................................................
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));

	/*
	 * Extract the desired list element.
	 */

	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
		&& !TclHasIntRep(value2Ptr, &tclListType)
		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
			&index) == TCL_OK)) {
	    TclDecrRefCount(value2Ptr);
	    tosPtr--;
	    pcAdjustment = 1;
	    goto lindexFastPath;
	}
................................................................................
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = Tcl_GetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {
		objResultPtr = Tcl_NewObj();
	    } else {
		length = Tcl_UniCharToUtf(ch, buf);
		if ((ch >= 0xD800) && (length < 3)) {
		    length += Tcl_UniCharToUtf(-1, buf + length);
		}
		objResultPtr = Tcl_NewStringObj(buf, length);
	    }
	}

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);
................................................................................
	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */

	/*
	 * Check that at least one of the objects is Unicode before promoting
	 * both.
	 */

	if (TclHasIntRep(valuePtr, &tclStringType)
		|| TclHasIntRep(value2Ptr, &tclStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
................................................................................
	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

................................................................................
    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_TRY_CVT_TO_BOOLEAN:
	valuePtr = OBJ_AT_TOS;
	if (TclHasIntRep(valuePtr,  &tclBooleanType)) {
	    objResultPtr = TCONST(1);
	} else {
	    int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
	    objResultPtr = TCONST(result);
	}
	TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr);
	NEXT_INST_F(1, 0, 1);
................................................................................
	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);


    case INST_DICT_EXISTS: {

	register int found;

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);



	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(NULL, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_EXISTS);
	    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT) {

		found = 0;
		goto afterDictExists;
	    }





	}

	if (Tcl_DictObjGet(NULL, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {

	    found = (objResultPtr ? 1 : 0);



















	} else {
	    found = 0;
	}
    afterDictExists:
	TRACE_APPEND(("%d\n", found));

	/*
................................................................................
	 * conditional jump, so we can take advantage of this to do some
	 * peephole optimization (note that we're careful to not close out
	 * someone doing something else).
	 */

	JUMP_PEEPHOLE_V(found, 5, opnd+1);
    }
    case INST_DICT_GET:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);
	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    }
	}
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	if (!objResultPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS)));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), NULL);
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(5, opnd+1, 1);
    case INST_DICT_GET_DEF:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd+1);
	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd), DICT_PATH_EXISTS);
	    if (dictPtr == NULL) {
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd+1))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
		goto dictGetDefUseDefault;
	    }
	}
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else if (!objResultPtr) {
	dictGetDefUseDefault:
	    objResultPtr = OBJ_AT_TOS;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(5, opnd+2, 1);

    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);

................................................................................
	    TclNewObj(statePtr);
	    ir.twoPtrValue.ptr1 = searchPtr;
	    ir.twoPtrValue.ptr2 = dictPtr;
	    Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
	}
	varPtr = LOCAL(opnd);
	if (varPtr->value.objPtr) {
	    if (TclHasIntRep(varPtr->value.objPtr, &dictIteratorType)) {
		Tcl_Panic("mis-issued dictFirst!");
	    }
	    TclDecrRefCount(varPtr->value.objPtr);
	}
	varPtr->value.objPtr = statePtr;
	Tcl_IncrRefCount(statePtr);
	goto pushDictIteratorResult;
................................................................................
		/*
		 * Force Tcl's integer division rules.
		 * TODO: examine for logic simplification
		 */

		if (((wQuotient < (Tcl_WideInt) 0)
			|| ((wQuotient == (Tcl_WideInt) 0)
			&& ((w1 < 0 && w2 > 0)
			|| (w1 > 0 && w2 < 0))))
			&& (wQuotient * w2 != w1)) {
		    wQuotient -= (Tcl_WideInt) 1;
		}
		wRemainder = w1 - w2*wQuotient;
		WIDE_RESULT(wRemainder);
	    }

................................................................................
	    return NULL;
	}
	Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
	Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
	mp_init(&bigResult);
	mp_init(&bigRemainder);
	mp_div(&big1, &big2, &bigResult, &bigRemainder);
	if ((bigRemainder.used != 0) && (bigRemainder.sign != big2.sign)) {
	    /*
	     * Convert to Tcl's integer division rules.
	     */

	    mp_sub_d(&bigResult, 1, &bigResult);
	    mp_add(&bigRemainder, &big2, &bigRemainder);
	}
................................................................................
    case INST_RSHIFT: {
	/*
	 * Reject negative shift argument.
	 */

	switch (type2) {
	case TCL_NUMBER_INT:
	    invalid = (*((const Tcl_WideInt *)ptr2) < 0);
	    break;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    invalid = big2.sign != MP_ZPOS;
	    mp_clear(&big2);
	    break;
	default:
	    /* Unused, here to silence compiler warning */
	    invalid = 0;
	}
	if (invalid) {
................................................................................
	    return GENERAL_ARITHMETIC_ERROR;
	}

	/*
	 * Zero shifted any number of bits is still zero.
	 */

	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == 0)) {
	    return constants[0];
	}

	if (opcode == INST_LSHIFT) {
	    /*
	     * Large left shifts create integer overflow.
	     *
................................................................................
		 * not take us to the result of 0 or -1, but since we're using
		 * mp_div_2d to do the work, and it takes only an int
		 * argument, we draw the line there.
		 */

		switch (type1) {
		case TCL_NUMBER_INT:
		    zero = (*(const Tcl_WideInt *)ptr1 > 0);
		    break;
		case TCL_NUMBER_BIG:
		    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
		    zero = (big1.sign == MP_ZPOS);
		    mp_clear(&big1);
		    break;
		default:
		    /* Unused, here to silence compiler warning. */
		    zero = 0;
		}
		if (zero) {
................................................................................
	    /*
	     * Handle shifts within the native wide range.
	     */

	    if (type1 == TCL_NUMBER_INT) {
		w1 = *(const Tcl_WideInt *)ptr1;
		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
		    if (w1 >= 0) {
			return constants[0];
		    }
		    WIDE_RESULT(-1);
		}
		WIDE_RESULT(w1 >> shift);
	    }
	}
................................................................................
		return NULL;
	    }

	    negativeExponent = (w2 < 0);
	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
	} else {
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    negativeExponent = big2.sign != MP_ZPOS;
	    mp_mod_2d(&big2, 1, &big2);
	    oddExponent = big2.used != 0;
	    mp_clear(&big2);
	}

	if (type1 == TCL_NUMBER_INT) {
	    w1 = *((const Tcl_WideInt *)ptr1);

	    if (negativeExponent) {
................................................................................
	if (w1 == -2) {
	    int signum = oddExponent ? -1 : 1;

	    /*
	     * Reduce small powers of 2 to shifts.
	     */

	    if ((Tcl_WideUInt) w2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) {
		WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
	    }
	    goto overflowExpon;
	}
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {
................................................................................

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)

		|| (value2Ptr->typePtr != &tclIntType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, w2, &bigResult, 1);
	mp_clear(&big1);

	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:
................................................................................
	case INST_SUB:
	    mp_sub(&big1, &big2, &bigResult);
	    break;
	case INST_MULT:
	    mp_mul(&big1, &big2, &bigResult);
	    break;
	case INST_DIV:
	    if (big2.used == 0) {
		mp_clear(&big1);
		mp_clear(&big2);
		mp_clear(&bigResult);
		return DIVIDED_BY_ZERO;
	    }
	    mp_init(&bigRemainder);
	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
	    /* TODO: internals intrusion */
	    if ((bigRemainder.used != 0)
		    && (bigRemainder.sign != big2.sign)) {
		/*
		 * Convert to Tcl's integer division rules.
		 */

		mp_sub_d(&bigResult, 1, &bigResult);
		mp_add(&bigRemainder, &big2, &bigRemainder);
................................................................................
	    if (d2 > (double)WIDE_MAX) {
		return MP_LT;
	    }
	    w2 = (Tcl_WideInt) d2;
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if (big2.sign != MP_ZPOS) {
		compare = MP_GT;
	    } else {
		compare = MP_LT;
	    }
	    mp_clear(&big2);
	    return compare;
	}
................................................................................
	    goto wideCompare;
	case TCL_NUMBER_BIG:
	    if (TclIsInfinite(d1)) {
		return (d1 > 0.0) ? MP_GT : MP_LT;
	    }
	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
		if (big2.sign != MP_ZPOS) {
		    compare = MP_GT;
		} else {
		    compare = MP_LT;
		}
		mp_clear(&big2);
		return compare;
	    }
................................................................................
    objBytesIfUnshared = 0.0;
    strBytesIfUnshared = 0.0;
    strBytesSharedMultX = 0.0;
    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) {

Changes to generic/tclFileName.c.

594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
....
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
....
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
     * 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, (size_t) len+1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */

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

unsigned
Tcl_GetFSDeviceFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (unsigned) statPtr->st_dev;
}

unsigned
Tcl_GetFSInodeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (unsigned) statPtr->st_ino;
}

unsigned
Tcl_GetModeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (unsigned) statPtr->st_mode;
}

int
Tcl_GetLinkCountFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int)statPtr->st_nlink;
................................................................................
}

unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    return (unsigned) statPtr->st_blksize;
#else
    /*
     * Not a great guess, but will do...
     */

    return GUESSED_BLOCK_SIZE;
#endif







|







 







|






|






|







 







|







594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
....
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
....
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
     * 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.
     */

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

unsigned
Tcl_GetFSDeviceFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_dev;
}

unsigned
Tcl_GetFSInodeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_ino;
}

unsigned
Tcl_GetModeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_mode;
}

int
Tcl_GetLinkCountFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int)statPtr->st_nlink;
................................................................................
}

unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    return statPtr->st_blksize;
#else
    /*
     * Not a great guess, but will do...
     */

    return GUESSED_BLOCK_SIZE;
#endif

Changes to generic/tclHash.c.

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;







|
|







1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0);
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;

Changes to generic/tclIO.c.

3458
3459
3460
3461
3462
3463
3464





3465
3466
3467
3468
3469
3470
3471
....
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
....
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
....
4442
4443
4444
4445
4446
4447
4448


4449
4450
4451
4452
4453
4454
4455
....
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
5092
5093
5094
5095
5096
....
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
....
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
....
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
....
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
....
6330
6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
....
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
....
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
....
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
....
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
....
8499
8500
8501
8502
8503
8504
8505










8506
8507
8508
8509
8510
8511
8512
....
8526
8527
8528
8529
8530
8531
8532















8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
8551

8552
8553
8554
8555
8556
8557
8558
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    Tcl_ClearChannelHandlers(chan);






    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
................................................................................
	}
	if (saved) {
	    /*
	     * Here's some translated bytes left over from the last buffer
	     * that we need to stick at the beginning of this buffer.
	     */

	    memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
	    bufPtr->nextAdded += saved;
	    saved = 0;
	}
	PreserveChannelBuffer(bufPtr);
	dst = InsertPoint(bufPtr);
	dstLen = SpaceLeft(bufPtr);

................................................................................
	     * the translation to produce a character that crossed the end of
	     * the output buffer, so that we would get a completely full
	     * buffer before flushing it. The extra bytes will be moved to the
	     * beginning of the next buffer.
	     */

	    saved = -SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, (size_t) saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

................................................................................
    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
    }



    return total;
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
	/*
	 * Copy bytes from the channel buffer to the ByteArray. This may
	 * realloc space, so keep track of result.
	 */

	rawLen = dstEnd - dst;
	byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
	memcpy(byteArray + byteLen, dst, (size_t) rawLen);
	byteLen += rawLen;
    }

    /*
     * Found EOL or EOF, but the output buffer may now contain too many bytes.
     * We need to know how many bytes correspond to the number we want, so we
     * can remove the correct number of bytes from the channel buffer.
................................................................................
  gotEOL:
    if (bufPtr == NULL) {
	Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL");
    }

    rawLen = eol - dst;
    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
    memcpy(byteArray + byteLen, dst, (size_t) rawLen);
    byteLen += rawLen;
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */
................................................................................
	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
		: bytesToRead;

	/*
         * Copy the current chunk into the read buffer.
         */

	memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
	bufPtr->nextRemoved += toCopy;
	copied += toCopy;
	readBuf += toCopy;
	bytesToRead -= toCopy;

	/*
         * If the current buffer is empty recycle it.
................................................................................
		{
		    /*
		     * There are chars leading the buffer before the eof char.
		     * Adjust the dstLimit so we go back and read only those
		     * and do not encounter the eof char this time.
		     */

		    dstLimit = dstRead - 1 + TCL_UTF_MAX;
		    statePtr->flags = savedFlags;
		    statePtr->inputEncodingFlags = savedIEFlags;
		    statePtr->inputEncodingState = savedState;
		    continue;
		}
	    }

................................................................................
		/*
		 * There are chars we can read before we hit the bare CR.  Go
		 * back with a smaller dstLimit so we get them in the next
		 * pass, compute a matching srcRead, and don't end up back
		 * here in this call.
		 */

		dstLimit = dstRead - 1 + TCL_UTF_MAX;
		statePtr->flags = savedFlags;
		statePtr->inputEncodingFlags = savedIEFlags;
		statePtr->inputEncodingState = savedState;
		continue;
	    }

	    assert(dstWrote == 0);
................................................................................
	     * TODO: This cannot happen anymore.
	     *
	     * We read more chars than allowed.  Reset limits to prevent that
	     * and try again.  Don't forget the extra padding of TCL_UTF_MAX
	     * bytes demanded by the Tcl_ExternalToUtf() call!
	     */

	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
	    statePtr->flags = savedFlags;
	    statePtr->inputEncodingFlags = savedIEFlags;
	    statePtr->inputEncodingState = savedState;
	    continue;
	}

	if (dstWrote == 0) {
................................................................................
	     */

	    if (nextPtr->nextRemoved - srcLen < 0) {
		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
	    }

	    nextPtr->nextRemoved -= srcLen;
	    memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
	    RecycleBuffer(statePtr, bufPtr, 0);
	    statePtr->inQueueHead = nextPtr;
	    Tcl_SetObjLength(objPtr, numBytes);
	    return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
	}

	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
................................................................................
	}
    }

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (dstStart != srcStart) {
	    memcpy(dstStart, srcStart, (size_t) srcLen);
	}
	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
	    char *dst = dstStart;
	    char *dstEnd = dstStart + srcLen;

	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
		*dst++ = '\n';
................................................................................
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr,
	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    bufPtr = AllocChannelBuffer(len);
    memcpy(InsertPoint(bufPtr), str, (size_t) len);
    bufPtr->nextAdded += len;

    if (statePtr->inQueueHead == NULL) {
	bufPtr->nextPtr = NULL;
	statePtr->inQueueHead = bufPtr;
	statePtr->inQueueTail = bufPtr;
    } else if (atEnd) {
................................................................................
	     * - It does not process all events in the event queue, but only
	     *	 one, at least in some situations.
	     *
	     * In that case we can get into a situation where
	     *
	     * - Tcl drops READABLE here, because it has data in its own
	     *	 buffers waiting to be read by the extension.
	     * - A READABLE event is syntesized via timer.
	     * - The OS still reports the EXCEPTION condition on the file.
	     * - And the extension gets the EXCPTION event first, and handles
	     *	 this as EOF.
	     *
	     * End result ==> Premature end of reading from a file.
	     *
	     * The concrete example is 'Expect', and its [expect] command
	     * (and at the C-level, deep in the bowels of Expect,
	     * 'exp_get_next_event'. See marker 'SunOS' for commentary in
................................................................................

	    if (!statePtr->timer) {
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
	    }
	}
    }










    ChanWatch(chanPtr, mask);
}
 
/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --
................................................................................
static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
















    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
	    && (statePtr->interestMask & TCL_READABLE)
	    && (statePtr->inQueueHead != NULL)
	    && IsBufferReady(statePtr->inQueueHead)) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	Tcl_Preserve(statePtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
	Tcl_Release(statePtr);
    } else {
	statePtr->timer = NULL;
	UpdateInterest(chanPtr);
    }

}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *







>
>
>
>
>







 







|







 







|







 







>
>







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|

|







 







>
>
>
>
>
>
>
>
>
>







 







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












<

<

<


>







3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
....
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
....
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
....
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
....
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
....
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
....
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
....
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
....
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
....
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
....
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
....
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
....
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
....
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
....
8506
8507
8508
8509
8510
8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
....
8543
8544
8545
8546
8547
8548
8549
8550
8551
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576

8577

8578

8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
................................................................................
	}
	if (saved) {
	    /*
	     * Here's some translated bytes left over from the last buffer
	     * that we need to stick at the beginning of this buffer.
	     */

	    memcpy(InsertPoint(bufPtr), safe, saved);
	    bufPtr->nextAdded += saved;
	    saved = 0;
	}
	PreserveChannelBuffer(bufPtr);
	dst = InsertPoint(bufPtr);
	dstLen = SpaceLeft(bufPtr);

................................................................................
	     * the translation to produce a character that crossed the end of
	     * the output buffer, so that we would get a completely full
	     * buffer before flushing it. The extra bytes will be moved to the
	     * beginning of the next buffer.
	     */

	    saved = -SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

................................................................................
    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
    }

    UpdateInterest(chanPtr);

    return total;
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
	/*
	 * Copy bytes from the channel buffer to the ByteArray. This may
	 * realloc space, so keep track of result.
	 */

	rawLen = dstEnd - dst;
	byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
	memcpy(byteArray + byteLen, dst, rawLen);
	byteLen += rawLen;
    }

    /*
     * Found EOL or EOF, but the output buffer may now contain too many bytes.
     * We need to know how many bytes correspond to the number we want, so we
     * can remove the correct number of bytes from the channel buffer.
................................................................................
  gotEOL:
    if (bufPtr == NULL) {
	Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL");
    }

    rawLen = eol - dst;
    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
    memcpy(byteArray + byteLen, dst, rawLen);
    byteLen += rawLen;
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */
................................................................................
	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
		: bytesToRead;

	/*
         * Copy the current chunk into the read buffer.
         */

	memcpy(readBuf, RemovePoint(bufPtr), toCopy);
	bufPtr->nextRemoved += toCopy;
	copied += toCopy;
	readBuf += toCopy;
	bytesToRead -= toCopy;

	/*
         * If the current buffer is empty recycle it.
................................................................................
		{
		    /*
		     * There are chars leading the buffer before the eof char.
		     * Adjust the dstLimit so we go back and read only those
		     * and do not encounter the eof char this time.
		     */

		    dstLimit = dstRead + (TCL_UTF_MAX - 1);
		    statePtr->flags = savedFlags;
		    statePtr->inputEncodingFlags = savedIEFlags;
		    statePtr->inputEncodingState = savedState;
		    continue;
		}
	    }

................................................................................
		/*
		 * There are chars we can read before we hit the bare CR.  Go
		 * back with a smaller dstLimit so we get them in the next
		 * pass, compute a matching srcRead, and don't end up back
		 * here in this call.
		 */

		dstLimit = dstRead + (TCL_UTF_MAX - 1);
		statePtr->flags = savedFlags;
		statePtr->inputEncodingFlags = savedIEFlags;
		statePtr->inputEncodingState = savedState;
		continue;
	    }

	    assert(dstWrote == 0);
................................................................................
	     * TODO: This cannot happen anymore.
	     *
	     * We read more chars than allowed.  Reset limits to prevent that
	     * and try again.  Don't forget the extra padding of TCL_UTF_MAX
	     * bytes demanded by the Tcl_ExternalToUtf() call!
	     */

	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1);
	    statePtr->flags = savedFlags;
	    statePtr->inputEncodingFlags = savedIEFlags;
	    statePtr->inputEncodingState = savedState;
	    continue;
	}

	if (dstWrote == 0) {
................................................................................
	     */

	    if (nextPtr->nextRemoved - srcLen < 0) {
		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
	    }

	    nextPtr->nextRemoved -= srcLen;
	    memcpy(RemovePoint(nextPtr), src, srcLen);
	    RecycleBuffer(statePtr, bufPtr, 0);
	    statePtr->inQueueHead = nextPtr;
	    Tcl_SetObjLength(objPtr, numBytes);
	    return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
	}

	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
................................................................................
	}
    }

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (dstStart != srcStart) {
	    memcpy(dstStart, srcStart, srcLen);
	}
	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
	    char *dst = dstStart;
	    char *dstEnd = dstStart + srcLen;

	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
		*dst++ = '\n';
................................................................................
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr,
	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    bufPtr = AllocChannelBuffer(len);
    memcpy(InsertPoint(bufPtr), str, len);
    bufPtr->nextAdded += len;

    if (statePtr->inQueueHead == NULL) {
	bufPtr->nextPtr = NULL;
	statePtr->inQueueHead = bufPtr;
	statePtr->inQueueTail = bufPtr;
    } else if (atEnd) {
................................................................................
	     * - It does not process all events in the event queue, but only
	     *	 one, at least in some situations.
	     *
	     * In that case we can get into a situation where
	     *
	     * - Tcl drops READABLE here, because it has data in its own
	     *	 buffers waiting to be read by the extension.
	     * - A READABLE event is synthesized via timer.
	     * - The OS still reports the EXCEPTION condition on the file.
	     * - And the extension gets the EXCEPTION event first, and handles
	     *	 this as EOF.
	     *
	     * End result ==> Premature end of reading from a file.
	     *
	     * The concrete example is 'Expect', and its [expect] command
	     * (and at the C-level, deep in the bowels of Expect,
	     * 'exp_get_next_event'. See marker 'SunOS' for commentary in
................................................................................

	    if (!statePtr->timer) {
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timer
	&& mask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}
 
/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --
................................................................................
static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
	&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
	) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
    }

    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
	    && (statePtr->interestMask & TCL_READABLE)
	    && (statePtr->inQueueHead != NULL)
	    && IsBufferReady(statePtr->inQueueHead)) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);

	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);

    } else {

	UpdateInterest(chanPtr);
    }
    Tcl_Release(statePtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *

Changes to generic/tclIOCmd.c.

948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

    /*
     * Create the string argument array "argv". Make sure argv is large enough
     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
     */

    argc = objc - skip;
    argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));

    /*
     * Copy the string conversions of each (post option) object into the
     * argument vector.
     */

    for (i = 0; i < argc; i++) {







|







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

    /*
     * Create the string argument array "argv". Make sure argv is large enough
     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
     */

    argc = objc - skip;
    argv = TclStackAlloc(interp, (argc + 1) * sizeof(char *));

    /*
     * Copy the string conversions of each (post option) object into the
     * argument vector.
     */

    for (i = 0; i < argc; i++) {

Changes to generic/tclIORChan.c.

50
51
52
53
54
55
56


57
58
59
60
61
62
63
...
108
109
110
111
112
113
114











115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
...
916
917
918
919
920
921
922
923











924
925
926
927
928
929
930
...
963
964
965
966
967
968
969


















970
971
972
973
974
975
976
....
1157
1158
1159
1160
1161
1162
1163






1164
1165
1166
1167
1168
1169
1170
....
1226
1227
1228
1229
1230
1231
1232






1233
1234
1235
1236
1237
1238
1239
....
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
....
2127
2128
2129
2130
2131
2132
2133


2134
2135
2136
2137
2138
2139
2140
....
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
....
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
			    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);



/*
 * The C layer channel type/driver definition used by the reflection. This is
 * a version 3 structure.
 */

static const Tcl_ChannelType tclRChannelType = {
................................................................................
    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */












    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *
     * Here this is _not_ required. Interest in events is posted to the Tcl
     * level via 'watch'. And posting of events is possible from the Tcl level
     * as well, via 'chan postevent'. This means that the generation of all
     * events, fake or not, timer based or not, is completely in the hands of
     * the Tcl level. Therefore no timer here.
     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
................................................................................
    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);











#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

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

    Tcl_ResetResult(interp);
    return TCL_OK;

#undef CHAN
#undef EVENT
}


















 
/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
MarshallError(
................................................................................
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree(tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}






        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */
................................................................................
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	ckfree(tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }






    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
        goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec > 0) {
	memcpy(buf, bytev, (size_t) bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return bytec;
................................................................................
    rcPtr = ckalloc(sizeof(ReflectedChannel));

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

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;


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

    /* ASSERT: cmdpfxObj is a Tcl List */
................................................................................
	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = -1;
	    } else {
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, (size_t) bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
	break;
................................................................................
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */







>
>







 







>
>
>
>
>
>
>
>
>
>
>









|
|
|
<
<







 







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







 







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







 







>
>
>
>
>
>







 







>
>
>
>
>
>







 







|







 







>
>







 







|







 







|












50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
...
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139


140
141
142
143
144
145
146
...
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
...
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
....
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
....
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
....
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
....
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
....
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
			    int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static void     TimerRunRead(ClientData clientData);
static void     TimerRunWrite(ClientData clientData);

/*
 * The C layer channel type/driver definition used by the reflection. This is
 * a version 3 structure.
 */

static const Tcl_ChannelType tclRChannelType = {
................................................................................
    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */

    Tcl_TimerToken readTimer;   /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is readable
			        */
    Tcl_TimerToken writeTimer;  /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is writable
			        */

    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *
     * A timer is used here as well in order to ensure at least on pass through
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.


     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
................................................................................
    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
	if (events & TCL_READABLE) {
	    if (rcPtr->readTimer == NULL) {
		rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunRead, rcPtr);
	    }
	}
	if (events & TCL_WRITABLE) {
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

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

    Tcl_ResetResult(interp);
    return TCL_OK;

#undef CHAN
#undef EVENT
}
 
static void
TimerRunRead(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    rcPtr->readTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}
 
static void
TimerRunWrite(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    rcPtr->writeTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}
 
/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
MarshallError(
................................................................................
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree(tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
	if (rcPtr->readTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->readTimer);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */
................................................................................
    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	ckfree(tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    if (rcPtr->readTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->readTimer);
    }
    if (rcPtr->writeTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
        goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec > 0) {
	memcpy(buf, bytev, bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return bytec;
................................................................................
    rcPtr = ckalloc(sizeof(ReflectedChannel));

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

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

    /* ASSERT: cmdpfxObj is a Tcl List */
................................................................................
	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = -1;
	    } else {
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
	break;
................................................................................
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclIORTrans.c.

2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
....
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
....
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
....
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
....
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedFlush:
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedClear:
................................................................................
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif /* TCL_THREADS */
 
/*
 *----------------------------------------------------------------------
 *
 * TimerKill --







|







 







|







 







|







 







|







 







|







2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
....
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
....
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
....
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
....
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedFlush:
................................................................................

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedClear:
................................................................................
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */
 
/*
 *----------------------------------------------------------------------
 *
 * TimerKill --

Changes to generic/tclIOUtil.c.

4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *	This function is for use by the Win/Unix native filesystems, so that
 *	they can easily retrieve the native (char* or TCHAR*) representation
 *	of a path. Other filesystems will probably want to implement similar
 *	functions. They basically act as a safety net around
 *	Tcl_FSGetInternalRep. Normally your file-system functions will always
 *	be called with path objects already converted to the correct
 *	filesystem, but if for some reason they are called directly (i.e. by
 *	functions not in this file), then one cannot necessarily guarantee
 *	that the path object pointer is from the correct filesystem.







|







4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *	This function is for use by the Win/Unix native filesystems, so that
 *	they can easily retrieve the native (char* or WCHAR*) representation
 *	of a path. Other filesystems will probably want to implement similar
 *	functions. They basically act as a safety net around
 *	Tcl_FSGetInternalRep. Normally your file-system functions will always
 *	be called with path objects already converted to the correct
 *	filesystem, but if for some reason they are called directly (i.e. by
 *	functions not in this file), then one cannot necessarily guarantee
 *	that the path object pointer is from the correct filesystem.

Changes to generic/tclIndexObj.c.

974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
....
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
....
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned)len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
................................................................................
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned) len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
................................................................................
    Tcl_Obj *value,
    int *codePtr)		/* Argument objects. */
{
    static const char *const returnCodes[] = {
	"ok", "error", "return", "break", "continue", NULL
    };

    if ((value->typePtr != &indexType)
	    && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
	return TCL_OK;
    }
    if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
	    codePtr) == TCL_OK) {
	return TCL_OK;
    }







|
<







 







|
<







 







|







974
975
976
977
978
979
980
981

982
983
984
985
986
987
988
....
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
....
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp, len + 1);


		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
................................................................................
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp, len + 1);


		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
................................................................................
    Tcl_Obj *value,
    int *codePtr)		/* Argument objects. */
{
    static const char *const returnCodes[] = {
	"ok", "error", "return", "break", "continue", NULL
    };

    if (!TclHasIntRep(value, &indexType)
	    && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
	return TCL_OK;
    }
    if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
	    codePtr) == TCL_OK) {
	return TCL_OK;
    }

Changes to generic/tclInt.h.

2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
....
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
....
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
....
3108
3109
3110
3111
3112
3113
3114

3115
3116
3117
3118
3119
3120
3121
....
3243
3244
3245
3246
3247
3248
3249











3250
3251
3252
3253
3254
3255
3256
....
3261
3262
3263
3264
3265
3266
3267

3268
3269
3270









3271


3272
3273
3274
3275
3276
3277
3278
....
3450
3451
3452
3453
3454
3455
3456



3457
3458
3459
3460
3461
3462
3463
....
3539
3540
3541
3542
3543
3544
3545



3546
3547
3548
3549
3550
3551
3552
....
3621
3622
3623
3624
3625
3626
3627



3628
3629
3630
3631
3632
3633
3634
....
3783
3784
3785
3786
3787
3788
3789



3790
3791
3792
3793
3794
3795
3796
....
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
....
4489
4490
4491
4492
4493
4494
4495

























4496
4497
4498
4499
4500
4501
4502
....
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
....
4619
4620
4621
4622
4623
4624
4625


4626
4627
4628
4629
4630
4631
4632
4633
4634
				/* Procedure that unloads a loaded module */
};

/* Flags for conversion of doubles to digit strings */

#define TCL_DD_SHORTEST 		0x4
				/* Use the shortest possible string */
#define TCL_DD_STEELE   		0x5
				/* Use the original Steele&White algorithm */
#define TCL_DD_E_FORMAT 		0x2
				/* Use a fixed-length string of digits,
				 * suitable for E format*/
#define TCL_DD_F_FORMAT 		0x3
				/* Use a fixed number of digits after the
				 * decimal point, suitable for F format */

................................................................................
				/* Allow return of a shorter digit string
				 * if it converts losslessly */
#define TCL_DD_NO_QUICK 		0x8
				/* Debug flag: forbid quick FP conversion */

#define TCL_DD_CONVERSION_TYPE_MASK	0x3
				/* Mask to isolate the conversion type */
#define TCL_DD_STEELE0 			0x1
				/* 'Steele&White' after masking */
#define TCL_DD_SHORTEST0		0x0
				/* 'Shortest possible' after masking */

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

................................................................................
MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitBignumFromLong(mp_int *, long);
MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);
................................................................................
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);

MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
................................................................................
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);











MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
................................................................................
MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);

#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);









#endif


MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, int length);
................................................................................
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LpopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,



			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,



			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,



			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,



			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLastCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................
 */

#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (unsigned) (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
................................................................................
 *
 * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)


























/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
................................................................................
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
		    (unsigned int) (allocated * sizeof(Tcl_Token)));	\
	    if (newPtr == NULL) {					\
		allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
		if (allocated > TCL_MAX_TOKENS) {			\
		    allocated = TCL_MAX_TOKENS;				\
		}							\
		newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr,	\
			(unsigned int) (allocated * sizeof(Tcl_Token))); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			(size_t) ((used) * sizeof(Tcl_Token)));		\
	    }								\
	    (tokenPtr) = newPtr;					\
	}								\
    } while (0)

#define TclGrowParseTokenArray(parsePtr, append)			\
    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
................................................................................
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))


#define TclFetchIntRep(objPtr, type) \
	(((objPtr)->typePtr == type) ? &((objPtr)->internalRep) : NULL)


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for







<
<







 







<
<
<
<







 







<







 







>







 







>
>
>
>
>
>
>
>
>
>
>







 







>



>
>
>
>
>
>
>
>
>

>
>







 







>
>
>







 







>
>
>







 







>
>
>







 







>
>
>







 







|
|







 







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







 







|






|




|







 







>
>

|







2872
2873
2874
2875
2876
2877
2878


2879
2880
2881
2882
2883
2884
2885
....
2887
2888
2889
2890
2891
2892
2893




2894
2895
2896
2897
2898
2899
2900
....
3056
3057
3058
3059
3060
3061
3062

3063
3064
3065
3066
3067
3068
3069
....
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
....
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
....
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
....
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
....
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
....
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
....
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
....
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
....
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
....
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
....
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
				/* Procedure that unloads a loaded module */
};

/* Flags for conversion of doubles to digit strings */

#define TCL_DD_SHORTEST 		0x4
				/* Use the shortest possible string */


#define TCL_DD_E_FORMAT 		0x2
				/* Use a fixed-length string of digits,
				 * suitable for E format*/
#define TCL_DD_F_FORMAT 		0x3
				/* Use a fixed number of digits after the
				 * decimal point, suitable for F format */

................................................................................
				/* Allow return of a shorter digit string
				 * if it converts losslessly */
#define TCL_DD_NO_QUICK 		0x8
				/* Debug flag: forbid quick FP conversion */

#define TCL_DD_CONVERSION_TYPE_MASK	0x3
				/* Mask to isolate the conversion type */





/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

................................................................................
MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);

MODULE_SCOPE void	TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
MODULE_SCOPE void	TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);
................................................................................
			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
................................................................................
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
#if (TCL_UTF_MAX > 4) && (defined(__CYGWIN__) || defined(_WIN32))
MODULE_SCOPE int TclUtfToWChar(const char *src, WCHAR *chPtr);
MODULE_SCOPE char *	TclWCharToUtfDString(const WCHAR *uniStr,
			    int uniLength, Tcl_DString *dsPtr);
MODULE_SCOPE WCHAR * TclUtfToWCharDString(const char *src,
			    int length, Tcl_DString *dsPtr);
#else
#   define TclUtfToWChar TclUtfToUniChar
#   define TclWCharToUtfDString Tcl_UniCharToUtfDString
#   define TclUtfToWCharDString Tcl_UtfToUniCharDString
#endif
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
................................................................................
MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);

#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#else
#   ifdef _WIN32
#	define TCL_WIDE_CLICKS 1
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	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, int length);
................................................................................
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LpopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LremoveObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeRateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
................................................................................
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetWithDefaultCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringInsertCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLastCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
................................................................................
 */

#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *) ckalloc((len) + 1); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
................................................................................
 *
 * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the bignum out of the bignum
 * representation of a Tcl_Obj.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum);
 *----------------------------------------------------------------
 */

#define TclUnpackBignum(objPtr, bignum) \
    do {								\
	register Tcl_Obj *bignumObj = (objPtr);				\
	register int bignumPayload =					\
		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
	if (bignumPayload == -1) {					\
	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
	} else {							\
	    (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1;	\
	    (bignum).sign = bignumPayload >> 30;			\
	    (bignum).alloc = (bignumPayload >> 15) & 0x7fff;		\
	    (bignum).used = bignumPayload & 0x7fff;			\
	}								\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
................................................................................
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
		    allocated * sizeof(Tcl_Token));	\
	    if (newPtr == NULL) {					\
		allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
		if (allocated > TCL_MAX_TOKENS) {			\
		    allocated = TCL_MAX_TOKENS;				\
		}							\
		newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr,	\
			allocated * sizeof(Tcl_Token)); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			(used) * sizeof(Tcl_Token));		\
	    }								\
	    (tokenPtr) = newPtr;					\
	}								\
    } while (0)

#define TclGrowParseTokenArray(parsePtr, append)			\
    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
................................................................................
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasIntRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#define TclFetchIntRep(objPtr, type) \
	(TclHasIntRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for

Changes to generic/tclInterp.c.

1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
....
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
....
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981

    listPtr = Tcl_NewListObj(cmdc, NULL);
    listRep = ListRepPtr(listPtr);
    listRep->elemCount = cmdc;
    cmdv = &listRep->elements;

    prefv = &aliasPtr->objPtr;
    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
................................................................................
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    Tcl_ResetResult(targetInterp);

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

................................................................................
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:







|
|







 







|
|







 







|
|







1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
....
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
....
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981

    listPtr = Tcl_NewListObj(cmdc, NULL);
    listRep = ListRepPtr(listPtr);
    listRep->elemCount = cmdc;
    cmdv = &listRep->elements;

    prefv = &aliasPtr->objPtr;
    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
................................................................................
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    Tcl_ResetResult(targetInterp);

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

................................................................................
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:

Changes to generic/tclLink.c.

4
5
6
7
8
9
10


11
12
13
14
15
16


17
18
19
20
21
22
23
24
25

26
27
28
29
30





31
32
33
34
35
36
37
..
40
41
42
43
44
45
46













47
48
49
50
51
52
53
54
55
56
57
58
59




60
61
62
63


64
65
66
67
68
69
70
71

72
73
74















75
76
77
78
79
80
81
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117


118
119
120
121
122
123
124
125
126
127
128
129

130
131
132
133
134
135
136
...
140
141
142
143
144
145
146


147
148
149
150
151
152
153


























































































































































































154
155
156
157
158
159
160
161
162
163
164
165
166
...
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
...
241
242
243
244
245
246
247











































































































































































































































248
249
250
251
252
253
254
...
269
270
271
272
273
274
275
276
277
278
279
280
281

282



283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
...
312
313
314
315
316
317
318









319
320
321
322
323
324
325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357

358
359


360
361
362

363

364
365
366
367
368
369
370
...
388
389
390
391
392
393
394




395



























































396


397








398


399
400
401
402
403

404
405
406
407












408


409
410
411
412
413

414
415
416
417
418
419
420
421


422
423
424
425
426
427
428

429
430
431





432

433
434
435













436
437
438
439
440
441

442
443
444
445











446
447

448
449
450
451
452

453
454
455
456












457
458

459
460
461
462
463


464
465
466
467











468
469

470
471
472
473
474

475
476
477
478












479
480

481
482
483
484
485


486
487
488
489












490
491

492
493
494
495
496


497
498
499
500
501











502
503

504
505
506
507
508

509
510
511
512
513
514




515
516










517
518
519


520
521
522
523
524
525
526
527
528



529
530









531
532
533

534
535
536
537












538
539


540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558




559
560
561
562
563
564
565
...
578
579
580
581
582
583
584
585

586
587
588










589
590
591










592
593
594










595
596
597










598
599
600










601
602
603










604
605
606










607
608
609










610
611
612










613
614
615
616










617
618
619










620
621
622
623










624
625
626











627
628
629
630
631

632
633
634
635
636
637
638
639



















640
641
642
643
644
645
646
647
648
649
650
651


652
653
654
655
656
657
658
659
660
661
662
663
664

665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690


691


692
693
694
695
696
697

698
699
700
701
702



703
704
705
706
707
708
709
710


711
712


713


714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750

751
752
753
754
755
756
757
758
759
 *	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.


 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"



/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl
 * variable.
 */

typedef struct Link {
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */

    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    char *addr;			/* Location of C variable. */





    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
	short s;
................................................................................
	long l;
	unsigned long ul;
#endif
	Tcl_WideInt w;
	Tcl_WideUInt uw;
	float f;
	double d;













    } lastValue;		/* Last known value of C variable; used to
				 * avoid string conversions. */
    int flags;			/* Miscellaneous one-bit values; see below for
				 * definitions. */
} Link;

/*
 * Definitions for flag bits:
 * LINK_READ_ONLY -		1 means errors should be generated if Tcl
 *				script attempts to write variable.
 * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
 *				in progress for this variable, so trace
 *				callbacks on the variable should be ignored.




 */

#define LINK_READ_ONLY		1
#define LINK_BEING_UPDATED	2



/*
 * Forward references to functions defined later in this file:
 */

static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static Tcl_Obj *	ObjValue(Link *linkPtr);

static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
static int		GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
















/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
 * is not strictly a good thing, but it keeps the code much shorter and
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_LinkVar(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    char *addr,			/* Address of a C variable to be linked to
				 * varName. */
    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;


    int code;

    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->interp = interp;

    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
................................................................................
    }
#endif
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }


    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
	return TCL_ERROR;
    }


























































































































































































    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	ckfree(linkPtr);
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    ckfree(linkPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *
................................................................................
	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
    }
}
 
/*
 *----------------------------------------------------------------------
 *











































































































































































































































 * LinkTraceProc --
 *
 *	This function is invoked when a linked Tcl variable is read, written,
 *	or unset from Tcl. It's responsible for keeping the C variable in sync
 *	with the Tcl variable.
 *
 * Results:
................................................................................
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    int changed;
    size_t valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;

    double valueDouble;




    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    ckfree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
................................................................................

    /*
     * For read accesses, update the Tcl variable if the C variable has
     * changed since the last time we updated the Tcl variable.
     */

    if (flags & TCL_TRACE_READS) {









	switch (linkPtr->type) {
	case TCL_LINK_INT:
	case TCL_LINK_BOOLEAN:
	    changed = (LinkedVar(int) != linkPtr->lastValue.i);
	    break;
	case TCL_LINK_DOUBLE:
	    changed = (LinkedVar(double) != linkPtr->lastValue.d);

	    break;
	case TCL_LINK_WIDE_INT:
	    changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
	    break;
	case TCL_LINK_WIDE_UINT:
	    changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
	    break;
	case TCL_LINK_CHAR:
	    changed = (LinkedVar(char) != linkPtr->lastValue.c);
	    break;
	case TCL_LINK_UCHAR:
	    changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
	    break;
	case TCL_LINK_SHORT:
	    changed = (LinkedVar(short) != linkPtr->lastValue.s);
	    break;
	case TCL_LINK_USHORT:
	    changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
	    break;
	case TCL_LINK_UINT:
	    changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
	    break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	case TCL_LINK_LONG:
	    changed = (LinkedVar(long) != linkPtr->lastValue.l);
	    break;
	case TCL_LINK_ULONG:
	    changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
	    break;
#endif
	case TCL_LINK_FLOAT:
	    changed = (LinkedVar(float) != linkPtr->lastValue.f);

	    break;
	case TCL_LINK_STRING:


	    changed = 1;
	    break;
	default:

	    return (char *) "internal error: bad linked variable type";

	}
	if (changed) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	}
	return NULL;
    }
................................................................................
	/*
	 * This shouldn't ever happen.
	 */

	return (char *) "internal error: linked variable couldn't be read";
    }





    switch (linkPtr->type) {



























































    case TCL_LINK_INT:


	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK








		&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {


	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have integer value";
	}
	LinkedVar(int) = linkPtr->lastValue.i;

	break;

    case TCL_LINK_WIDE_INT:
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK












		&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {


	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have integer value";
	}
	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;

	break;

    case TCL_LINK_DOUBLE:
	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
#ifdef ACCEPT_NAN
	    Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType);
	    if (irPtr == NULL) {
#endif


		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		    return (char *) "variable must have real value";
		}
#ifdef ACCEPT_NAN
	    }

	    linkPtr->lastValue.d = irPtr->doubleValue;
#endif
	}





	LinkedVar(double) = linkPtr->lastValue.d;

	break;

    case TCL_LINK_BOOLEAN:













	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have boolean value";
	}
	LinkedVar(int) = linkPtr->lastValue.i;

	break;

    case TCL_LINK_CHAR:
	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK











		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have char value";
	}
	LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;

	break;

    case TCL_LINK_UCHAR:
	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK












		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
		|| valueInt < 0 || valueInt > UCHAR_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have unsigned char value";
	}
	LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;


	break;

    case TCL_LINK_SHORT:
	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK











		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have short value";
	}
	LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;

	break;

    case TCL_LINK_USHORT:
	if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK












		&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
		|| valueInt < 0 || valueInt > USHRT_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have unsigned short value";
	}
	LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;


	break;

    case TCL_LINK_UINT:
	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK












		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
		|| valueWide < 0 || valueWide > UINT_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have unsigned int value";
	}
	LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;


	break;

#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK











		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {

	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have long value";
	}
	LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;

	break;

    case TCL_LINK_ULONG:
	if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {




	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);










	    return (char *) "variable must have unsigned long value";
	}
	LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;


	break;
#endif

    case TCL_LINK_WIDE_UINT:
	/*
	 * FIXME: represent as a bignum.
	 */
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
		&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {



	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);









	    return (char *) "variable must have unsigned wide int value";
	}
	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;

	break;

    case TCL_LINK_FLOAT:
	if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK












		&& GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {


	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return (char *) "variable must have float value";
	}
	LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
	break;

    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	break;

    default:
	return (char *) "internal error: bad linked variable type";
    }




    return NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ObjValue --
................................................................................
 */

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj;


    switch (linkPtr->type) {
    case TCL_LINK_INT:










	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewIntObj(linkPtr->lastValue.i);
    case TCL_LINK_WIDE_INT:










	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:










	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:










	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
    case TCL_LINK_CHAR:










	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:










	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:










	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:










	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:










	linkPtr->lastValue.ui = LinkedVar(unsigned int);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:










	linkPtr->lastValue.l = LinkedVar(long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
    case TCL_LINK_ULONG:










	linkPtr->lastValue.ul = LinkedVar(unsigned long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:










	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:











	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	/*
	 * FIXME: represent as a bignum.
	 */
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}
	return Tcl_NewStringObj(p, -1);




















    /*
     * This code only gets executed if the link type is unknown (shouldn't
     * ever happen).
     */

    default:
	TclNewLiteralStringObj(resultObj, "??");
	return resultObj;
    }
}

static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);



static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};

static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
    const char *str;
    const char *endPtr;


    str = TclGetString(objPtr);
    if ((objPtr->length == 1) && (str[0] == '.')){
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
	/* If number is followed by [eE][+-]?, then it is an invalid
	 * double, but it could be the start of a valid double. */
	if (*endPtr == 'e' || *endPtr == 'E') {
	    ++endPtr;
	    if (*endPtr == '+' || *endPtr == '-') ++endPtr;
	    if (*endPtr == 0) {
		double doubleValue = 0.0;
		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &invalidRealType;
		objPtr->internalRep.doubleValue = doubleValue;
		return TCL_OK;
	    }
	}
    }
    return TCL_ERROR;
}






/*
 * This function checks for integer representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
 * (upperand lowercase). See bug [39f6304c2e].

 */
int
GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
{
    const char *str = TclGetString(objPtr);




    if ((objPtr->length == 0) ||
	    ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;


    }
    return TCL_ERROR;


}



int
GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
{
    int intValue;

    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	return TCL_ERROR;
    }
    *widePtr = intValue;
    return TCL_OK;
}

/*
 * This function checks for double representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
 * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
 */
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
{
    int intValue;

    if (objPtr->typePtr == &invalidRealType) {
	goto gotdouble;
    }
    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
	*doublePtr = (double) intValue;
	return TCL_OK;
    }
    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
    gotdouble:
	*doublePtr = objPtr->internalRep.doubleValue;
	return TCL_OK;
    }
    return TCL_ERROR;

}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







>
>






>
>









>




|
>
>
>
>
>







 







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













>
>
>
>




>
>








>

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







 







|






>
>












>







 







>
>




|


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





|







 







|







 







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







 







|





>

>
>
>







|

|







 







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

|
|
|
|
|
|

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







 







>
>
>
>

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

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



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



<
<
<
<
<
>
>
|
|
|
|

<

>
|
<
|
>
>
>
>
>
|
>



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



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



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



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



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



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




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



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




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



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





>
>
>
>







 







|
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>




>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>




>
>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>
>
>
>

<
<
<

>








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










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

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

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









4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
..
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
...
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
...
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
...
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
...
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
...
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807

808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839

840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
...
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993





994
995
996
997
998
999
1000

1001
1002
1003

1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037

1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103
1104
1105

1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118

1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174
1175
1176



1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201





1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222

1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235

1236
1237
1238
1239
1240
1241
1242

1243







1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
....
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453



1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493

1494
1495
1496

1497





1498




1499
1500

























1501
1502
1503
1504
1505
1506





1507
1508


1509

1510
1511
1512
1513







1514
1515
1516

1517
1518
1519
1520
1521
1522




































1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
 *	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 "tommath.h"
#include <math.h>

/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl
 * variable.
 */

typedef struct Link {
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    int bytes;			/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    int numElems;		/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
	short s;
................................................................................
	long l;
	unsigned long ul;
#endif
	Tcl_WideInt w;
	Tcl_WideUInt uw;
	float f;
	double d;
	void *aryPtr;		/* Generic array. */
	char *cPtr;		/* char array */
	unsigned char *ucPtr;	/* unsigned char array */
	short *sPtr;		/* short array */
	unsigned short *usPtr;	/* unsigned short array */
	int *iPtr;		/* int array */
	unsigned int *uiPtr;	/* unsigned int array */
	long *lPtr;		/* long array */
	unsigned long *ulPtr;	/* unsigned long array */
	Tcl_WideInt *wPtr;	/* wide (long long) array */
	Tcl_WideUInt *uwPtr;	/* unsigned wide (long long) array */
	float *fPtr;		/* float array */
	double *dPtr;		/* double array */
    } lastValue;		/* Last known value of C variable; used to
				 * avoid string conversions. */
    int flags;			/* Miscellaneous one-bit values; see below for
				 * definitions. */
} Link;

/*
 * Definitions for flag bits:
 * LINK_READ_ONLY -		1 means errors should be generated if Tcl
 *				script attempts to write variable.
 * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
 *				in progress for this variable, so trace
 *				callbacks on the variable should be ignored.
 * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the
 *				heap.
 * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on
 *				the heap.
 */

#define LINK_READ_ONLY		1
#define LINK_BEING_UPDATED	2
#define LINK_ALLOC_ADDR		4
#define LINK_ALLOC_LAST		8

/*
 * Forward references to functions defined later in this file:
 */

static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static Tcl_Obj *	ObjValue(Link *linkPtr);
static void		LinkFree(Link *linkPtr);
static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);

static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
			    double *doublePtr);
static int		SetInvalidRealFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);

/*
 * A marker type used to flag weirdnesses so we can pass them around right.
 */

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
 * is not strictly a good thing, but it keeps the code much shorter and
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcl_LinkVar(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. */
    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->nsPtr = NULL;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
................................................................................
    }
#endif
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }
    linkPtr->bytes = 0;
    linkPtr->numElems = 0;
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	return TCL_ERROR;
    }

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinkArray --
 *
 *	Link a C variable array to a Tcl variable so that changes to either
 *	one causes the other to change.
 *
 * Results:
 *	The return value is TCL_OK if everything went well or TCL_ERROR if an
 *	error occurred (the interp's result is also set after errors).
 *
 * Side effects:
 *	The value at *addr is linked to the Tcl variable "varName", using
 *	"type" to convert between string values for Tcl and binary values for
 *	*addr.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LinkArray(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    int size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    if (size < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong array size given", -1));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
    linkPtr->numElems = size;
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
    case TCL_LINK_BOOLEAN:
	linkPtr->bytes = size * sizeof(int);
	break;
    case TCL_LINK_DOUBLE:
	linkPtr->bytes = size * sizeof(double);
	break;
    case TCL_LINK_WIDE_INT:
	linkPtr->bytes = size * sizeof(Tcl_WideInt);
	break;
    case TCL_LINK_WIDE_UINT:
	linkPtr->bytes = size * sizeof(Tcl_WideUInt);
	break;
    case TCL_LINK_CHAR:
	linkPtr->bytes = size * sizeof(char);
	break;
    case TCL_LINK_UCHAR:
	linkPtr->bytes = size * sizeof(unsigned char);
	break;
    case TCL_LINK_SHORT:
	linkPtr->bytes = size * sizeof(short);
	break;
    case TCL_LINK_USHORT:
	linkPtr->bytes = size * sizeof(unsigned short);
	break;
    case TCL_LINK_UINT:
	linkPtr->bytes = size * sizeof(unsigned int);
	break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	linkPtr->bytes = size * sizeof(long);
	break;
    case TCL_LINK_ULONG:
	linkPtr->bytes = size * sizeof(unsigned long);
	break;
#endif
    case TCL_LINK_FLOAT:
	linkPtr->bytes = size * sizeof(float);
	break;
    case TCL_LINK_STRING:
	linkPtr->bytes = size * sizeof(char);
	size = 1;		/* This is a variable length string, no need
				 * to check last value. */

	/*
	 * If no address is given create one and use as address the
         * not needed linkPtr->lastValue
	 */

	if (addr == NULL) {
	    linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
	    linkPtr->flags |= LINK_ALLOC_LAST;
	    addr = (char *) &linkPtr->lastValue.cPtr;
	}
	break;
    case TCL_LINK_CHARS:
    case TCL_LINK_BINARY:
	linkPtr->bytes = size * sizeof(char);
	break;
    default:
	LinkFree(linkPtr);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad linked array variable type", -1));
	return TCL_ERROR;
    }

    /*
     * Allocate C variable space in case no address is given
     */

    if (addr == NULL) {
	linkPtr->addr = ckalloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_ADDR;
    } else {
	linkPtr->addr = addr;
    }

    /*
     * If necessary create space for last used value.
     */

    if (size > 1) {
	linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_LAST;
    }

    /*
     * Initialize allocated space.
     */

    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	memset(linkPtr->addr, 0, linkPtr->bytes);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memset(linkPtr->lastValue.aryPtr, 0, linkPtr->bytes);
    }

    /*
     * Set common structure values.
     */

    linkPtr->interp = interp;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	return TCL_ERROR;
    }

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
    }
    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    LinkFree(linkPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *
................................................................................
	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * GetInt, GetWide, GetUWide, GetDouble, EqualDouble, IsSpecial --
 *
 *	Helper functions for LinkTraceProc and ObjValue. These are all
 *	factored out here to make those functions simpler.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetInt(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    return (Tcl_GetIntFromObj(NULL, objPtr, intPtr) != TCL_OK
	    && GetInvalidIntFromObj(objPtr, intPtr) != TCL_OK);
}

static inline int
GetWide(
    Tcl_Obj *objPtr,
    Tcl_WideInt *widePtr)
{
    if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) {
	int intValue;

	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	    return 1;
	}
	*widePtr = intValue;
    }
    return 0;
}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
    ClientData clientData;
    int type, intValue;

    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
	if (type == TCL_NUMBER_INT) {
	    *widePtr = *((const Tcl_WideInt *) clientData);
	    return (*widePtr < 0);
	} else if (type == TCL_NUMBER_BIG) {
	    mp_int *numPtr = clientData;
	    Tcl_WideUInt value = 0;
	    union {
		Tcl_WideUInt value;
		unsigned char bytes[sizeof(Tcl_WideUInt)];
	    } scratch;
	    unsigned long numBytes = sizeof(Tcl_WideUInt);
	    unsigned char *bytes = scratch.bytes;

	    if (numPtr->sign || (MP_OKAY != mp_to_unsigned_bin_n(numPtr,
		    bytes, &numBytes))) {
		/*
		 * If the sign bit is set (a negative value) or if the value
		 * can't possibly fit in the bits of an unsigned wide, there's
		 * no point in doing further conversion.
		 */
		return 1;
	    }
#ifdef WORDS_BIGENDIAN
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
#else /* !WORDS_BIGENDIAN */
	    /*
	     * Little-endian can read the value directly.
	     */
	    value = scratch.value;
#endif /* WORDS_BIGENDIAN */
	    *uwidePtr = value;
	    return 0;
	}
    }

    /*
     * Evil edge case fallback.
     */

    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	return 1;
    }
    *uwidePtr = intValue;
    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)
{
    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
	return 0;
    } else {
#ifdef ACCEPT_NAN
	Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType);

	if (irPtr != NULL) {
	    *dblPtr = irPtr->doubleValue;
	    return 0;
	}
#endif /* ACCEPT_NAN */
	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
    }
}

static inline int
EqualDouble(
    double a,
    double b)
{
    return (a == b)
#ifdef ACCEPT_NAN
	|| (TclIsNaN(a) && TclIsNaN(b))
#endif /* ACCEPT_NAN */
	;
}

static inline int
IsSpecial(
    double a)
{
    return TclIsInfinite(a)
#ifdef ACCEPT_NAN
	|| TclIsNaN(a)
#endif /* ACCEPT_NAN */
	;
}

/*
 * Mark an object as holding a weird double.
 */

static int
SetInvalidRealFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;

    str = TclGetString(objPtr);
    if ((objPtr->length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
	/*
	 * If number is followed by [eE][+-]?, then it is an invalid
	 * double, but it could be the start of a valid double.
	 */

	if (*endPtr == 'e' || *endPtr == 'E') {
	    ++endPtr;
	    if (*endPtr == '+' || *endPtr == '-') {
		++endPtr;
	    }
	    if (*endPtr == 0) {
		double doubleValue = 0.0;

		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &invalidRealType;
		objPtr->internalRep.doubleValue = doubleValue;
		return TCL_OK;
	    }
	}
    }
    return TCL_ERROR;
}

/*
 * This function checks for integer representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
 * (upperand lowercase). See bug [39f6304c2e].
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    const char *str = TclGetString(objPtr);

    if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0')
	    && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 * This function checks for double representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
 * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
 */

static int
GetInvalidDoubleFromObj(
    Tcl_Obj *objPtr,
    double *doublePtr)
{
    int intValue;

    if (TclHasIntRep(objPtr, &invalidRealType)) {
	goto gotdouble;
    }
    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
	*doublePtr = (double) intValue;
	return TCL_OK;
    }
    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
    gotdouble:
	*doublePtr = objPtr->internalRep.doubleValue;
	return TCL_OK;
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * LinkTraceProc --
 *
 *	This function is invoked when a linked Tcl variable is read, written,
 *	or unset from Tcl. It's responsible for keeping the C variable in sync
 *	with the Tcl variable.
 *
 * Results:
................................................................................
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    int changed;
    int valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    int objc;
    Tcl_Obj **objv;
    int i;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    LinkFree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}
................................................................................

    /*
     * For read accesses, update the Tcl variable if the C variable has
     * changed since the last time we updated the Tcl variable.
     */

    if (flags & TCL_TRACE_READS) {
	/*
	 * Variable arrays
	 */

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    changed = memcmp(linkPtr->addr, linkPtr->lastValue.aryPtr,
		    linkPtr->bytes);
	} else {
	    /* single variables */
	    switch (linkPtr->type) {
	    case TCL_LINK_INT:
	    case TCL_LINK_BOOLEAN:
		changed = (LinkedVar(int) != linkPtr->lastValue.i);
		break;
	    case TCL_LINK_DOUBLE:

		changed = !EqualDouble(LinkedVar(double), linkPtr->lastValue.d);
		break;
	    case TCL_LINK_WIDE_INT:
		changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
		break;
	    case TCL_LINK_WIDE_UINT:
		changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
		break;
	    case TCL_LINK_CHAR:
		changed = (LinkedVar(char) != linkPtr->lastValue.c);
		break;
	    case TCL_LINK_UCHAR:
		changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
		break;
	    case TCL_LINK_SHORT:
		changed = (LinkedVar(short) != linkPtr->lastValue.s);
		break;
	    case TCL_LINK_USHORT:
		changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
		break;
	    case TCL_LINK_UINT:
		changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
		break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	    case TCL_LINK_LONG:
		changed = (LinkedVar(long) != linkPtr->lastValue.l);
		break;
	    case TCL_LINK_ULONG:
		changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
		break;
#endif
	    case TCL_LINK_FLOAT:

		changed = !EqualDouble(LinkedVar(float), linkPtr->lastValue.f);
		break;
	    case TCL_LINK_STRING:
	    case TCL_LINK_CHARS:
	    case TCL_LINK_BINARY:
		changed = 1;
		break;
	    default:
		changed = 0;
		/* return (char *) "internal error: bad linked variable type"; */
	    }
	}
	if (changed) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	}
	return NULL;
    }
................................................................................
	/*
	 * This shouldn't ever happen.
	 */

	return (char *) "internal error: linked variable couldn't be read";
    }

    /*
     * Special cases.
     */

    switch (linkPtr->type) {
    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) 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, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
	} else {
	    linkPtr->lastValue.uc = (unsigned char) *value;
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
	}
	return NULL;
    }

    /*
     * A helper macro. Writing this as a function is messy because of type
     * variance.
     */

#define InRange(lowerLimit, value, upperLimit)			\
    ((value) >= (lowerLimit) && (value) <= (upperLimit))

    /*
     * If we're working with an array of numbers, extract the Tcl list.
     */

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
		|| objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (GetInt(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have integer values";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (GetInt(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have integer value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	break;

    case TCL_LINK_WIDE_INT:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		Tcl_WideInt *varPtr = &linkPtr->lastValue.wPtr[i];

		if (GetWide(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have wide integer value";
		}
	    }
	} else {
	    Tcl_WideInt *varPtr = &linkPtr->lastValue.w;

	    if (GetWide(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have wide integer value";
	    }
	    LinkedVar(Tcl_WideInt) = *varPtr;
	}
	break;

    case TCL_LINK_DOUBLE:





	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &linkPtr->lastValue.dPtr[i])) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *) "variable array must have real value";
		}

	    }
	} else {
	    double *varPtr = &linkPtr->lastValue.d;


	    if (GetDouble(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have real value";
	    }
	    LinkedVar(double) = *varPtr;
	}
	break;

    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have boolean value";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have boolean value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	break;

    case TCL_LINK_CHAR:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have char value";
		}
		linkPtr->lastValue.cPtr[i] = (char) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)

		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have char value";
	    }
	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
	}
	break;

    case TCL_LINK_UCHAR:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, UCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have unsigned char value";
		}
		linkPtr->lastValue.ucPtr[i] = (unsigned char) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)

		    || !InRange(0, valueInt, UCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned char value";
	    }
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc =
		    (unsigned char) valueInt;
	}
	break;

    case TCL_LINK_SHORT:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have short value";
		}
		linkPtr->lastValue.sPtr[i] = (short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)

		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have short value";
	    }
	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
	}
	break;

    case TCL_LINK_USHORT:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, USHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			"variable array must have unsigned short value";
		}
		linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)

		    || !InRange(0, valueInt, USHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned short value";
	    }
	    LinkedVar(unsigned short) = linkPtr->lastValue.us =
		    (unsigned short) valueInt;
	}
	break;

    case TCL_LINK_UINT:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(0, valueWide, UINT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned int value";
		}
		linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)

		    || !InRange(0, valueWide, UINT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned int value";
	    }
	    LinkedVar(unsigned int) = linkPtr->lastValue.ui =
		    (unsigned int) valueWide;
	}
	break;

#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have long value";
		}
		linkPtr->lastValue.lPtr[i] = (long) valueWide;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)

		    || !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have long value";
	    }
	    LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide;
	}
	break;

    case TCL_LINK_ULONG:



	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)
			|| !InRange(0, valueUWide, ULONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned long value";
		}
		linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)
		    || !InRange(0, valueUWide, ULONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned long value";
	    }
	    LinkedVar(unsigned long) = linkPtr->lastValue.ul =
		    (unsigned long) valueUWide;
	}
	break;
#endif

    case TCL_LINK_WIDE_UINT:





	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned wide int value";
		}
		linkPtr->lastValue.uwPtr[i] = valueUWide;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned wide int value";
	    }
	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = valueUWide;
	}
	break;

    case TCL_LINK_FLOAT:

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &valueDouble)
			&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		        && !IsSpecial(valueDouble)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have float value";
		}
		linkPtr->lastValue.fPtr[i] = (float) valueDouble;
	    }
	} else {
	    if (GetDouble(valueObj, &valueDouble)

		    && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		    && !IsSpecial(valueDouble)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have float value";
	    }
	    LinkedVar(float) = linkPtr->lastValue.f = (float) valueDouble;

	}







	break;

    default:
	return (char *) "internal error: bad linked variable type";
    }

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
    }
    return NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ObjValue --
................................................................................
 */

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    int i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewIntObj(linkPtr->lastValue.i);
    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.wPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.uiPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ui = LinkedVar(unsigned int);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.lPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.l = LinkedVar(long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.ulPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ul = LinkedVar(unsigned long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);



	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}
	return Tcl_NewStringObj(p, -1);

    case TCL_LINK_CHARS:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    linkPtr->lastValue.cPtr[linkPtr->bytes-1] = '\0';
	    /* take care of proper string end */
	    return Tcl_NewStringObj(linkPtr->lastValue.cPtr, linkPtr->bytes);
	}
	linkPtr->lastValue.c = '\0';
	return Tcl_NewStringObj(&linkPtr->lastValue.c, 1);

    case TCL_LINK_BINARY:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    return Tcl_NewByteArrayObj((unsigned char *) linkPtr->addr,
		    linkPtr->bytes);
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewByteArrayObj(&linkPtr->lastValue.uc, 1);

    /*
     * This code only gets executed if the link type is unknown (shouldn't
     * ever happen).
     */

    default:
	TclNewLiteralStringObj(resultObj, "??");
	return resultObj;
    }
}
 

/*
 *----------------------------------------------------------------------
 *

 * LinkFree --





 *




 *	Free's allocated space of given link and link structure.
 *

























 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *





 *----------------------------------------------------------------------
 */




static void
LinkFree(
    Link *linkPtr)		/* Structure describing linked variable. */
{







    if (linkPtr->nsPtr) {
	TclNsDecrRefCount(linkPtr->nsPtr);
    }

    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	ckfree(linkPtr->addr);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	ckfree(linkPtr->lastValue.aryPtr);
    }




































    ckfree((char *) linkPtr);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclListObj.c.

782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
....
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
....
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
....
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
	    }
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
	    ckfree(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    ListResetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
................................................................................
	 * both. Allocate a new struct and insert elements into it.
	 */

	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldPtrs = elemPtrs;
	int newMax;

	if (needGrow){
	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(NULL, newMax, NULL);
	if (listRepPtr == NULL) {
................................................................................
	    oldListRepPtr->refCount--;
	} else {
	    /*
	     * The old struct will be removed; use its inherited refCounts.
	     */

	    if (first > 0) {
		memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
	    }

	    /*
	     * "Delete" count elements starting at first.
	     */

	    for (j = first;  j < first + count;  j++) {
................................................................................
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).
     */

    if (!TclHasStringRep(objPtr) && (objPtr->typePtr == &tclDictType)) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done, size;

	/*
	 * Create the new list representation. Note that we do not need to do
	 * anything with the string representation as the transformation (and







|







 







|







 







|







 







|







782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
....
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
....
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
....
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
	    }
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
	    ckfree(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    ListResetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
................................................................................
	 * both. Allocate a new struct and insert elements into it.
	 */

	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldPtrs = elemPtrs;
	int newMax;

	if (needGrow) {
	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(NULL, newMax, NULL);
	if (listRepPtr == NULL) {
................................................................................
	    oldListRepPtr->refCount--;
	} else {
	    /*
	     * The old struct will be removed; use its inherited refCounts.
	     */

	    if (first > 0) {
		memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *));
	    }

	    /*
	     * "Delete" count elements starting at first.
	     */

	    for (j = first;  j < first + count;  j++) {
................................................................................
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).
     */

    if (!TclHasStringRep(objPtr) && TclHasIntRep(objPtr, &tclDictType)) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done, size;

	/*
	 * Create the new list representation. Note that we do not need to do
	 * anything with the string representation as the transformation (and

Changes to generic/tclLiteral.c.

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
....
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
	     */

	    int objLength;
	    char *objBytes = TclGetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
		/*
		 * A literal was found: return it
		 */

		if (newPtr) {
		    *newPtr = 0;
		}
................................................................................

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
................................................................................
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (literalObjPtr->typePtr == &tclCmdNameType) {
	    TclFreeIntRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
	Tcl_IncrRefCount(literalObjPtr);
	TclReleaseLiteral(interp, literalObjPtr);
    }
}







|







 







|







 







|







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
....
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
	     */

	    int objLength;
	    char *objBytes = TclGetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		/*
		 * A literal was found: return it
		 */

		if (newPtr) {
		    *newPtr = 0;
		}
................................................................................

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
................................................................................
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (TclHasIntRep(literalObjPtr, &tclCmdNameType)) {
	    TclFreeIntRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
	Tcl_IncrRefCount(literalObjPtr);
	TclReleaseLiteral(interp, literalObjPtr);
    }
}

Changes to generic/tclLoad.c.

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	 * Create a new record to describe this package.
	 */

	pkgPtr = ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = ckalloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = ckalloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));







|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
	 * Create a new record to describe this package.
	 */

	pkgPtr = ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = ckalloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = ckalloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));

Changes to generic/tclMain.c.

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71






72

73
74
75
76
77
78
79
80
81
82

/*
 * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
 * NewNativeObj is needed (which provides proper conversion from native
 * encoding to UTF-8).
 */

#ifdef UNICODE
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE */
static inline Tcl_Obj *
NewNativeObj(
    char *string,
    int length)
{
    Tcl_DString ds;







    Tcl_ExternalToUtfDString(NULL, string, length, &ds);

    return TclDStringToObj(&ds);
}
#endif /* !UNICODE */

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








|

|


|




>
>
>
>
>
>
|
>


|







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

/*
 * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
 * NewNativeObj is needed (which provides proper conversion from native
 * encoding to UTF-8).
 */

#if defined(UNICODE) && (TCL_UTF_MAX <= 4)
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE || (TCL_UTF_MAX > 4) */
static inline Tcl_Obj *
NewNativeObj(
    TCHAR *string,
    int length)
{
    Tcl_DString ds;

#ifdef UNICODE
    if (length > 0) {
	length *= sizeof(WCHAR);
    }
    Tcl_WinTCharToUtf(string, length, &ds);
#else
    Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
#endif
    return TclDStringToObj(&ds);
}
#endif /* !UNICODE || (TCL_UTF_MAX > 4) */

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

Changes to generic/tclNamesp.c.

872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
....
1082
1083
1084
1085
1086
1087
1088







1089
1090
1091
1092
1093
1094
1095
....
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = ckalloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
     * If compilation of commands originating from the parent NS is
................................................................................
	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}







 
/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
 *	Used internally to dismantle and unlink a namespace when it is
................................................................................

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = ckalloc(len + 1);
    memcpy(patternCpy, pattern, (unsigned) len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
     * changed (probably will have!) However, we do not need to recompute this







|







 







>
>
>
>
>
>
>







 







|







872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
....
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
....
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = ckalloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
     * If compilation of commands originating from the parent NS is
................................................................................
	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}

int
TclNamespaceDeleted(
    Namespace *nsPtr)
{
    return (nsPtr->flags & NS_DYING) ? 1 : 0;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
 *	Used internally to dismantle and unlink a namespace when it is
................................................................................

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = ckalloc(len + 1);
    memcpy(patternCpy, pattern, len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
     * changed (probably will have!) However, we do not need to recompute this

Changes to generic/tclOO.c.

342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
...
870
871
872
873
874
875
876

877


878
879
880

881
882
883
884
885
886
887
...
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
...
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
....
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
....
1146
1147
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
....
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
....
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
....
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
....
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
....
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
....
1970
1971
1972
1973
1974
1975
1976


1977


1978
1979
1980
1981
1982
1983
1984
....
2008
2009
2010
2011
2012
2013
2014

2015
2016
2017
2018
2019
2020
2021
....
2071
2072
2073
2074
2075
2076
2077

2078
2079
2080

2081
2082
2083
2084
2085
2086
2087
....
2117
2118
2119
2120
2121
2122
2123


2124


2125
2126
2127
2128
2129
2130
2131
....
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
....
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i=0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i=0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

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

    InitClassSystemRoots(interp, fPtr);

    /*
     * Basic method declarations for the core classes.
     */

    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
     */
................................................................................
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }


  configNamespace:

    ((Namespace *)oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

    if (fPtr->helpersNs != NULL) {
................................................................................

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {

	    mixinSubclassPtr = clsPtr->mixinSubs.list[clsPtr->mixinSubs.num-1];


	    /* This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */

	    if (!Deleted(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
................................................................................

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
................................................................................

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];

	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
................................................................................
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;

    if (Deleted(oPtr)) {
	/*
	 * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
	 * guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;


    /* Let the dominoes fall */


    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
................................................................................
     * of it have gone. [Bug 2949397]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
	int result;

	Tcl_InterpState state;

	oPtr->flags |= DESTRUCTOR_CALLED;

	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
................................................................................
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if
     * it still exists) because otherwise its pointer to the object
     * points into freed memory.
     */

    if (((Command *)oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
................................................................................
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    /*
     * TODO: Should this be protected with a * !IsRoot() condition?
     */

    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
................................................................................
     */

    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

 
Object *
TclNewObjectInstanceCommon(
    Tcl_Interp *interp,
    Class *classPtr,
    const char *nameStr,
    const char *nsNameStr)
................................................................................
{
    Tcl_HashEntry *hPtr;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    const char *simpleName = NULL;
    Namespace *nsPtr = NULL, *dummy;
    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    int isNew;

    if (nameStr) {
	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	    return NULL;
	}

	/*
	 * We could make a hash entry! Don't actually want to do that here so
	 * nuke it immediately because we'll create it properly soon.
	 */

	Tcl_DeleteHashEntry(hPtr);
    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
................................................................................
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}
 


static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
................................................................................
	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}


	/* For the reference just created in DUPLICATE */


	AddRef(mixinPtr->thisPtr);
    }

    /*
     * Copy the object's filter list to the new object.
     */

................................................................................
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;
................................................................................
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);


	    /* For the new item in cls2Ptr->superclasses that memcpy just
	     * created
	     */

	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

................................................................................
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);


	    /* For the copy just created in DUPLICATE */


	    AddRef(mixinPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's methods, constructor and destructor.
	 */

................................................................................
    int skip)
{
    CallContext *contextPtr = (CallContext *) context;
    int savedIndex = contextPtr->index;
    int savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

................................................................................
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv,
    int skip)
{
    register CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */








|






|







 







|


|











|







 







<

<
|







 







>
|
>
>
|


>







 







|







 







|
>







 







|
|













>
|
>
>







 







<

>







 







|
|
|


|







 







<
|
<
<







 







<







 







<









|
|






<
<
<
<
<
<
<







 







<
<







 







>
>
|
>
>







 







>







 







>
|
|

>







 







>
>
|
>
>







 







|







 







|







342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
663
664
665
666
667
668
669

670

671
672
673
674
675
676
677
678
...
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
...
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
...
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
....
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
....
1152
1153
1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166
1167
....
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
....
1203
1204
1205
1206
1207
1208
1209

1210


1211
1212
1213
1214
1215
1216
1217
....
1764
1765
1766
1767
1768
1769
1770

1771
1772
1773
1774
1775
1776
1777
....
1778
1779
1780
1781
1782
1783
1784

1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801







1802
1803
1804
1805
1806
1807
1808
....
1827
1828
1829
1830
1831
1832
1833


1834
1835
1836
1837
1838
1839
1840
....
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
....
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
....
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
....
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
....
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
....
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i = 0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i = 0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

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

    InitClassSystemRoots(interp, fPtr);

    /*
     * Basic method declarations for the core classes.
     */

    for (i = 0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i = 0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
     */
................................................................................
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }


  configNamespace:

    ((Namespace *) oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

    if (fPtr->helpersNs != NULL) {
................................................................................

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr =
		    clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1];

	    /*
	     * This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */

	    if (!Deleted(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
................................................................................

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
................................................................................

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1];

	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
................................................................................
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;

    if (Deleted(oPtr)) {
	/*
	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
	 * this guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;

    /*
     * Let the dominoes fall!
     */

    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
................................................................................
     * of it have gone. [Bug 2949397]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
	int result;

	Tcl_InterpState state;

	oPtr->flags |= DESTRUCTOR_CALLED;

	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
................................................................................
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if it
     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
................................................................................
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */


    /* TODO: Should this be protected with a !IsRoot() condition? */


    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
................................................................................
     */

    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

 
Object *
TclNewObjectInstanceCommon(
    Tcl_Interp *interp,
    Class *classPtr,
    const char *nameStr,
    const char *nsNameStr)
................................................................................
{
    Tcl_HashEntry *hPtr;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    const char *simpleName = NULL;
    Namespace *nsPtr = NULL, *dummy;
    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);


    if (nameStr) {
	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
	if (hPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	    return NULL;
	}







    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
................................................................................
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}
 


static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
................................................................................
	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}

	/*
	 * For the reference just created in DUPLICATE.
	 */

	AddRef(mixinPtr->thisPtr);
    }

    /*
     * Copy the object's filter list to the new object.
     */

................................................................................
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;
................................................................................
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

	    /*
	     * For the new item in cls2Ptr->superclasses that memcpy just
	     * created.
	     */

	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

................................................................................
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);

	    /*
	     * For the copy just created in DUPLICATE.
	     */

	    AddRef(mixinPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's methods, constructor and destructor.
	 */

................................................................................
    int skip)
{
    CallContext *contextPtr = (CallContext *) context;
    int savedIndex = contextPtr->index;
    int savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

................................................................................
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv,
    int skip)
{
    register CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

Changes to generic/tclOOCall.c.

324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
...
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643

644


645
646
647
648
649
650
651
....
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
....
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	int i;

	for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when
	 * we're doing unknown processing.
	 */
................................................................................
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    int i;

    for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}
 
/*
 * ----------------------------------------------------------------------
................................................................................
     * Note that 'i' may well be less than names.numEntries when we are
     * dealing with public method names. We don't sort unless there's at least
     * two method names.
     */

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    return i;
}


/* Comparator for SortMethodNames */


static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;
................................................................................
    }

    /*
     * First test whether the method is already in the call chain. Skip over
     * any leading filters.
     */

    for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) {
	if (callPtr->chain[i].mPtr == mPtr &&
		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
	    /*
	     * Call chain semantics states that methods come as *late* in the
	     * call chain as possible. This is done by copying down the
	     * following methods. Note that this does not change the number of
	     * method invocations in the call chain; it just rearranges them.
	     */

	    Class *declCls = callPtr->chain[i].filterDeclarer;

	    for (; i+1<callPtr->numChain ; i++) {
		callPtr->chain[i] = callPtr->chain[i+1];
	    }
	    callPtr->chain[i].mPtr = mPtr;
	    callPtr->chain[i].isFilter = (doneFilters != NULL);
	    callPtr->chain[i].filterDeclarer = declCls;
	    return;
	}
    }
................................................................................
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i=0 ; i<callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;







|







 







|







 







|









>
|
>
>







 







|











|
|







 







|







324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
...
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
...
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
....
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
....
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	int i;

	for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when
	 * we're doing unknown processing.
	 */
................................................................................
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    int i;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}
 
/*
 * ----------------------------------------------------------------------
................................................................................
     * Note that 'i' may well be less than names.numEntries when we are
     * dealing with public method names. We don't sort unless there's at least
     * two method names.
     */

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    return i;
}

/*
 * Comparator for SortMethodNames
 */

static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;
................................................................................
    }

    /*
     * First test whether the method is already in the call chain. Skip over
     * any leading filters.
     */

    for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
	if (callPtr->chain[i].mPtr == mPtr &&
		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
	    /*
	     * Call chain semantics states that methods come as *late* in the
	     * call chain as possible. This is done by copying down the
	     * following methods. Note that this does not change the number of
	     * method invocations in the call chain; it just rearranges them.
	     */

	    Class *declCls = callPtr->chain[i].filterDeclarer;

	    for (; i + 1 < callPtr->numChain ; i++) {
		callPtr->chain[i] = callPtr->chain[i + 1];
	    }
	    callPtr->chain[i].mPtr = mPtr;
	    callPtr->chain[i].isFilter = (doneFilters != NULL);
	    callPtr->chain[i].filterDeclarer = declCls;
	    return;
	}
    }
................................................................................
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;

Changes to generic/tclOODefineCmds.c.

45
46
47
48
49
50
51






52
53
54
55
56
57
58
...
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
...
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
...
396
397
398
399
400
401
402


403


404
405
406
407
408
409
410
...
448
449
450
451
452
453
454


455


456
457
458
459
460
461
462
...
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
....
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
....
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
....
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
....
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
....
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
....
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
....
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
....
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
....
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
....
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
....
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
....
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
....
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
....
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
....
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
....
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
....
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}







/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
................................................................................
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(oPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
................................................................................
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(classPtr->filters.list, size);
	}
	for (i=0 ; i<numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;
    }

................................................................................
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);


		/* For the new copy created by memcpy */


		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    oPtr->epoch++;
}
 
................................................................................
	} else {
	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);


	    /* For the new copy created by memcpy */


	    AddRef(mixinPtr->thisPtr);
	}
    }
    BumpGlobalEpoch(interp, classPtr);
}
 
/*
................................................................................
    }

    if (matchedStr != NULL) {
	/*
	 * Got one match, and only one match!
	 */


	Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
	int result;

	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
	Tcl_IncrRefCount(newObjv[0]);
	if (objc > 2) {
	    memcpy(newObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc-2));
	}
	result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
	Tcl_DecrRefCount(newObjv[0]);
	TclStackFree(interp, newObjv);
	return result;
    }

  noMatch:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
................................................................................
     * comments above for why these contortions are necessary.
     */

    objPtr = Tcl_NewObj();
    obj2Ptr = Tcl_NewObj();
    cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
    if (cmd == NULL) {

	/* punt this case! */


	Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
    } else {
	Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
    }
    Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
    /* TODO: overflow? */
    Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-offset, objv+offset);
    Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);

    result = Tcl_EvalObjv(interp, objc-cmdIndex, objs, TCL_EVAL_INVOKE);
    if (isRoot) {
	TclResetRewriteEnsemble(interp, 1);
    }
    Tcl_DecrRefCount(objPtr);

    return result;
}
................................................................................
    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Delete the method structure from the appropriate hash table.
	 */

	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
		objv[i], NULL) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (!isInstanceExport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
	 * record. If there is no such method in this object or class (i.e.
	 * the method comes from something inherited from or that we're an
	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
................................................................................
    }
    if (!isInstanceForward && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method structure.
     */

    prefixObj = Tcl_NewListObj(objc-2, objv+2);
    if (isInstanceForward) {
	mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
		prefixObj);
    } else {
	mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
		objv[1], prefixObj);
    }
................................................................................
	    isPublic = 0;
	    break;
	}
    } else {
	if (IsPrivateDefine(interp)) {
	    isPublic = TRUE_PRIVATE_METHOD;
	} else {
	    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
		    ? PUBLIC_METHOD : 0;
	}
    }

    /*
     * Create the method by using the right back-end API.
     */
................................................................................
    if (!isInstanceUnexport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	/*
	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
	 * method record. If there is no such method in this object or class
	 * (i.e. the method comes from something inherited from or that we're
	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
    } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i=0 ; i<mixinc ; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    i--;
	    goto freeAndError;
	}
	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int superc, i, j;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
    } else {
	for (i=0 ; i<superc ; i++) {
	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
		    "only a class can be a superclass");
	    if (superclasses[i] == NULL) {
		i--;
		goto failedAfterAlloc;
	    }
	    for (j=0 ; j<i ; j++) {
		if (superclasses[j] == superclasses[i]) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "class should only be a direct superclass once",
			    -1));
		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
		    goto failedAfterAlloc;
		}
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
................................................................................
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
................................................................................
    if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i=0 ; i<mixinc ; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    TclStackFree(interp, mixins);
	    return TCL_ERROR;
	}
    }
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);







>
>
>
>
>
>







 







|







 







|







 







>
>
|
>
>







 







>
>
|
>
>







 







>
|





|

|







 







>
|
>
>






|


|







 







|







 







|







 







|









|







 







|







 







|







 







|







 







|







 







|







 







|







 







|






|







 







|







 







|







 







|







 







|







 







|







 







|












|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
...
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
...
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
...
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
...
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
...
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
....
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
....
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
....
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
....
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
....
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
....
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
....
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
....
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
....
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
....
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
....
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
....
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
....
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
....
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
....
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
....
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
....
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}

/*
 * A [string match] pattern used to determine if a method should be exported.
 */

#define PUBLIC_PATTERN		"[a-z]*"

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
................................................................................
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(oPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
................................................................................
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	} else {
	    filtersList = ckrealloc(classPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;
    }

................................................................................
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);

		/*
		 * For the new copy created by memcpy().
		 */

		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    oPtr->epoch++;
}
 
................................................................................
	} else {
	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);

	    /*
	     * For the new copy created by memcpy.
	     */

	    AddRef(mixinPtr->thisPtr);
	}
    }
    BumpGlobalEpoch(interp, classPtr);
}
 
/*
................................................................................
    }

    if (matchedStr != NULL) {
	/*
	 * Got one match, and only one match!
	 */

	Tcl_Obj **newObjv =
		TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1));
	int result;

	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
	Tcl_IncrRefCount(newObjv[0]);
	if (objc > 2) {
	    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
	}
	result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);
	Tcl_DecrRefCount(newObjv[0]);
	TclStackFree(interp, newObjv);
	return result;
    }

  noMatch:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
................................................................................
     * comments above for why these contortions are necessary.
     */

    objPtr = Tcl_NewObj();
    obj2Ptr = Tcl_NewObj();
    cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
    if (cmd == NULL) {
	/*
	 * Punt this case!
	 */

	Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
    } else {
	Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
    }
    Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
    /* TODO: overflow? */
    Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
    Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);

    result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
    if (isRoot) {
	TclResetRewriteEnsemble(interp, 1);
    }
    Tcl_DecrRefCount(objPtr);

    return result;
}
................................................................................
    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Delete the method structure from the appropriate hash table.
	 */

	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
		objv[i], NULL) != TCL_OK) {
	    return TCL_ERROR;
................................................................................
    if (!isInstanceExport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
	 * record. If there is no such method in this object or class (i.e.
	 * the method comes from something inherited from or that we're an
	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
................................................................................
    }
    if (!isInstanceForward && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method structure.
     */

    prefixObj = Tcl_NewListObj(objc - 2, objv + 2);
    if (isInstanceForward) {
	mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
		prefixObj);
    } else {
	mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
		objv[1], prefixObj);
    }
................................................................................
	    isPublic = 0;
	    break;
	}
    } else {
	if (IsPrivateDefine(interp)) {
	    isPublic = TRUE_PRIVATE_METHOD;
	} else {
	    isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
		    ? PUBLIC_METHOD : 0;
	}
    }

    /*
     * Create the method by using the right back-end API.
     */
................................................................................
    if (!isInstanceUnexport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
	 * method record. If there is no such method in this object or class
	 * (i.e. the method comes from something inherited from or that we're
	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
    } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i = 0; i < mixinc; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    i--;
	    goto freeAndError;
	}
	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int superc, i, j;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
    } else {
	for (i = 0; i < superc; i++) {
	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
		    "only a class can be a superclass");
	    if (superclasses[i] == NULL) {
		i--;
		goto failedAfterAlloc;
	    }
	    for (j = 0; j < i; j++) {
		if (superclasses[j] == superclasses[i]) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "class should only be a direct superclass once",
			    -1));
		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
		    goto failedAfterAlloc;
		}
................................................................................
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
................................................................................
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i = 0; i < varc; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
................................................................................
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
................................................................................
    if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i = 0; i < mixinc; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    TclStackFree(interp, mixins);
	    return TCL_ERROR;
	}
    }
................................................................................
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i = 0; i < varc; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);

Changes to generic/tclObj.c.

187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
....
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
....
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039

3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
....
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283

3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
....
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
....
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
....
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
....
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
....
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743



3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
....
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
	    mp_shrink(&(bignum));                                       \
	}                                                               \
	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used));            \
    }

#define UNPACK_BIGNUM(objPtr, bignum) \
    if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
	(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
    } else {                                                            \
	(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1;          \
	(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
	(bignum).alloc =                                                \
		(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
	(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
    }

/*
 * Prototypes for functions defined later in this file:
 */

static int		ParseBoolean(Tcl_Obj *objPtr);
static int		SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	    return TCL_OK;
	}
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
    return TCL_ERROR;
}
 
................................................................................
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
		    / DIGIT_BIT) {
		unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
		unsigned char *bytes = (unsigned char *) &scratch;


		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + (unsigned long)LONG_MAX) {
			    *longPtr = - (long) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (unsigned long)ULONG_MAX) {
			    *longPtr = (long) value;
			    return TCL_OK;
			}
		    }
		}
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
................................................................................
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t) big.used <= (CHAR_BIT * sizeof(Tcl_WideInt)
		     + DIGIT_BIT - 1) / DIGIT_BIT) {
		Tcl_WideUInt value = 0;
		unsigned long numBytes = sizeof(Tcl_WideInt);
		Tcl_WideInt scratch;
		unsigned char *bytes = (unsigned char *) &scratch;


		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (big.sign) {
			if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			    *wideIntPtr = - (Tcl_WideInt) value;
			    return TCL_OK;
			}
		    } else {
			if (value <= (Tcl_WideUInt)WIDE_MAX) {
			    *wideIntPtr = (Tcl_WideInt) value;
			    return TCL_OK;
			}
		    }
		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

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

static void
FreeBignum(
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}
 
................................................................................
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    mp_int bignumVal;
    mp_int bignumCopy;

    copyPtr->typePtr = &tclBignumType;
    UNPACK_BIGNUM(srcPtr, bignumVal);
    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
	Tcl_Panic("initialization failure in DupBignum");
    }
    PACK_BIGNUM(bignumCopy, copyPtr);
}
 
/*
................................................................................
UpdateStringOfBignum(
    Tcl_Obj *objPtr)
{
    mp_int bignumVal;
    int size;
    char *stringVal;

    UNPACK_BIGNUM(objPtr, bignumVal);
    if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
	Tcl_Panic("radix size failure in UpdateStringOfBignum");
    }
    if (size < 2) {
	/*
	 * mp_radix_size() returns < 2 when more than INT_MAX bytes would be
	 * needed to hold the string rep (because mp_radix_size ignores
................................................................................
    mp_int *bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {
	    if (copy || Tcl_IsShared(objPtr)) {
		mp_int temp;

		UNPACK_BIGNUM(objPtr, temp);
		mp_init_copy(bignumValue, &temp);
	    } else {
		UNPACK_BIGNUM(objPtr, *bignumValue);
		/* Optimized TclFreeIntRep */
		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
................................................................................
 */

void
Tcl_SetBignumObj(
    Tcl_Obj *objPtr,		/* Object to set */
    mp_int *bignumValue)	/* Value to store */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
    }
    if ((size_t) bignumValue->used
	    <= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
	Tcl_WideUInt value = 0;
	unsigned long numBytes = sizeof(Tcl_WideUInt);
	Tcl_WideUInt scratch;
	unsigned char *bytes = (unsigned char *) &scratch;




	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForWide;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	    goto tooLargeForWide;
	}
	if (bignumValue->sign) {
	    TclSetIntObj(objPtr, -(Tcl_WideInt)value);
	} else {
	    TclSetIntObj(objPtr, (Tcl_WideInt)value);
	}
	mp_clear(bignumValue);
	return;
    }
  tooLargeForWide:
    TclInvalidateStringRep(objPtr);
    TclFreeIntRep(objPtr);
    TclSetBignumIntRep(objPtr, bignumValue);
}
 
/*
................................................................................
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));

	    UNPACK_BIGNUM(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==
	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
    return TCL_ERROR;







<
<
<
<
<
<
<
<
<
<
<







 







|







 







<
<
<
<
|
|

>
|
|

|
|
|
|
|
|
|
|
|
|
<







 







<
<
<
<
|
|
|
|

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







 







|







 







|







 







|







 







|


|







 







<
<
<
<
<
|
|
|
|

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







 







|







187
188
189
190
191
192
193











194
195
196
197
198
199
200
....
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
....
3015
3016
3017
3018
3019
3020
3021




3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038

3039
3040
3041
3042
3043
3044
3045
....
3253
3254
3255
3256
3257
3258
3259




3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278

3279
3280
3281
3282
3283
3284
3285
....
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
....
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
....
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
....
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
....
3708
3709
3710
3711
3712
3713
3714





3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738

3739
3740
3741
3742
3743
3744
3745
....
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
	    mp_shrink(&(bignum));                                       \
	}                                                               \
	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used));            \
    }












/*
 * Prototypes for functions defined later in this file:
 */

static int		ParseBoolean(Tcl_Obj *objPtr);
static int		SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
................................................................................
	if (objPtr->typePtr == &tclIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;

	    TclUnpackBignum(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	    return TCL_OK;
	}
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
    return TCL_ERROR;
}
 
................................................................................
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;




	    unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    if (value <= 1 + (unsigned long)LONG_MAX) {
			*longPtr = - (long) value;
			return TCL_OK;
		    }
		} else {
		    if (value <= (unsigned long)ULONG_MAX) {
			*longPtr = (long) value;
			return TCL_OK;

		    }
		}
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
................................................................................
	if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;




	    Tcl_WideUInt value = 0;
	    unsigned long numBytes = sizeof(Tcl_WideInt);
	    Tcl_WideInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			*wideIntPtr = - (Tcl_WideInt) value;
			return TCL_OK;
		    }
		} else {
		    if (value <= (Tcl_WideUInt)WIDE_MAX) {
			*wideIntPtr = (Tcl_WideInt) value;
			return TCL_OK;

		    }
		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

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

static void
FreeBignum(
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    TclUnpackBignum(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
    }
    objPtr->typePtr = NULL;
}
 
................................................................................
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    mp_int bignumVal;
    mp_int bignumCopy;

    copyPtr->typePtr = &tclBignumType;
    TclUnpackBignum(srcPtr, bignumVal);
    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
	Tcl_Panic("initialization failure in DupBignum");
    }
    PACK_BIGNUM(bignumCopy, copyPtr);
}
 
/*
................................................................................
UpdateStringOfBignum(
    Tcl_Obj *objPtr)
{
    mp_int bignumVal;
    int size;
    char *stringVal;

    TclUnpackBignum(objPtr, bignumVal);
    if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
	Tcl_Panic("radix size failure in UpdateStringOfBignum");
    }
    if (size < 2) {
	/*
	 * mp_radix_size() returns < 2 when more than INT_MAX bytes would be
	 * needed to hold the string rep (because mp_radix_size ignores
................................................................................
    mp_int *bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {
	    if (copy || Tcl_IsShared(objPtr)) {
		mp_int temp;

		TclUnpackBignum(objPtr, temp);
		mp_init_copy(bignumValue, &temp);
	    } else {
		TclUnpackBignum(objPtr, *bignumValue);
		/* Optimized TclFreeIntRep */
		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
................................................................................
 */

void
Tcl_SetBignumObj(
    Tcl_Obj *objPtr,		/* Object to set */
    mp_int *bignumValue)	/* Value to store */
{





    Tcl_WideUInt value = 0;
    unsigned long numBytes = sizeof(Tcl_WideUInt);
    Tcl_WideUInt scratch;
    unsigned char *bytes = (unsigned char *) &scratch;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
    }
    if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	goto tooLargeForWide;
    }
    while (numBytes-- > 0) {
	value = (value << CHAR_BIT) | *bytes++;
    }
    if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	goto tooLargeForWide;
    }
    if (bignumValue->sign) {
	TclSetIntObj(objPtr, -(Tcl_WideInt)value);
    } else {
	TclSetIntObj(objPtr, (Tcl_WideInt)value);
    }
    mp_clear(bignumValue);
    return;

  tooLargeForWide:
    TclInvalidateStringRep(objPtr);
    TclFreeIntRep(objPtr);
    TclSetBignumIntRep(objPtr, bignumValue);
}
 
/*
................................................................................
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));

	    TclUnpackBignum(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==
	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
    return TCL_ERROR;

Changes to generic/tclParse.c.

787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
...
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
....
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
				 * written. At most TCL_UTF_MAX bytes will be
				 * written there. */
{
    register const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    int count;
    char buf[TCL_UTF_MAX];

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
    }
................................................................................
	 */

	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
	    count = TclUtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, p, (size_t) (numBytes - 1));
	    utfBytes[numBytes - 1] = '\0';
	    count = TclUtfToUniChar(utfBytes, &unichar) + 1;
	}
	result = unichar;
	break;
    }

  done:
    if (readPtr != NULL) {
	*readPtr = count;
    }
    count = Tcl_UniCharToUtf(result, dst);
    if (!count) {
	/* Special case for handling high surrogates. */
	count = Tcl_UniCharToUtf(-1, dst);
    }
    return count;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;
	int appendByteLength = 0;
	char utfCharBytes[TCL_UTF_MAX];

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    append = tokenPtr->start;
	    appendByteLength = tokenPtr->size;
	    break;








|







 







|












|

|







 







|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
...
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
....
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
				 * written. At most TCL_UTF_MAX bytes will be
				 * written there. */
{
    register const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    int count;
    char buf[4] = "";

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
    }
................................................................................
	 */

	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
	    count = TclUtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
	} else {
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, p, numBytes - 1);
	    utfBytes[numBytes - 1] = '\0';
	    count = TclUtfToUniChar(utfBytes, &unichar) + 1;
	}
	result = unichar;
	break;
    }

  done:
    if (readPtr != NULL) {
	*readPtr = count;
    }
    count = Tcl_UniCharToUtf(result, dst);
    if ((result >= 0xD800) && (count < 3)) {
	/* Special case for handling high surrogates. */
	count += Tcl_UniCharToUtf(-1, dst + count);
    }
    return count;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;
	int appendByteLength = 0;
	char utfCharBytes[4] = "";

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    append = tokenPtr->start;
	    appendByteLength = tokenPtr->size;
	    break;

Changes to generic/tclPathObj.c.

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
....
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
....
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493
....
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
....
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092

2093
2094
2095
2096
2097
2098
2099
....
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
....
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255

2256
2257
2258
2259
2260
2261
2262
....
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577

Tcl_Obj *
TclPathPart(
    Tcl_Interp *interp,		/* Used for error reporting */
    Tcl_Obj *pathPtr,		/* Path to take dirname of */
    Tcl_PathPart portion)	/* Requested portion of name */
{
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0) {
	    switch (portion) {
	    case TCL_PATH_DIRNAME: {
		/*
		 * Check if the joined-on bit has any directory delimiters in
................................................................................
int
Tcl_FSConvertToPathType(
    Tcl_Interp *interp,		/* Interpreter in which to store error message
				 * (if necessary). */
    Tcl_Obj *pathPtr)		/* Object to convert to a valid, current path
				 * type. */
{
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    /*
     * While it is bad practice to examine an object's type directly, this is
     * actually the best thing to do here. The reason is that if we are
     * converting this object to FsPath type for the first time, we don't need
     * to worry whether the 'cwd' has changed. On the other hand, if this
     * object is already of FsPath type, and is a relative path, we do have to
     * worry about the cwd. If the cwd has changed, we must recompute the
     * path.
     */

    if (irPtr) {
	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
	    return TCL_OK;
	}

	TclGetString(pathPtr);
	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    }
................................................................................

static int
MakePathFromNormalized(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {

	return TCL_OK;
    }

    fsPathPtr = ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
................................................................................
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);

	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;
}
 
................................................................................

int
TclFSEnsureEpochOk(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **fsPtrPtr)
{
    FsPath *srcFsPathPtr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr == NULL) {

	return TCL_OK;
    }

    srcFsPathPtr = PATHOBJ(pathPtr);

    /*
     * Check if the filesystem has changed in some way since this object's
................................................................................
void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    ClientData clientData)
{
    FsPath *srcFsPathPtr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);;

    /*
     * Make sure pathPtr is of the correct type.
     */

    if (irPtr == NULL) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
................................................................................
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {

	return TCL_OK;
    }

    /*
     * First step is to translate the filename. This is similar to
     * Tcl_TranslateFilename, but shouldn't convert everything to windows
     * backslashes on that platform. The current implementation of this piece
................................................................................
 */

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    ClientData *clientDataPtr)
{
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */

    if (irPtr) {
	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}







|
<
<







 







<
<










|







 







<

<
>







 







|







 







<

<
>







 







<





|







 







<

<
>







 







<
<







|







556
557
558
559
560
561
562
563


564
565
566
567
568
569
570
....
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
....
1473
1474
1475
1476
1477
1478
1479

1480

1481
1482
1483
1484
1485
1486
1487
1488
....
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
....
2078
2079
2080
2081
2082
2083
2084

2085

2086
2087
2088
2089
2090
2091
2092
2093
....
2136
2137
2138
2139
2140
2141
2142

2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
....
2239
2240
2241
2242
2243
2244
2245

2246

2247
2248
2249
2250
2251
2252
2253
2254
....
2546
2547
2548
2549
2550
2551
2552


2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567

Tcl_Obj *
TclPathPart(
    Tcl_Interp *interp,		/* Used for error reporting */
    Tcl_Obj *pathPtr,		/* Path to take dirname of */
    Tcl_PathPart portion)	/* Requested portion of name */
{
    if (TclHasIntRep(pathPtr, &fsPathType)) {


	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0) {
	    switch (portion) {
	    case TCL_PATH_DIRNAME: {
		/*
		 * Check if the joined-on bit has any directory delimiters in
................................................................................
int
Tcl_FSConvertToPathType(
    Tcl_Interp *interp,		/* Interpreter in which to store error message
				 * (if necessary). */
    Tcl_Obj *pathPtr)		/* Object to convert to a valid, current path
				 * type. */
{


    /*
     * While it is bad practice to examine an object's type directly, this is
     * actually the best thing to do here. The reason is that if we are
     * converting this object to FsPath type for the first time, we don't need
     * to worry whether the 'cwd' has changed. On the other hand, if this
     * object is already of FsPath type, and is a relative path, we do have to
     * worry about the cwd. If the cwd has changed, we must recompute the
     * path.
     */

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
	    return TCL_OK;
	}

	TclGetString(pathPtr);
	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    }
................................................................................

static int
MakePathFromNormalized(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;



    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    fsPathPtr = ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
................................................................................
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;
}
 
................................................................................

int
TclFSEnsureEpochOk(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **fsPtrPtr)
{
    FsPath *srcFsPathPtr;



    if (!TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    srcFsPathPtr = PATHOBJ(pathPtr);

    /*
     * Check if the filesystem has changed in some way since this object's
................................................................................
void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    ClientData clientData)
{
    FsPath *srcFsPathPtr;


    /*
     * Make sure pathPtr is of the correct type.
     */

    if (!TclHasIntRep(pathPtr, &fsPathType)) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
................................................................................
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;



    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    /*
     * First step is to translate the filename. This is similar to
     * Tcl_TranslateFilename, but shouldn't convert everything to windows
     * backslashes on that platform. The current implementation of this piece
................................................................................
 */

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    ClientData *clientDataPtr)
{


    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}

Changes to generic/tclPipe.c.

329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
	 * Make sure we start at the beginning of the file.
	 */

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count < 0) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(







|







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
	 * Make sure we start at the beginning of the file.
	 */

	if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count < 0) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(

Changes to generic/tclPkg.c.

34
35
36
37
38
39
40
41

42
43
44
45
46

47

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176
177
178
179
180
181
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
...
219
220
221
222
223
224
225


226
227
228
229
230
231
232
233
234

235
236
237
238
239
240

241
242
243
244
245
246
247
248


249
250

251


252

253
254
255
256
257
258
259
260
261



262
263

264

265
266
267
268
269
270
271
...
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
...
414
415
416
417
418
419
420

421
422
423

424
425
426
427
428
429
430
431

432


433

434
435
436
437


438

439
440
441
442
443
444

445
446
447
448
449
450
451
452
453

454

455

456
457
458
459
460
461
462




463
464
465
466
467
468






469





470
471
472
473
474
475
476





477
478







479
480
481
482
483

484
485
486

487
488
489
490
491
492
493
494
495
496
497
498
499




500
501
502
503

504
505
506
507
508
509
510
511
512
513
514
515


516


517

518

519
520
521
522
523




524
525
526
527
528
529

530
531
532
533
534
535
536
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569




570
571
572
573
574
575


576


577
578
579
580
581
582
583
...
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627

628



629
630
631
632
633
634
635
...
643
644
645
646
647
648
649

650
651
652
653
654
655

656

657
658
659
660
661
662
663
...
670
671
672
673
674
675
676
677
678
679

680
681
682
683
684
685

686



687
688

689
690
691
692
693
694
695
...
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
...
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
...
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
...
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
851
....
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
1026
....
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
....
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
....
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
....
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
....
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
....
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
....
1420
1421
1422
1423
1424
1425
1426
1427




1428
1429
1430
1431
1432
1433
1434
1435
1436
....
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
				 * Tcl_Preserve and Tcl_Release. */
    char *pkgIndex;		/* Full file name of pkgIndex file */
    struct PkgAvail *nextPtr;	/* Next in list of available versions of the
				 * same package. */
} PkgAvail;

typedef struct PkgName {
    struct PkgName *nextPtr;	/* Next in list of package names being initialized. */

    char name[1];
} PkgName;

typedef struct PkgFiles {
    PkgName *names;		/* Package names being initialized. Must be first field*/

    Tcl_HashTable table;	/* Table which contains files for each package */

} PkgFiles;


/*
 * For each package that is known in any way to an interpreter, there is one
 * record of the following type. These records are stored in the
 * "packageTable" hash table in the interpreter, keyed by package name such as
 * "Tk" (no version number).
 */

typedef struct Package {
    char *version;		/* Version that has been supplied in this
				 * interpreter via "package provide"
				 * (malloc'ed). NULL means the package doesn't
				 * exist in this interpreter yet. */
    PkgAvail *availPtr;		/* First in list of all available versions of
				 * this package. */
    const void *clientData;	/* Client data. */
} Package;

typedef struct Require {
    void * clientDataPtr;
    const char *name;
    Package *pkgPtr;
    char *versionToProvide;
} Require;

typedef struct RequireProcArgs {
    const char *name;
................................................................................
{
    Package *pkgPtr;
    char *pvi, *vi;
    int res;

    pkgPtr = FindPackage(interp, name);
    if (pkgPtr->version == NULL) {

	DupString(pkgPtr->version, version);
	pkgPtr->clientData = clientData;
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	ckfree(pvi);
	return TCL_ERROR;
    }

................................................................................
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "conflicting versions provided for package \"%s\": %s, then %s",
	    name, pkgPtr->version, version));
    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 * Side effects:
 *	The script from some previous "package ifneeded" command may be
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */



static void PkgFilesCleanupProc(ClientData clientData,
    			    Tcl_Interp *interp)
{
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;

	pkgFiles->names = name->nextPtr;
	ckfree(name);
    }
    entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
    while (entry) {
	Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);

	Tcl_DecrRefCount(obj);
	entry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&pkgFiles->table);
    ckfree(pkgFiles);
    return;
}



void *TclInitPkgFiles(Tcl_Interp *interp)
{

    /* If assocdata "tclPkgFiles" doesn't exist yet, create it */


    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (!pkgFiles) {
	pkgFiles = ckalloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}




void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName)
{

    PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (pkgFiles && pkgFiles->names) {
	const char *name = pkgFiles->names->name;
	Tcl_HashTable *table = &pkgFiles->table;
	int new;
	Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &new);
	Tcl_Obj *list;

................................................................................
	 * those unresolved references may cause the loading of the package to
	 * also load a second copy of the Tcl library, leading to all kinds of
	 * trouble. We would like to catch that error and report a useful
	 * message back to the user. That's what we're doing.
	 *
	 * Second, how does this work? If we reach this point, then the global
	 * variable tclEmptyStringRep has the value NULL. Compare that with
	 * the definition of tclEmptyStringRep near the top of this file.
	 * It clearly should not have the value NULL; it
	 * should point to the char tclEmptyString. If we see it having the
	 * value NULL, then somehow we are seeing a Tcl library that isn't
	 * completely initialized, and that's an indicator for the error
	 * condition described above. (Further explanation is welcome.)
	 *
	 * Third, so what do we do about it? This situation indicates the
	 * package we just loaded wasn't properly compiled to be stub-enabled,
	 * yet it thinks it is stub-enabled (it called Tcl_InitStubs()). We
	 * want to report that the package just loaded is broken, so we want
	 * to place an error message in the interpreter result and return NULL
	 * to indicate failure to Tcl_InitStubs() so that it will also fail.
................................................................................

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
	    result = Tcl_GetStringResult(interp);
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

................................................................................
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
{
    RequireProcArgs args;

    args.name = name;
    args.clientDataPtr = clientDataPtr;
    return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv);

}

static int
TclNRPkgRequireProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[]) {

    RequireProcArgs *args = clientData;


    Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr);

    return TCL_OK;
}

static int


PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result)

{
    const char *name = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj *const *reqv = data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;

    if (code != TCL_OK) {
	return code;
    }
    reqPtr = ckalloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {

	Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);

    } else {

	Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) {




    Tcl_DString command;
    char *script;
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name /* Name of desired package. */;






    if (reqPtr->pkgPtr->version == NULL) {





	    /*
	     * The package is not in the database. If there is a "package unknown"
	     * command, invoke it.
	     */

	    script = ((Interp *) interp)->packageUnknown;
	    if (script == NULL) {





		Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
	    } else {







		Tcl_DStringInit(&command);
		Tcl_DStringAppend(&command, script, -1);
		Tcl_DStringAppendElement(&command, name);
		AddRequirementsToDString(&command, reqc, reqv);


		Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
		Tcl_NREvalObj(interp,
		    Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)),

		    TCL_EVAL_GLOBAL
		);
		Tcl_DStringFree(&command);
	    }
	    return TCL_OK;
    } else {
	Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) {




    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name /* Name of desired package. */;

    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	result = TCL_ERROR;
    }
    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp,
		"\n    (\"package unknown\" script)");
	return result;
    }
    Tcl_ResetResult(interp);


    /* pkgPtr may now be invalid, so refresh it. */


    reqPtr->pkgPtr = FindPackage(interp, name);

    Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal);

    return TCL_OK;
}

static int
PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {




    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]), satisfies;
    Tcl_Obj **const reqv = data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name /* Name of desired package. */;

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't find package %s", name));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
	AddRequirementsToResult(interp, reqc, reqv);
	return TCL_ERROR;
    }

    /*
     * Ensure that the provided version meets the current requirements.
     */

    if (reqc != 0) {
	CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);

	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	ckfree(pkgVersionI);

	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
		    name, reqPtr->pkgPtr->version));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);
	    AddRequirementsToResult(interp, reqc, reqv);
	    return TCL_ERROR;
	}
    }

    if (clientDataPtr) {
	const void **ptr = (const void **) clientDataPtr;

	*ptr = reqPtr->pkgPtr->clientData;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {




    ckfree(data[0]);
    return result;
}

 
static int


SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {


    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
................................................................................
		name, (char *) pkgPtr->clientData, name));
	AddRequirementsToResult(interp, reqc, reqv);
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
	return TCL_ERROR;
    }

    /*
     * The package isn't yet present. Search the list of available
     * versions and invoke the script for the best available version. We
     * are actually locating the best, and the best stable version. One of
     * them is then chosen based on the selection mode.
     */

    bestPtr = NULL;
    bestStablePtr = NULL;
    bestVersion = NULL;
    bestStableVersion = NULL;

    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
	    availPtr = availPtr->nextPtr) {
	if (CheckVersionAndConvert(interp, availPtr->version,
		&availVersion, &availStable) != TCL_OK) {
	    /*
	     * The provided version number has invalid syntax. This
	     * should not happen. This should have been caught by the
	     * 'package ifneeded' registering the package.
	     */

	    continue;
	}


	/* Check satisfaction of requirements before considering the current version further. */



	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		ckfree(availVersion);
		availVersion = NULL;
		continue;
	    }
................................................................................
	     */

	    if (res > 0) {
		/*
		 * The version of the package sought is better than the
		 * currently selected version.
		 */

		ckfree(bestVersion);
		bestVersion = NULL;
		goto newbest;
	    }
	} else {
	newbest:

	    /* We have found a version which is better than our max. */


	    bestPtr = availPtr;
	    CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	}

	if (!availStable) {
	    ckfree(availVersion);
................................................................................

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	    if (res > 0) {
		/*
		 * This stable version of the package sought is better
		 * than the currently selected stable version.
		 */

		ckfree(bestStableVersion);
		bestStableVersion = NULL;
		goto newstable;
	    }
	} else {
	newstable:

	    /* We have found a stable version which is better than our max stable. */



	    bestStablePtr = availPtr;
	    CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);

	}

	ckfree(availVersion);
	availVersion = NULL;
    } /* end for */

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

    if (bestStableVersion != NULL) {
	ckfree(bestStableVersion);
	bestStableVersion = NULL;
    }

    /*
     * Now choose a version among the two best. For 'latest' we simply
     * take (actually keep) the best. For 'stable' we take the best
     * stable, if there is any, or the best if there is nothing stable.
     */

    if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
	    && (bestStablePtr != NULL)) {
	bestPtr = bestStablePtr;
    }

    if (bestPtr == NULL) {

	Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    } else {
	/*
	 * We found an ifneeded script for the package. Be careful while
	 * executing it: this could cause reentrancy, so (a) protect the
	 * script itself from deletion and (b) don't assume that bestPtr
	 * will still exist when the script completes.
	 */

	char *versionToProvide = bestPtr->version;
	PkgFiles *pkgFiles;
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = TclInitPkgFiles(interp);


	/* Push "ifneeded" package name in "tclPkgFiles" assocdata. */


	pkgName = ckalloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;

	Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]);

	Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL);

    }
    return TCL_OK;
}
 
static int
SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {




    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;


    /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/


    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    ckfree(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
................................................................................
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;

	    if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
		    NULL) != TCL_OK) {
		result = TCL_ERROR;
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		ckfree(pvi);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);
................................................................................
		ckfree(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			    name, versionToProvide,
			    name, reqPtr->pkgPtr->version));
		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
			    "WRONGPROVIDE", NULL);
		}
	    }
	}
    } else if (result != TCL_ERROR) {
	Tcl_Obj *codePtr = Tcl_NewIntObj(result);
................................................................................
		"\n    (\"package ifneeded %s %s\" script)",
		name, versionToProvide));
    }
    Tcl_Release(versionToProvide);

    if (result != TCL_OK) {
	/*
	 * Take a non-TCL_OK code from the script as an indication the
	 * package wasn't loaded properly, so the package system
	 * should not remember an improper load.
	 *
	 * This is consistent with our returning NULL. If we're not
	 * willing to tell our caller we got a particular version, we
	 * shouldn't store that version for telling future callers
	 * either.
	 */

	if (reqPtr->pkgPtr->version != NULL) {
	    ckfree(reqPtr->pkgPtr->version);
	    reqPtr->pkgPtr->version = NULL;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
    }


    Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgPresent / Tcl_PkgPresentEx --
................................................................................

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	}
	pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	if (pkgFiles) {

	    Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2]));
	    if (entry) {
		Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
	    }
	}
	break;
    }
    case PKG_FORGET: {
	const char *keyString;

	PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

	for (i = 2; i < objc; i++) {
	    keyString = TclGetString(objv[i]);
	    if (pkgFiles) {
		hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
		if (hPtr) {
		    Tcl_Obj *obj = Tcl_GetHashValue(hPtr);
................................................................................
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
	    if (hPtr == NULL) {
		continue;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		ckfree(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
................................................................................
		ckfree(argv3i);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    ckfree(avi);

	    if (res == 0){
		if (objc == 4) {
		    ckfree(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));