Check-in [18ef41c5e4]
Not logged in

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

Overview
Comment:merge trunk
Timelines: family | ancestors | descendants | both | dgp-refactor
Files: files | file ages | folders
SHA3-256: 18ef41c5e4e0e005d92098fac04fb80c4988a09271ecae323b7274d1750bc783
User & Date: dgp 2022-09-07 14:40:45.951
Context
2022-09-09
13:49
merge trunk check-in: f35aff5e93 user: dgp tags: dgp-refactor
2022-09-07
14:40
merge trunk check-in: 18ef41c5e4 user: dgp tags: dgp-refactor
07:47
Merge 8.7 check-in: 7b88ab39e3 user: jan.nijtmans tags: trunk, main
2022-08-22
14:09
merge trunk check-in: 8b4b520113 user: dgp tags: dgp-refactor
Changes
Unified Diff Ignore Whitespace Patch
Changes to .github/workflows/linux-build.yml.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
name: Linux
on: [push]
permissions:
  contents: read
jobs:
  gcc:
    runs-on: ubuntu-20.04
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_UTF_MAX=3"
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
name: Linux
on: [push]
permissions:
  contents: read
jobs:
  gcc:
    runs-on: ubuntu-22.04
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_UTF_MAX=3"
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
Changes to .github/workflows/onefiledist.yml.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
name: Build Binaries
on: [push]
permissions:
  contents: read
jobs:
  linux:
    name: Linux
    runs-on: ubuntu-18.04
    defaults:
      run:
        shell: bash
    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Prepare







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
name: Build Binaries
on: [push]
permissions:
  contents: read
jobs:
  linux:
    name: Linux
    runs-on: ubuntu-20.04
    defaults:
      run:
        shell: bash
    steps:
      - name: Checkout
        uses: actions/checkout@v3
      - name: Prepare
Changes to .gitignore.
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
config.status
config.status.lineno
html
manifest.uuid
_FOSSIL_
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc
*/libtcl.vfs
*/libtcl*.zip
*/tclUuid.h
libtommath/bn.ilg
libtommath/bn.ind







|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
config.status
config.status.lineno
html
manifest.uuid
_FOSSIL_
*/tclConfig.sh
*/tclsh*
*/tcltest
*/versions.vc
*/version.vc
*/libtcl.vfs
*/libtcl*.zip
*/tclUuid.h
libtommath/bn.ilg
libtommath/bn.ind
Changes to doc/CrtChannel.3.
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
.PP
The \fIwideSeekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
operations will be applied. \fIWideSeekProc\fR must match the following
prototype:
.PP
.CS
typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
        void *\fIinstanceData\fR,
        Tcl_WideInt \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and
\fIseekMode\fR have the same meaning as for the \fBTcl_Seek\fR







|

|







526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
.PP
The \fIwideSeekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
operations will be applied. \fIWideSeekProc\fR must match the following
prototype:
.PP
.CS
typedef long long \fBTcl_DriverWideSeekProc\fR(
        void *\fIinstanceData\fR,
        long long \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and
\fIseekMode\fR have the same meaning as for the \fBTcl_Seek\fR
Changes to doc/CrtObjCmd.3.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18



19
20
21
22
23
24
25
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp



int
\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
.sp
int
\fBTcl_DeleteCommandFromToken\fR(\fIinterp, token\fR)
.sp
int










|







>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_CreateObjCommand2, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp
Tcl_Command
\fBTcl_CreateObjCommand2\fR(\fIinterp, cmdName, proc2, clientData, deleteProc\fR)
.sp
int
\fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR)
.sp
int
\fBTcl_DeleteCommandFromToken\fR(\fIinterp, token\fR)
.sp
int
48
49
50
51
52
53
54



55
56
57
58
59
60
61
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP "const char" *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.



.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.AP Tcl_Command token in







>
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP "const char" *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP Tcl_ObjCmdProc2 *proc2 in
Implementation of the new command: \fIproc2\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP void *clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.AP Tcl_Command token in
169
170
171
172
173
174
175











176
177
178
179
180
181
182
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.











.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
If \fIcmdName\fR is not bound as a command in \fIinterp\fR then
\fBTcl_DeleteCommand\fR does nothing and returns -1;  otherwise
it returns 0.







>
>
>
>
>
>
>
>
>
>
>







175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
\fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR,
except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
.PP
.CS
typedef int \fBTcl_ObjCmdProc2\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        size_t \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
If \fIcmdName\fR is not bound as a command in \fIinterp\fR then
\fBTcl_DeleteCommand\fR does nothing and returns -1;  otherwise
it returns 0.
212
213
214
215
216
217
218


219
220
221
222

223
224
225
226
227


228
229
230
231
232
233
234
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;


} \fBTcl_CmdInfo\fR;
.CE
.PP
The \fIisNativeObjectProc\fR field has the value 1

if \fBTcl_CreateObjCommand\fR was called to register the command;
it is 0 if only \fBTcl_CreateCommand\fR was called.
It allows a program to determine whether it is faster to
call \fIobjProc\fR or \fIproc\fR:
\fIobjProc\fR is normally faster


if \fIisNativeObjectProc\fR has the value 1.
The fields \fIobjProc\fR and \fIobjClientData\fR
have the same meaning as the \fIproc\fR and \fIclientData\fR
arguments to \fBTcl_CreateObjCommand\fR;
they hold information about the value-based command procedure
that the Tcl interpreter calls to implement the command.
The fields \fIproc\fR and \fIclientData\fR







>
>



|
>
|
|

|
|
>
>







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
    Tcl_ObjCmdProc2 *\fIobjProc2\fR;
    void *\fIobjClientData2\fR;
} \fBTcl_CmdInfo\fR;
.CE
.PP
The \fIisNativeObjectProc\fR field has the value 2 if
\fBTcl_CreateObjCommand2\fR was called to register the command;
it has the value 1 if \fBTcl_CreateObjCommand\fR was called to
register the command; it is 0 if only \fBTcl_CreateCommand\fR was called.
It allows a program to determine whether it is faster to
call \fIobjProc2\fR, \fIobjProc\fR or \fIproc\fR:
\fIobjProc2\fR/\fIobjProc\fR is normally faster
if \fIisNativeObjectProc\fR has the value 2;
\fIobjProc\fR/\fIobjProc\fR is normally faster
if \fIisNativeObjectProc\fR has the value 1.
The fields \fIobjProc\fR and \fIobjClientData\fR
have the same meaning as the \fIproc\fR and \fIclientData\fR
arguments to \fBTcl_CreateObjCommand\fR;
they hold information about the value-based command procedure
that the Tcl interpreter calls to implement the command.
The fields \fIproc\fR and \fIclientData\fR
Changes to doc/CrtTrace.3.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23



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



41
42
43
44
45
46
47
48
49
50
51
52
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Trace
\fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
.sp
Tcl_Trace
\fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR)
.sp



\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
.AS Tcl_CmdObjTraceDeleteProc *deleteProc
.AP Tcl_Interp *interp in
Interpreter containing command to be traced or untraced.
.AP int level in
Only commands at or below this nesting level will be traced unless
0 is specified.  1 means
top-level commands only, 2 means top-level commands or those that are
invoked as immediate consequences of executing top-level commands
(procedure bodies, bracketed commands, etc.) and so on.
A value of 0 means that commands at any level are traced.
.AP int flags in
Flags governing the trace execution.  See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.



.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed.  See below for
details on the calling sequence.
.AP void *clientData in
Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted.  See below for details of
the calling sequence.  A NULL pointer is permissible and results in no
callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call
to \fBTcl_CreateTrace\fR).












|










>
>
>

















>
>
>




|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_CreateObjTrace2, Tcl_DeleteTrace \- arrange for command execution to be traced
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Trace
\fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
.sp
Tcl_Trace
\fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR)
.sp
Tcl_Trace
\fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR)
.sp
\fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
.SH ARGUMENTS
.AS Tcl_CmdObjTraceDeleteProc *deleteProc
.AP Tcl_Interp *interp in
Interpreter containing command to be traced or untraced.
.AP int level in
Only commands at or below this nesting level will be traced unless
0 is specified.  1 means
top-level commands only, 2 means top-level commands or those that are
invoked as immediate consequences of executing top-level commands
(procedure bodies, bracketed commands, etc.) and so on.
A value of 0 means that commands at any level are traced.
.AP int flags in
Flags governing the trace execution.  See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.
.AP Tcl_CmdObjTraceProc2 *objProc2 in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed.  See below for
details on the calling sequence.
.AP void *clientData in
Arbitrary one-word value to pass to \fIobjProc\fR, \fIobjProc2\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted.  See below for details of
the calling sequence.  A NULL pointer is permissible and results in no
callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call
to \fBTcl_CreateTrace\fR).
Changes to doc/Eval.3.
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
A Tcl value containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP size_t objc in
The number of values in the array pointed to by \fIobjPtr\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
Points to an array of pointers to values; each value holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any
null terminating character.  If \-1, then all characters up to the







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
A Tcl value containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP size_t objc in
The number of values in the array pointed to by \fIobjv\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
Points to an array of pointers to values; each value holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any
null terminating character.  If \-1, then all characters up to the
Changes to doc/GetVersion.3.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Tcl_GetVersion \- get the version of the library at runtime
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR)
.SH ARGUMENTS
.AS Tcl_ReleaseType *patchLevel out
.AP int *major out
Major version number of the Tcl library.
.AP int *minor out
Minor version number of the Tcl library.
.AP int *patchLevel out
The patch level of the Tcl library (or alpha or beta number).
.AP Tcl_ReleaseType *type out
The type of release, also indicates the type of patch level. Can be
one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or
\fBTCL_FINAL_RELEASE\fR.
.BE

.SH DESCRIPTION
.PP







<






|







11
12
13
14
15
16
17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
Tcl_GetVersion \- get the version of the library at runtime
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR)
.SH ARGUMENTS

.AP int *major out
Major version number of the Tcl library.
.AP int *minor out
Minor version number of the Tcl library.
.AP int *patchLevel out
The patch level of the Tcl library (or alpha or beta number).
.AP int *type out
The type of release, also indicates the type of patch level. Can be
one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or
\fBTCL_FINAL_RELEASE\fR.
.BE

.SH DESCRIPTION
.PP
Changes to doc/NRE.3.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20




21
22
23



24
25
26
27
28
29
30
.\"
.\" Copyright (c) 2008 Kevin B. Kenny.
.\" Copyright (c) 2018 Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData,
                    deleteProc\fR)
.sp




int
\fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR)
.sp



int
\fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR)
.sp
int
\fBTcl_NREvalObjv\fR(\fIinterp, objc, objv, flags\fR)
.sp
int











|








>
>
>
>



>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
.\"
.\" Copyright (c) 2008 Kevin B. Kenny.
.\" Copyright (c) 2018 Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NRCreateCommand, Tcl_NRCreateCommand2, Tcl_NRCallObjProc, Tcl_NRCallObjProc2, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData,
                    deleteProc\fR)
.sp
Tcl_Command
\fBTcl_NRCreateCommand2\fR(\fIinterp, cmdName, proc2, nreProc2, clientData,
                    deleteProc\fR)
.sp
int
\fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR)
.sp
int
\fBTcl_NRCallObjProc2\fR(\fIinterp, nreProc2, clientData, objc, objv\fR)
.sp
int
\fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR)
.sp
int
\fBTcl_NREvalObjv\fR(\fIinterp, objc, objv, flags\fR)
.sp
int
43
44
45
46
47
48
49





50
51


52
53
54
55
56
57
58
.AP "const char" *cmdName in
Name of the command to create.
.AP Tcl_ObjCmdProc *proc in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).





.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.


.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP size_t objc in







>
>
>
>
>


>
>







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
.AP "const char" *cmdName in
Name of the command to create.
.AP Tcl_ObjCmdProc *proc in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc2 *proc2 in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc2\fR to call \fInreProc2\fR using a new trampoline.  Behaves
in the same way as the \fIproc2\fR argument to \fBTcl_CreateObjCommand2\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.
.AP Tcl_ObjCmdProc2 *nreProc2 in
Called instead of \fIproc2\fR when a trampoline is already in use.
.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP size_t objc in
99
100
101
102
103
104
105



106
107
108
109
110
111
112
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
current namespace, creates a command by that name, and returns a token for the
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
Except for a few cases noted below any existing command by the same name is
first deleted.  If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.



.PP
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
.PP
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
consumes no space on the C stack.
.PP







>
>
>







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
current namespace, creates a command by that name, and returns a token for the
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
Except for a few cases noted below any existing command by the same name is
first deleted.  If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.
.PP
\fBTcl_NRCreateCommand2\fR, is an alternative to \fBTcl_NRCreateCommand\fR
in the same way as \fBTcl_CreateObjCommand2\fR.
.PP
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
.PP
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
consumes no space on the C stack.
.PP
Changes to doc/TraceVar.3.
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
.PP
.CS
typedef char *\fBTcl_VarTraceProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        char *\fIname1\fR,
        char *\fIname2\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
\fIclientData\fR typically points to an application-specific







|
|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
.PP
.CS
typedef char *\fBTcl_VarTraceProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIname1\fR,
        const char *\fIname2\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
\fIclientData\fR typically points to an application-specific
Changes to generic/tcl.decls.
2556
2557
2558
2559
2560
2561
2562





















2563
2564
2565
2566
2567
2568
2569
declare 672 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
declare 673 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index)
}























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

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

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







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







2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
declare 672 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
declare 673 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index)
}

declare 676 {
    Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc2 *proc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 677 {
    Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc2 *objProc2, void *clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 678 {
    Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc2 *proc,
	    Tcl_ObjCmdProc2 *nreProc2, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 679 {
    int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2,
	    void *clientData, size_t objc, Tcl_Obj *const objv[])
}

# ----- 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.
551
552
553
554
555
556
557



558
559
560
561
562
563
564
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);



typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
#define Tcl_EncodingFreeProc Tcl_FreeProc







>
>
>







551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, size_t objc,
	struct Tcl_Obj *const objv[]);
typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
#define Tcl_EncodingFreeProc Tcl_FreeProc
573
574
575
576
577
578
579


580
581
582
583
584
585
586
typedef void (Tcl_FreeProc) (void *blockPtr);
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);


typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);







>
>







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
typedef void (Tcl_FreeProc) (void *blockPtr);
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
	size_t objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
783
784
785
786
787
788
789


790
791
792
793
794
795
796
    void *deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */


} Tcl_CmdInfo;

/*
 *----------------------------------------------------------------------------
 * The structure defined below is used to hold dynamic strings. The only
 * fields that clients should use are string and length, accessible via the
 * macros Tcl_DStringValue and Tcl_DStringLength.







>
>







788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
    void *deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */
    Tcl_ObjCmdProc2 *objProc2;	/* Not used in Tcl 8.7. */
    void *objClientData2;	/* Not used in Tcl 8.7. */
} Tcl_CmdInfo;

/*
 *----------------------------------------------------------------------------
 * The structure defined below is used to hold dynamic strings. The only
 * fields that clients should use are string and length, accessible via the
 * macros Tcl_DStringValue and Tcl_DStringLength.
Changes to generic/tclBasic.c.
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
buildInfoObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	int len;
	const char *arg = TclGetStringFromObj(objv[1], &len);
	if (len == 7 && !strcmp(arg, "version")) {







|


|


|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
buildInfoObjCmd2(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc - 1 > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	int len;
	const char *arg = TclGetStringFromObj(objv[1], &len);
	if (len == 7 && !strcmp(arg, "version")) {
688
689
690
691
692
693
694










695
696
697
698
699
700
701
	}
	Tcl_AppendResult(interp, "0", NULL);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, (char *)clientData, NULL);
    return TCL_OK;
}











/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
 *	Create a new TCL command interpreter.







>
>
>
>
>
>
>
>
>
>







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
	}
	Tcl_AppendResult(interp, "0", NULL);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, (char *)clientData, NULL);
    return TCL_OK;
}

static int
buildInfoObjCmd(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
 *	Create a new TCL command interpreter.
1231
1232
1233
1234
1235
1236
1237

1238
1239
1240



1241
1242
1243
1244
1245
1246
1247
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     * TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
    Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);

    Tcl_CreateObjCommand(interp, "::tcl::build-info",
	    buildInfoObjCmd, (void *)version, NULL);





    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));







>
|

|
>
>
>







1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     * TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...."
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
    Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
    Tcl_CmdInfo info2;
    Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info",
	    buildInfoObjCmd, (void *)version, NULL);
    Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2);
    info2.objProc2 = buildInfoObjCmd2;
    info2.objClientData2 = (void *)version;
    Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2);

    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
2626
2627
2628
2629
2630
2631
2632




























































2633
2634
2635
2636
2637
2638
2639
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */





























































Tcl_Command
Tcl_CreateObjCommand(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the







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







2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

typedef struct {
    Tcl_ObjCmdProc2 *proc;
    void *clientData; /* Arbitrary value to pass to proc function. */
    Tcl_CmdDeleteProc *deleteProc;
    void *deleteData; /* Arbitrary value to pass to deleteProc function. */
    Tcl_ObjCmdProc2 *nreProc;
} CmdWrapperInfo;


static int cmdWrapperProc(void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const *objv)
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->proc(info->clientData, interp, (size_t)objc, objv);
}

static void cmdWrapperDeleteProc(void *clientData) {
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;

    clientData = info->deleteData;
    Tcl_CmdDeleteProc *deleteProc = info->deleteProc;
    Tcl_Free(info);
    if (deleteProc != NULL) {
	deleteProc(clientData);
    }
}

Tcl_Command
Tcl_CreateObjCommand2(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc2 *proc,	/* Object-based function to associate with
				 * name. */
    void *clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
)
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
    info->proc = proc;
    info->clientData = clientData;
    info->deleteProc = deleteProc;
    info->deleteData = clientData;

    return Tcl_CreateObjCommand(interp, cmdName,
	    (proc ? cmdWrapperProc : NULL),
	    info, cmdWrapperDeleteProc);
}

Tcl_Command
Tcl_CreateObjCommand(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
3206
3207
3208
3209
3210
3211
3212































3213
3214
3215
3216
3217
3218
3219
 *	returned. If the command doesn't exist then 0 is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
































int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;		/* Internal representation of the command */







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







3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
 *	returned. If the command doesn't exist then 0 is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
invokeObj2Command(
    void *clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    Command *cmdPtr = (Command *) clientData;

    if (objc > INT_MAX) {
	objc = TCL_INDEX_NONE;
    }
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, objc, objv);
    }
    return result;
}

static int cmdWrapper2Proc(void *clientData,
    Tcl_Interp *interp,
    size_t objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr = (Command *)clientData;
    return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}

int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;		/* Internal representation of the command */
3236
3237
3238
3239
3240
3241
3242


























3243
3244


3245
3246
3247
3248
3249
3250
3251
    } else {
	if (infoPtr->objProc != cmdPtr->objProc) {
	    cmdPtr->nreProc = NULL;
	    cmdPtr->objProc = infoPtr->objProc;
	}
	cmdPtr->objClientData = infoPtr->objClientData;
    }


























    cmdPtr->deleteProc = infoPtr->deleteProc;
    cmdPtr->deleteData = infoPtr->deleteData;


    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandInfo --







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







3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
    } else {
	if (infoPtr->objProc != cmdPtr->objProc) {
	    cmdPtr->nreProc = NULL;
	    cmdPtr->objProc = infoPtr->objProc;
	}
	cmdPtr->objClientData = infoPtr->objClientData;
    }
    if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
	CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
	if (infoPtr->objProc2 == NULL) {
	    info->proc = invokeObj2Command;
	    info->clientData = cmdPtr;
	    info->nreProc = NULL;
	} else {
	    if (infoPtr->objProc2 != info->proc) {
		info->nreProc = NULL;
		info->proc = infoPtr->objProc2;
	    }
	    info->clientData = infoPtr->objClientData2;
	}
	info->deleteProc = infoPtr->deleteProc;
	info->deleteData = infoPtr->deleteData;
    } else {
	if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) {
	    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
	    info->proc = infoPtr->objProc2;
	    info->clientData = infoPtr->objClientData2;
	    info->nreProc = NULL;
	    info->deleteProc = infoPtr->deleteProc;
	    info->deleteData = infoPtr->deleteData;
	    cmdPtr->deleteProc = cmdWrapperDeleteProc;
	    cmdPtr->deleteData = info;
	} else {
	    cmdPtr->deleteProc = infoPtr->deleteProc;
	    cmdPtr->deleteData = infoPtr->deleteData;
	}
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandInfo --
3304
3305
3306
3307
3308
3309
3310
3311

3312
3313
3314
3315
3316
3317
3318
3319
3320










3321
3322

3323
3324

3325
3326
3327
3328
3329
3330
3331

    if (cmd == NULL) {
	return 0;
    }

    /*
     * Set isNativeObjectProc 1 if objProc was registered by a call to
     * Tcl_CreateObjCommand. Otherwise set it to 0.

     */

    cmdPtr = (Command *) cmd;
    infoPtr->isNativeObjectProc =
	    (cmdPtr->objProc != TclInvokeStringCommand);
    infoPtr->objProc = cmdPtr->objProc;
    infoPtr->objClientData = cmdPtr->objClientData;
    infoPtr->proc = cmdPtr->proc;
    infoPtr->clientData = cmdPtr->clientData;










    infoPtr->deleteProc = cmdPtr->deleteProc;
    infoPtr->deleteData = cmdPtr->deleteData;

    infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;


    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandName --







|
>









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







3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477

    if (cmd == NULL) {
	return 0;
    }

    /*
     * Set isNativeObjectProc 1 if objProc was registered by a call to
     * Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was
     * registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0.
     */

    cmdPtr = (Command *) cmd;
    infoPtr->isNativeObjectProc =
	    (cmdPtr->objProc != TclInvokeStringCommand);
    infoPtr->objProc = cmdPtr->objProc;
    infoPtr->objClientData = cmdPtr->objClientData;
    infoPtr->proc = cmdPtr->proc;
    infoPtr->clientData = cmdPtr->clientData;
    if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
	CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
	infoPtr->deleteProc = info->deleteProc;
	infoPtr->deleteData = info->deleteData;
	infoPtr->objProc2 = info->proc;
	infoPtr->objClientData2 = info->clientData;
	if (cmdPtr->objProc == cmdWrapperProc) {
	    infoPtr->isNativeObjectProc = 2;
	}
    } else {
	infoPtr->deleteProc = cmdPtr->deleteProc;
	infoPtr->deleteData = cmdPtr->deleteData;
	infoPtr->objProc2 = cmdWrapper2Proc;
	infoPtr->objClientData2 = cmdPtr;
    }
    infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandName --
8313
8314
8315
8316
8317
8318
8319







































8320
8321
8322
8323
8324
8325
8326
    NRE_callback *rootPtr = TOP_CB(interp);

    TclNRAddCallback(interp, Dispatch, objProc, clientData,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}








































/*
 *----------------------------------------------------------------------
 *
 * Tcl_NRCreateCommand --
 *
 *	Define a new NRE-enabled object-based command in a command table.
 *







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







8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
8504
8505
8506
8507
8508
8509
8510
8511
    NRE_callback *rootPtr = TOP_CB(interp);

    TclNRAddCallback(interp, Dispatch, objProc, clientData,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}

int wrapperNRObjProc(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    clientData = info->clientData;
    Tcl_ObjCmdProc2 *proc = info->proc;
    Tcl_Free(info);
    if (objc < 0) {
	objc = -1;
    }
    return proc(clientData, interp, (size_t)objc, objv);
}

int
Tcl_NRCallObjProc2(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc2 *objProc,
    void *clientData,
    size_t objc,
    Tcl_Obj *const objv[])
{
    if (objc > INT_MAX) {
	Tcl_WrongNumArgs(interp, 1, objv, "?args?");
	return TCL_ERROR;
    }

    NRE_callback *rootPtr = TOP_CB(interp);
    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
    info->clientData = clientData;
    info->proc = objProc;

    TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NRCreateCommand --
 *
 *	Define a new NRE-enabled object-based command in a command table.
 *
8340
8341
8342
8343
8344
8345
8346












































8347
8348
8349
8350
8351
8352
8353
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */













































Tcl_Command
Tcl_NRCreateCommand(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the







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







8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
8551
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

static int cmdWrapperNreProc(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return info->nreProc(info->clientData, interp, (size_t)objc, objv);
}

Tcl_Command
Tcl_NRCreateCommand2(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc2 *proc,	/* Object-based function to associate with
				 * name, provides direct access for direct
				 * calls. */
    Tcl_ObjCmdProc2 *nreProc,	/* Object-based function to associate with
				 * name, provides NR implementation */
    void *clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
    info->proc = proc;
    info->clientData = clientData;
    info->nreProc = nreProc;
    info->deleteProc = deleteProc;
    info->deleteData = clientData;
    return Tcl_NRCreateCommand(interp, cmdName,
	    (proc ? cmdWrapperProc : NULL),
	    (nreProc ? cmdWrapperNreProc : NULL),
	    info, cmdWrapperDeleteProc);
}

Tcl_Command
Tcl_NRCreateCommand(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
Changes to generic/tclCmdIL.c.
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904







2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

    listPtr = Tcl_NewListObj(totalElems, NULL);
    if (totalElems) {
	List *listRepPtr = ListRepPtr(listPtr);








	listRepPtr->elemCount = elementCount*objc;
	dataArray = listRepPtr->elements;
    }

    /*
     * Set the elements. Note that we handle the common degenerate case of a
     * single value being repeated separately to permit the compiler as much
     * room as possible to optimize a loop that might be run a very large
     * number of times.







|

|












|
>
>
>
>
>
>
>
|
<
<







2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912


2913
2914
2915
2916
2917
2918
2919
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && (size_t)objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%" TCL_Z_MODIFIER "u elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

    listPtr = Tcl_NewListObj(totalElems, NULL);
    if (totalElems) {
	ListRep listRep;
	ListObjGetRep(listPtr, &listRep);
	dataArray = ListRepElementsBase(&listRep);
	listRep.storePtr->numUsed = totalElems;
	if (listRep.spanPtr) {
	    /* Future proofing in case Tcl_NewListObj returns a span */
	    listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
	    listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
	}


    }

    /*
     * Set the elements. Note that we handle the common degenerate case of a
     * single value being repeated separately to permit the compiler as much
     * room as possible to optimize a loop that might be run a very large
     * number of times.
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092


3093
3094





3095
3096
3097
3098
3099
3100
3101

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    if (Tcl_IsShared(objv[1])
	    || (ListRepPtr(objv[1])->refCount > 1)) {	/* Bug 1675044 */
	Tcl_Obj *resultObj, **dataArray;
	List *listRepPtr;

	resultObj = Tcl_NewListObj(elemc, NULL);
	listRepPtr = ListRepPtr(resultObj);


	listRepPtr->elemCount = elemc;
	dataArray = listRepPtr->elements;






	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
	    dataArray[j] = elemv[i];
	    Tcl_IncrRefCount(elemv[i]);
	}

	Tcl_SetObjResult(interp, resultObj);







|

|


|
>
>
|
|
>
>
>
>
>







3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    if (Tcl_IsShared(objv[1])
	|| ListObjRepIsShared(objv[1])) { /* Bug 1675044 */
	Tcl_Obj *resultObj, **dataArray;
	ListRep listRep;

	resultObj = Tcl_NewListObj(elemc, NULL);

	/* Modify the internal rep in-place */
	ListObjGetRep(resultObj, &listRep);
	listRep.storePtr->numUsed = elemc;
	dataArray = ListRepElementsBase(&listRep);
	if (listRep.spanPtr) {
	    /* Future proofing */
	    listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
	    listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
	}

	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
	    dataArray[j] = elemv[i];
	    Tcl_IncrRefCount(elemv[i]);
	}

	Tcl_SetObjResult(interp, resultObj);
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
    }

    /*
     * Now store the sorted elements in the result list.
     */

    if (sortInfo.resultCode == TCL_OK) {
	List *listRepPtr;
	Tcl_Obj **newArray, *objPtr;

	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
	listRepPtr = ListRepPtr(resultPtr);
	newArray = listRepPtr->elements;
	if (group) {
	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
		idx = elementPtr->payload.index;
		for (j = 0; j < groupSize; j++) {
		    if (indices) {
			TclNewIndexObj(objPtr, idx + j - groupOffset);
			newArray[i++] = objPtr;







|



|
|







4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
    }

    /*
     * Now store the sorted elements in the result list.
     */

    if (sortInfo.resultCode == TCL_OK) {
	ListRep listRep;
	Tcl_Obj **newArray, *objPtr;

	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
	ListObjGetRep(resultPtr, &listRep);
	newArray = ListRepElementsBase(&listRep);
	if (group) {
	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
		idx = elementPtr->payload.index;
		for (j = 0; j < groupSize; j++) {
		    if (indices) {
			TclNewIndexObj(objPtr, idx + j - groupOffset);
			newArray[i++] = objPtr;
4449
4450
4451
4452
4453
4454
4455

4456



4457
4458
4459
4460
4461
4462
4463
	} else {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		objPtr = elementPtr->payload.objPtr;
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	}

	listRepPtr->elemCount = i;



	Tcl_SetObjResult(interp, resultPtr);
    }

  done:
    if (sortMode == SORTMODE_COMMAND) {
	TclDecrRefCount(sortInfo.compareCmdPtr);
	TclDecrRefCount(listObj);







>
|
>
>
>







4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
	} else {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		objPtr = elementPtr->payload.objPtr;
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	}
	listRep.storePtr->numUsed = i;
	if (listRep.spanPtr) {
	    listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
	    listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
	}
	Tcl_SetObjResult(interp, resultPtr);
    }

  done:
    if (sortMode == SORTMODE_COMMAND) {
	TclDecrRefCount(sortInfo.compareCmdPtr);
	TclDecrRefCount(listObj);
Changes to generic/tclCompCmdsSZ.c.
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
		    Tcl_DStringValue(&buffer), &isNew);
	    if (isNew) {
		/*
		 * First time we've encountered this match clause, so it must
		 * point to here.
		 */

		Tcl_SetHashValue(hPtr, CurrentOffset(envPtr) - jumpLocation);
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    /*
	     * This is a default clause, so patch up the fallthrough from the
	     * INST_JUMP_TABLE instruction to here.
	     */







|







2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
		    Tcl_DStringValue(&buffer), &isNew);
	    if (isNew) {
		/*
		 * First time we've encountered this match clause, so it must
		 * point to here.
		 */

		Tcl_SetHashValue(hPtr, INT2PTR(CurrentOffset(envPtr) - jumpLocation));
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    /*
	     * This is a default clause, so patch up the fallthrough from the
	     * INST_JUMP_TABLE instruction to here.
	     */
Changes to generic/tclCompile.c.
2863
2864
2865
2866
2867
2868
2869




2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
    objArrayBytes = envPtr->mallocedLiteralArray ? 0 :
	    envPtr->literalArrayNext * sizeof(Tcl_Obj *);
    exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
    cmdLocBytes = GetCmdLocEncodingSize(envPtr);

    /*
     * Compute the total number of bytes needed for this bytecode.




     */

    structureSize = sizeof(ByteCode);
    structureSize += TCL_ALIGN(codeBytes);	  /* align object array */
    structureSize += TCL_ALIGN(objArrayBytes);	  /* align exc range arr */
    structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
    structureSize += cmdLocBytes;

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;







>
>
>
>


|







2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
    objArrayBytes = envPtr->mallocedLiteralArray ? 0 :
	    envPtr->literalArrayNext * sizeof(Tcl_Obj *);
    exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
    cmdLocBytes = GetCmdLocEncodingSize(envPtr);

    /*
     * Compute the total number of bytes needed for this bytecode.
     *
     * Note that code bytes need not be aligned but since later elements are we
     * need to pad anyway, either directly after ByteCode or after codeBytes,
     * and it's easier and more consistent to do the former.
     */

    structureSize = TCL_ALIGN(sizeof(ByteCode));  /* align code bytes */
    structureSize += TCL_ALIGN(codeBytes);	  /* align object array */
    structureSize += TCL_ALIGN(objArrayBytes);	  /* align exc range arr */
    structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
    structureSize += cmdLocBytes;

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
    codePtr->numCodeBytes = codeBytes;
    codePtr->numLitObjects = numLitObjects;
    codePtr->numExceptRanges = envPtr->exceptArrayNext;
    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 */

    if (envPtr->mallocedLiteralArray) {
	codePtr->objArrayPtr = envPtr->literalArrayPtr;
	codePtr->flags |= TCL_BYTECODE_FREE_LITERALS;







|







2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
    codePtr->numCodeBytes = codeBytes;
    codePtr->numLitObjects = numLitObjects;
    codePtr->numExceptRanges = envPtr->exceptArrayNext;
    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;

    p += TCL_ALIGN(sizeof(ByteCode));	/* align code bytes */
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, codeBytes);
    p += TCL_ALIGN(codeBytes);		/* align object array */

    if (envPtr->mallocedLiteralArray) {
	codePtr->objArrayPtr = envPtr->literalArrayPtr;
	codePtr->flags |= TCL_BYTECODE_FREE_LITERALS;
Changes to generic/tclConfig.c.
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 */

static int
QueryConfigObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    size_t m, n = 0;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL







|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
 */

static int
QueryConfigObjCmd(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    size_t m, n = 0;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
Changes to generic/tclDecls.h.
1803
1804
1805
1806
1807
1808
1809





















1810
1811
1812
1813
1814
1815
1816
/* 671 */
EXTERN const char *	Tcl_UtfAtIndex(const char *src, size_t index);
/* 672 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
				size_t last);
/* 673 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);






















typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;








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







1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
/* 671 */
EXTERN const char *	Tcl_UtfAtIndex(const char *src, size_t index);
/* 672 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
				size_t last);
/* 673 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);
/* Slot 674 is reserved */
/* Slot 675 is reserved */
/* 676 */
EXTERN Tcl_Command	Tcl_CreateObjCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc2,
				void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 677 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace2(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc2 *objProc2,
				void *clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
/* 678 */
EXTERN Tcl_Command	Tcl_NRCreateCommand2(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc2 *proc,
				Tcl_ObjCmdProc2 *nreProc2, void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 679 */
EXTERN int		Tcl_NRCallObjProc2(Tcl_Interp *interp,
				Tcl_ObjCmdProc2 *objProc2, void *clientData,
				size_t objc, Tcl_Obj *const objv[]);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

2488
2489
2490
2491
2492
2493
2494






2495
2496
2497
2498
2499
2500
2501
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */
    size_t (*tcl_UniCharLen) (const int *uniStr); /* 668 */
    size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 669 */
    size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */
    const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 671 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 672 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 673 */






} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif







>
>
>
>
>
>







2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */
    size_t (*tcl_UniCharLen) (const int *uniStr); /* 668 */
    size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 669 */
    size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */
    const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 671 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 672 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 673 */
    void (*reserved674)(void);
    void (*reserved675)(void);
    Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */
    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
3789
3790
3791
3792
3793
3794
3795










3796
3797
3798
3799
3800
3801
3802
	(tclStubsPtr->tcl_GetCharLength) /* 670 */
#define Tcl_UtfAtIndex \
	(tclStubsPtr->tcl_UtfAtIndex) /* 671 */
#define Tcl_GetRange \
	(tclStubsPtr->tcl_GetRange) /* 672 */
#define Tcl_GetUniChar \
	(tclStubsPtr->tcl_GetUniChar) /* 673 */











#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#ifdef _WIN32
#   undef Tcl_CreateFileHandler







>
>
>
>
>
>
>
>
>
>







3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
	(tclStubsPtr->tcl_GetCharLength) /* 670 */
#define Tcl_UtfAtIndex \
	(tclStubsPtr->tcl_UtfAtIndex) /* 671 */
#define Tcl_GetRange \
	(tclStubsPtr->tcl_GetRange) /* 672 */
#define Tcl_GetUniChar \
	(tclStubsPtr->tcl_GetUniChar) /* 673 */
/* Slot 674 is reserved */
/* Slot 675 is reserved */
#define Tcl_CreateObjCommand2 \
	(tclStubsPtr->tcl_CreateObjCommand2) /* 676 */
#define Tcl_CreateObjTrace2 \
	(tclStubsPtr->tcl_CreateObjTrace2) /* 677 */
#define Tcl_NRCreateCommand2 \
	(tclStubsPtr->tcl_NRCreateCommand2) /* 678 */
#define Tcl_NRCallObjProc2 \
	(tclStubsPtr->tcl_NRCallObjProc2) /* 679 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#ifdef _WIN32
#   undef Tcl_CreateFileHandler
Changes to generic/tclDisassemble.c.
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",

	    codePtr->structureSize,
	    sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    BA_AuxData_Size(codePtr->auxData) * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */








|
>

|







296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
	    codePtr->structureSize,
	    offsetof(ByteCode, localCachePtr),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    BA_AuxData_Size(codePtr->auxData) * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

Changes to generic/tclExecute.c.
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    ptrdiff_t *catchTop;	/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
    CmdFrame cmdFrame;		/* new codePtr was received for NR */
                                /* execution. */
    void *stack[1];		/* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */
} TEBCdata;

#define TEBC_YIELD() \
    do {						\
	esPtr->tosPtr = tosPtr;				\







|



|







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/
    Tcl_Obj **catchTop;		/* These fields are used on return TO this */
    Tcl_Obj *auxObjList;	/* this level: they record the state when a */
    CmdFrame cmdFrame;		/* new codePtr was received for NR */
                                /* execution. */
    Tcl_Obj *stack[1];		/* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */
} TEBCdata;

#define TEBC_YIELD() \
    do {						\
	esPtr->tosPtr = tosPtr;				\
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))

#define CURR_DEPTH	((ptrdiff_t) (tosPtr - initTosPtr))

#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
 * only used in TRACE* calls to get a string from an object.
 */

#ifdef TCL_COMPILE_DEBUG
#   define TRACE(a) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		(int) CURR_DEPTH,				\
		(size_t) (pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	break;							\
    }
#   define TRACE_APPEND(a) \
    while (traceInstructions) {		\
	printf a;			\
	break;				\
    }
#   define TRACE_ERROR(interp) \
    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
#   define TRACE_WITH_OBJ(a, objPtr) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		(int) CURR_DEPTH,				\
		(size_t) (pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	TclPrintObject(stdout, objPtr, 30);			\
	fprintf(stdout, "\n");					\
	break;							\
    }
#   define O2S(objPtr) \







|












|
|
|













|
|
|







362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

#define OBJ_AT_DEPTH(n)	*(tosPtr-(n))

#define CURR_DEPTH	((size_t)(tosPtr - initTosPtr))

#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)

/*
 * Macros used to trace instruction execution. The macros TRACE,
 * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is
 * only used in TRACE* calls to get a string from an object.
 */

#ifdef TCL_COMPILE_DEBUG
#   define TRACE(a) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(size_t)(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	break;							\
    }
#   define TRACE_APPEND(a) \
    while (traceInstructions) {		\
	printf a;			\
	break;				\
    }
#   define TRACE_ERROR(interp) \
    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
#   define TRACE_WITH_OBJ(a, objPtr) \
    while (traceInstructions) {					\
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(size_t)(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	TclPrintObject(stdout, objPtr, 30);			\
	fprintf(stdout, "\n");					\
	break;							\
    }
#   define O2S(objPtr) \
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
			    Tcl_Obj *const objv[]);
#endif /* TCL_COMPILE_STATS */
#ifdef TCL_COMPILE_DEBUG
static const char *	GetOpcodeName(const unsigned char *pc);
static void		PrintByteCodeInfo(ByteCode *codePtr);
static const char *	StringForResultCode(int result);
static void		ValidatePcAndStackTop(ByteCode *codePtr,
			    const unsigned char *pc, int stackTop,
			    int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		DeleteExecStack(ExecStack *esPtr);
static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,







|







616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
			    Tcl_Obj *const objv[]);
#endif /* TCL_COMPILE_STATS */
#ifdef TCL_COMPILE_DEBUG
static const char *	GetOpcodeName(const unsigned char *pc);
static void		PrintByteCodeInfo(ByteCode *codePtr);
static const char *	StringForResultCode(int result);
static void		ValidatePcAndStackTop(ByteCode *codePtr,
			    const unsigned char *pc, size_t stackTop,
			    int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		DeleteExecStack(ExecStack *esPtr);
static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */
#define	bcFramePtr	(&TD->cmdFrame)
#define	initCatchTop	((ptrdiff_t *) (TD->stack-1))
#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
#define esPtr		(iPtr->execEnvPtr->execStackPtr)

int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{







|
|







1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */
#define	bcFramePtr	(&TD->cmdFrame)
#define	initCatchTop	(TD->stack-1)
#define	initTosPtr	(initCatchTop+codePtr->maxExceptDepth)
#define esPtr		(iPtr->execEnvPtr->execStackPtr)

int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
    TclResetRewriteEnsemble(interp, 1);

    /*
     * Push the callback for bytecode execution
     */

    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
	    /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags));

    /*
     * Reset discard result flag - because it is applicable for this call only,
     * and should not affect all the nested invocations may return result.
     */
    iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;








|







1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
    TclResetRewriteEnsemble(interp, 1);

    /*
     * Push the callback for bytecode execution
     */

    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
	    /* cleanup */ NULL, INT2PTR(iPtr->evalFlags));

    /*
     * Reset discard result flag - because it is applicable for this call only,
     * and should not affect all the nested invocations may return result.
     */
    iPtr->evalFlags &= ~TCL_EVAL_DISCARD_RESULT;

2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
#endif

    TEBC_DATA_DIG();

#ifdef TCL_COMPILE_DEBUG
    if (!pc && (tclTraceExec >= 2)) {
	PrintByteCodeInfo(codePtr);
	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
	fflush(stdout);
    }
#endif

    if (!pc) {
	/* bytecode is starting from scratch */
	pc = codePtr->codeStart;







|







2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
#endif

    TEBC_DATA_DIG();

#ifdef TCL_COMPILE_DEBUG
    if (!pc && (tclTraceExec >= 2)) {
	PrintByteCodeInfo(codePtr);
	fprintf(stdout, "  Starting stack top=%" TCL_Z_MODIFIER "u\n", CURR_DEPTH);
	fflush(stdout);
    }
#endif

    if (!pc) {
	/* bytecode is starting from scratch */
	pc = codePtr->codeStart;
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
#ifdef TCL_COMPILE_DEBUG
    /*
     * Skip the stack depth check if an expansion is in progress.
     */

    CHECK_STACK();
    if (traceInstructions) {
	fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
	TclPrintInstruction(codePtr, pc);
	fflush(stdout);
    }
#endif /* TCL_COMPILE_DEBUG */

    TCL_DTRACE_INST_NEXT();








|







2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
#ifdef TCL_COMPILE_DEBUG
    /*
     * Skip the stack depth check if an expansion is in progress.
     */

    CHECK_STACK();
    if (traceInstructions) {
	fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u ", iPtr->numLevels, CURR_DEPTH);
	TclPrintInstruction(codePtr, pc);
	fflush(stdout);
    }
#endif /* TCL_COMPILE_DEBUG */

    TCL_DTRACE_INST_NEXT();

2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665

2666
2667
2668
2669
2670
2671
2672
2673
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);
	TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc));
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	size_t i;

	ptrdiff_t moved;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.
	 */








|


|











|










>
|







2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr2 = UINT2PTR(CURR_DEPTH);
	objPtr->length = 0;
	PUSH_TAUX_OBJ(objPtr);
	TRACE(("=> mark depth as %" TCL_Z_MODIFIER "u\n", CURR_DEPTH));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_EXPAND_DROP:
	/*
	 * Drops an element of the auxObjList, popping stack elements to
	 * restore the stack to the state before the point where the aux
	 * element was created.
	 */

	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc));
	NEXT_INST_V(1, objc, 0);

    case INST_EXPAND_STKTOP: {
	size_t i;
	TEBCdata *newTD;
	ptrdiff_t oldCatchTopOff, oldTosPtrOff;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.
	 */

2688
2689
2690
2691
2692
2693
2694



2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714

	auxObjList->length += objc - 1;
	if ((objc > 1) && (auxObjList->length > 0)) {
	    length = auxObjList->length /* Total expansion room we need */
		    + codePtr->maxStackDepth /* Beyond the original max */
		    - CURR_DEPTH;	/* Relative to where we are */
	    DECACHE_STACK_INFO();



	    moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
		    - (Tcl_Obj **) TD;
	    if (moved) {
		/*
		 * Change the global data to point to the new stack: move the
		 * TEBCdataPtr TD, recompute the position of every other
		 * stack-allocated parameter, update the stack pointers.
		 */

		TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);

		catchTop += moved;
		tosPtr += moved;
	    }
	}

	/*
	 * Expand the list at stacktop onto the stack; free the list. Knowing
	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
	 */







>
>
>
|
<
|






|

|
|







2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699

2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717

	auxObjList->length += objc - 1;
	if ((objc > 1) && (auxObjList->length > 0)) {
	    length = auxObjList->length /* Total expansion room we need */
		    + codePtr->maxStackDepth /* Beyond the original max */
		    - CURR_DEPTH;	/* Relative to where we are */
	    DECACHE_STACK_INFO();
	    oldCatchTopOff = catchTop - initCatchTop;
	    oldTosPtrOff = tosPtr - initTosPtr;
	    newTD = (TEBCdata *)
		    GrowEvaluationStack(iPtr->execEnvPtr, length, 1);

	    if (newTD != TD) {
		/*
		 * Change the global data to point to the new stack: move the
		 * TEBCdataPtr TD, recompute the position of every other
		 * stack-allocated parameter, update the stack pointers.
		 */

		TD = newTD;

		catchTop = initCatchTop + oldCatchTopOff;
		tosPtr = initTosPtr + oldTosPtrOff;
	    }
	}

	/*
	 * Expand the list at stacktop onto the stack; free the list. Knowing
	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
	 */
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
	TEBC_YIELD();
	/* add TEBCResume for object at top of stack */
	return TclNRExecuteByteCode(interp,
		    TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*







|







2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
	TEBC_YIELD();
	/* add TEBCResume for object at top of stack */
	return TclNRExecuteByteCode(interp,
		    TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);

	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;
	    Tcl_IncrRefCount(newValue);
	}
	if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
		!= TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);








|







3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
	if (Tcl_IsShared(objResultPtr)) {
	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);

	    TclDecrRefCount(objResultPtr);
	    varPtr->value.objPtr = objResultPtr = newValue;
	    Tcl_IncrRefCount(newValue);
	}
	if (TclListObjAppendElements(interp, objResultPtr, objc, objv)
		!= TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);

3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (Tcl_ListObjReplace(interp, valueToAssign, len, 0,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
			TclDecrRefCount(valueToAssign);
		    }
		    goto errorInLappendListPtr;
		}
	    }







|







3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
	    } else {
		if (Tcl_IsShared(objResultPtr)) {
		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
		    createdNewObj = 1;
		} else {
		    valueToAssign = objResultPtr;
		}
		if (TclListObjAppendElements(interp, valueToAssign,
			objc, objv) != TCL_OK) {
		    if (createdNewObj) {
			TclDecrRefCount(valueToAssign);
		    }
		    goto errorInLappendListPtr;
		}
	    }
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
		} else {
		    int shift = (int) w2;

		    /*
		     * Handle shifts within the native long range.
		     */

		    if (((size_t) shift < CHAR_BIT*sizeof(long))
			    && !((w1>0 ? w1 : ~w1) &
				-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
			wResult = (Tcl_WideUInt)w1 << shift;
			goto wideResultOfArithmetic;
		    }
		}








|







5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
		} else {
		    int shift = (int) w2;

		    /*
		     * Handle shifts within the native long range.
		     */

		    if (((size_t)shift < CHAR_BIT*sizeof(long))
			    && !((w1>0 ? w1 : ~w1) &
				-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
			wResult = (Tcl_WideUInt)w1 << shift;
			goto wideResultOfArithmetic;
		    }
		}

6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.
	 */

	*(++catchTop) = CURR_DEPTH;
	TRACE(("%u => catchTop=%d, stackTop=%d\n",
		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
		(int) CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);
    break;

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	result = TCL_OK;
	TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_PUSH_RESULT:
	objResultPtr = Tcl_GetObjResult(interp);
	TRACE_WITH_OBJ(("=> "), objResultPtr);








|
|
|
|









|







6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.
	 */

	*(++catchTop) = (Tcl_Obj *)UINT2PTR(CURR_DEPTH);
	TRACE(("%u => catchTop=%" TCL_Z_MODIFIER "u, stackTop=%" TCL_Z_MODIFIER "u\n",
		TclGetUInt4AtPtr(pc+1), (size_t)(catchTop - initCatchTop - 1),
		CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);
    break;

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();
	result = TCL_OK;
	TRACE(("=> catchTop=%" TCL_Z_MODIFIER "u\n", (size_t)(catchTop - initCatchTop - 1)));
	NEXT_INST_F(1, 0, 0);
    break;

    case INST_PUSH_RESULT:
	objResultPtr = Tcl_GetObjResult(interp);
	TRACE_WITH_OBJ(("=> "), objResultPtr);

7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop)
		    && (*catchTop > (ptrdiff_t)
			auxObjList->internalRep.twoPtrValue.ptr2)) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with







|
|







7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop)
		    && (PTR2UINT(*catchTop) >
			PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2))) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
7423
7424
7425
	 * "exception". It was found either by checkForCatch just above or by
	 * an instruction during break, continue, or error processing. Jump to
	 * its catchOffset after unwinding the operand stack to the depth it
	 * had when starting to execute the range's catch command.
	 */

    processCatch:
	while (CURR_DEPTH > *catchTop) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%d, "
		    "unwound to %ld, new pc %" TCL_Z_MODIFIER "u\n",
		    rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
		    (long)*catchTop, rangePtr->catchOffset);
	}
#endif
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */

	/*
	 * end of infinite loop dispatching on instructions.







|





|
|
|
|







7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
7423
7424
7425
7426
7427
7428
	 * "exception". It was found either by checkForCatch just above or by
	 * an instruction during break, continue, or error processing. Jump to
	 * its catchOffset after unwinding the operand stack to the depth it
	 * had when starting to execute the range's catch command.
	 */

    processCatch:
	while (CURR_DEPTH > PTR2UINT(*catchTop)) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%" TCL_Z_MODIFIER "u, "
		    "unwound to %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
		    rangePtr->codeOffset, (size_t)(catchTop - initCatchTop - 1),
		    PTR2UINT(*catchTop), (size_t)rangePtr->catchOffset);
	}
#endif
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */

	/*
	 * end of infinite loop dispatching on instructions.
7448
7449
7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
	    objPtr = POP_OBJECT();
	    Tcl_DecrRefCount(objPtr);
	}

	if (tosPtr < initTosPtr) {
	    fprintf(stderr,
		    "\nTclNRExecuteByteCode: abnormal return at pc %" TCL_Z_MODIFIER "u: "
		    "stack top %d < entry stack top %d\n",
		    (size_t)(pc - codePtr->codeStart),
		    (int) CURR_DEPTH, 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    TclReleaseByteCode(codePtr);







|

|







7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
7465
7466
7467
	    objPtr = POP_OBJECT();
	    Tcl_DecrRefCount(objPtr);
	}

	if (tosPtr < initTosPtr) {
	    fprintf(stderr,
		    "\nTclNRExecuteByteCode: abnormal return at pc %" TCL_Z_MODIFIER "u: "
		    "stack top %" TCL_Z_MODIFIER "u < entry stack top %d\n",
		    (size_t)(pc - codePtr->codeStart),
		    CURR_DEPTH, 0);
	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
	}
	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    TclReleaseByteCode(codePtr);
8688
8689
8690
8691
8692
8693
8694
8695

8696
8697
8698
8699
8700
8701
8702
8703
8704
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    ((float)codePtr->structureSize)/codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    fprintf(stdout, "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",

	    codePtr->structureSize,
	    sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    numAuxDataItems * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {







|
>

|







8691
8692
8693
8694
8695
8696
8697
8698
8699
8700
8701
8702
8703
8704
8705
8706
8707
8708
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    ((float)codePtr->structureSize)/codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    fprintf(stdout, "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER
        "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
	    codePtr->structureSize,
	    offsetof(ByteCode, localCachePtr),
	    codePtr->numCodeBytes,
	    codePtr->numLitObjects * sizeof(Tcl_Obj *),
	    codePtr->numExceptRanges*sizeof(ExceptionRange),
	    numAuxDataItems * sizeof(AuxData),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */
    if (procPtr != NULL) {
8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744
8745
8746
8747
8748

8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
8772
8773
8774
#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(
    ByteCode *codePtr,	/* The bytecode whose summary is printed to
				 * stdout. */
    const unsigned char *pc,	/* Points to first byte of a bytecode
				 * instruction. The program counter. */
    int stackTop,		/* Current stack top. Must be between
				 * stackLowerBound and stackUpperBound
				 * (inclusive). */
    int checkStack)		/* 0 if the stack depth check should be
				 * skipped. */
{
    int stackUpperBound = codePtr->maxStackDepth;
				/* Greatest legal value for stackTop. */
    size_t relativePc = pc - codePtr->codeStart;
    const unsigned char *codeStart = codePtr->codeStart;

    const unsigned char *codeEnd = codePtr->codeStart + codePtr->numCodeBytes;
    unsigned char opCode = *pc;

    if ((pc < codeStart) || (pc > codeEnd)) {
	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
		pc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
    }
    if (opCode >= LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    ((stackTop < 0) || (stackTop > stackUpperBound))) {
	size_t numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "\n executing ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);







|





|

|
|
>
|


|










|



|







8736
8737
8738
8739
8740
8741
8742
8743
8744
8745
8746
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
8772
8773
8774
8775
8776
8777
8778
8779
#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(
    ByteCode *codePtr,	/* The bytecode whose summary is printed to
				 * stdout. */
    const unsigned char *pc,	/* Points to first byte of a bytecode
				 * instruction. The program counter. */
    size_t stackTop,		/* Current stack top. Must be between
				 * stackLowerBound and stackUpperBound
				 * (inclusive). */
    int checkStack)		/* 0 if the stack depth check should be
				 * skipped. */
{
    size_t stackUpperBound = codePtr->maxStackDepth;
				/* Greatest legal value for stackTop. */
    size_t relativePc = (size_t)(pc - codePtr->codeStart);
    size_t codeStart = (size_t)codePtr->codeStart;
    size_t codeEnd = (size_t)
	    (codePtr->codeStart + codePtr->numCodeBytes);
    unsigned char opCode = *pc;

    if ((PTR2UINT(pc) < codeStart) || (PTR2UINT(pc) > codeEnd)) {
	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
		pc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
    }
    if (opCode >= LAST_INST_OPCODE) {
	fprintf(stderr, "\nBad opcode %u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
		opCode, relativePc);
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
    }
    if (checkStack &&
	    (stackTop > stackUpperBound)) {
	size_t numChars;
	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);

	fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "\n executing ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
9320
9321
9322
9323
9324
9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
	    + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj))
	    + statsPtr->totalLitStringBytes;
    totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes;

    numCurrentByteCodes =
	    statsPtr->numCompilations - statsPtr->numByteCodesFreed;
    currentHeaderBytes = numCurrentByteCodes
	    * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time));
    literalMgmtBytes = sizeof(LiteralTable)
	    + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
	    + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
    currentLiteralBytes = literalMgmtBytes
	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
	    + statsPtr->currentLitStringBytes;
    currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;







|







9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
	    + (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj))
	    + statsPtr->totalLitStringBytes;
    totalCodeBytes = statsPtr->totalByteCodeBytes + totalLiteralBytes;

    numCurrentByteCodes =
	    statsPtr->numCompilations - statsPtr->numByteCodesFreed;
    currentHeaderBytes = numCurrentByteCodes
	    * offsetof(ByteCode, localCachePtr);
    literalMgmtBytes = sizeof(LiteralTable)
	    + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
	    + (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
    currentLiteralBytes = literalMgmtBytes
	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
	    + statsPtr->currentLitStringBytes;
    currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
Changes to generic/tclHash.c.
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count = tablePtr->keyType;
    TCL_HASH_TYPE size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);

    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------







<
<

|
|






|
<
<
<







655
656
657
658
659
660
661


662
663
664
665
666
667
668
669
670
671



672
673
674
675
676
677
678
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
{


    Tcl_HashEntry *hPtr;
    TCL_HASH_TYPE count = tablePtr->keyType * sizeof(int);
    TCL_HASH_TYPE size = offsetof(Tcl_HashEntry, key) + count;

    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(size);

    memcpy(hPtr->key.string, keyPtr, count);



    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
 */

static int
CompareArrayKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    const int *iPtr1 = (const int *)keyPtr;
    const int *iPtr2 = hPtr->key.words;
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
    int count;

    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	if (count == 0) {
	    return 1;
	}
	if (*iPtr1 != *iPtr2) {
	    break;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * HashArrayKey --
 *







<
<
|
<

<
<
|
<
<
<
<
<
<







692
693
694
695
696
697
698


699

700


701






702
703
704
705
706
707
708
 */

static int
CompareArrayKeys(
    void *keyPtr,			/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{


    size_t count = hPtr->tablePtr->keyType * sizeof(int);




    return !memcmp(keyPtr, hPtr->key.string, count);






}

/*
 *----------------------------------------------------------------------
 *
 * HashArrayKey --
 *
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}

/*
 *----------------------------------------------------------------------







|







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
    size_t size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memset(hPtr, 0, offsetof(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}

/*
 *----------------------------------------------------------------------
Changes to generic/tclIndexObj.c.
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
	}

	/*
	 * Append a space character (" ") if there is more text to follow
	 * (either another element from objv, or the message string).
	 */

	if (i<objc-1 || message!=NULL) {
	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
	}
    }

    /*
     * Add any trailing message bits and set the resulting string as the
     * interpreter result. Caller is responsible for reporting this as an







|







940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
	}

	/*
	 * Append a space character (" ") if there is more text to follow
	 * (either another element from objv, or the message string).
	 */

	if (i + 1 < objc || message!=NULL) {
	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
	}
    }

    /*
     * Add any trailing message bits and set the resulting string as the
     * interpreter result. Caller is responsible for reporting this as an
Changes to generic/tclInt.decls.
578
579
580
581
582
583
584
585
586
587











588
589
590
591
592
593
594
}

# TIP 431: temporary directory creation function
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}
declare 261 {
    int	TclMSB(size_t n)
}











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

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

interface tclIntPlat







|


>
>
>
>
>
>
>
>
>
>
>







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
}

# TIP 431: temporary directory creation function
declare 258 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}
declare 259 {
    int	TclMSB(size_t n)
}

# TIP 625: for unit testing - create list objects with span
declare 260 {
    Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}

# TIP 625: for unit testing - check list invariants
declare 261 {
    void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}

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

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

interface tclIntPlat
Changes to generic/tclInt.h.
278
279
280
281
282
283
284

285



286
287
288
289
290
291
292
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif

    size_t nsId;		/* Unique id for the namespace. */



    Tcl_Interp *interp;	/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    size_t activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be







>

>
>
>







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
#if TCL_MAJOR_VERSION > 8
    size_t nsId;		/* Unique id for the namespace. */
#else
    unsigned long nsId;
#endif
    Tcl_Interp *interp;	/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    size_t activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
1837
1838
1839
1840
1841
1842
1843

1844










1845
1846
1847
1848
1849
1850
1851
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    void *interpInfo;	/* Information used by tclInterp.c to keep
				 * track of parent/child interps on a
				 * per-interp basis. */

    void (*optimizer)(void *envPtr);










    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    size_t numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this







>

>
>
>
>
>
>
>
>
>
>







1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    void *interpInfo;	/* Information used by tclInterp.c to keep
				 * track of parent/child interps on a
				 * per-interp basis. */
#if TCL_MAJOR_VERSION > 8
    void (*optimizer)(void *envPtr);
#else
    union {
	void (*optimizer)(void *envPtr);
	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
				 * unused space in interp was repurposed for
				 * pluggable bytecode optimizers. The core
				 * contains one optimizer, which can be
				 * selectively overridden by extensions. */
    } extra;
#endif
    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    size_t numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323

2324
2325
2326
2327
2328
2329
2330
2331
2332
2333










2334

2335
2336
2337
2338
2339
2340
2341
#if defined(__APPLE__)
#define TCL_ALLOCALIGN	16
#else
#define TCL_ALLOCALIGN	(2*sizeof(void *))
#endif

/*
 * This macro is used to determine the offset needed to safely allocate any
 * data structure in memory. Given a starting offset or size, it "rounds up"
 * or "aligns" the offset to the next 8-byte boundary so that any data
 * structure can be placed at the resulting offset without fear of an
 * alignment error.

 *
 * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce the
 * wrong result on platforms that allocate addresses that are divisible by 4
 * or 2. Only use it for offsets or sizes.
 *
 * This macro is only used by tclCompile.c in the core (Bug 926445). It
 * however not be made file static, as extensions that touch bytecodes
 * (notably tbcload) require it.
 */











#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)


/*
 * A common panic alert when memory allocation fails.
 */

#define TclOOM(ptr, size) \
	((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1)))







|

|
|
|
>


|
|






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







2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
#if defined(__APPLE__)
#define TCL_ALLOCALIGN	16
#else
#define TCL_ALLOCALIGN	(2*sizeof(void *))
#endif

/*
 * TCL_ALIGN is used to determine the offset needed to safely allocate any
 * data structure in memory. Given a starting offset or size, it "rounds up"
 * or "aligns" the offset to the next aligned (typically 8-byte) boundary so
 * that any data structure can be placed at the resulting offset without fear
 * of an alignment error. Note this is clamped to a minimum of 8 for API
 * compatibility.
 *
 * WARNING!! DO NOT USE THIS MACRO TO ALIGN POINTERS: it will produce the
 * wrong result on platforms that allocate addresses that are divisible by a
 * non-trivial factor of this alignment. Only use it for offsets or sizes.
 *
 * This macro is only used by tclCompile.c in the core (Bug 926445). It
 * however not be made file static, as extensions that touch bytecodes
 * (notably tbcload) require it.
 */

struct TclMaxAlignment {
    char unalign[8];
    union {
	long long maxAlignLongLong;
	double maxAlignDouble;
	void *maxAlignPointer;
    } aligned;
};
#define TCL_ALIGN_BYTES \
	offsetof(struct TclMaxAlignment, aligned)
#define TCL_ALIGN(x) \
	(((x) + (TCL_ALIGN_BYTES - 1)) & ~(TCL_ALIGN_BYTES - 1))

/*
 * A common panic alert when memory allocation fails.
 */

#define TclOOM(ptr, size) \
	((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1)))
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391

2392
2393
2394





2395

2396
2397

2398

2399
2400




2401





2402










2403










2404





2405

2406

2407

2408












2409
2410








2411










2412
2413











2414












2415
2416

2417

2418



2419


2420

2421


2422




2423

2424


2425






2426


























2427
2428
2429

2430

2431





2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
 */

#define	TCL_INVOKE_HIDDEN	(1<<0)
#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
#define TCL_INVOKE_NO_TRACEBACK	(1<<2)

/*
 * The structure used as the internal representation of Tcl list objects. This
 * struct is grown (reallocated and copied) as necessary to hold all the
 * list's element pointers. The struct might contain more slots than currently
 * used to hold all element pointers. This is done to make append operations
 * faster.
 */


typedef struct List {
    size_t refCount;





    size_t maxElemCount;		/* Total number of element array slots. */

    size_t elemCount;		/* Current number of list elements. */
    int canonicalFlag;		/* Set if the string representation was

				 * derived from the list representation. May

				 * be ignored if there is no string rep at
				 * all.*/




    Tcl_Obj *elements[TCLFLEXARRAY];		/* First list element; the struct is grown to





				 * accommodate all elements. */










} List;
















#define LIST_MAX \

	((int)(((size_t)UINT_MAX - offsetof(List, elements))/sizeof(Tcl_Obj *)))

#define LIST_SIZE(numElems) \

	(TCL_HASH_TYPE)(offsetof(List, elements) + ((numElems) * sizeof(Tcl_Obj *)))













/*








 * Macro used to get the elements of a list object.










 */












#define ListRepPtr(listPtr) \












    ((List *) (listPtr)->internalRep.twoPtrValue.ptr1)


#define ListObjGetElements(listPtr, objc, objv) \

    ((objv) = ListRepPtr(listPtr)->elements, \



     (objc) = ListRepPtr(listPtr)->elemCount)




#define ListObjLength(listPtr, len) \


    ((len) = ListRepPtr(listPtr)->elemCount)






#define ListObjIsCanonical(listPtr) \


    (((listPtr)->bytes == NULL) || ListRepPtr(listPtr)->canonicalFlag)

































#define TclListObjGetElementsM(interp, listPtr, objcPtr, objvPtr) \
    (((listPtr)->typePtr == &tclListType) \
	    ? ((ListObjGetElements((listPtr), *(objcPtr), *(objvPtr))), TCL_OK)\

	    : Tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)))







#define TclListObjLengthM(interp, listPtr, lenPtr) \
    (((listPtr)->typePtr == &tclListType) \
	    ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
	    : Tcl_ListObjLength((interp), (listPtr), (lenPtr)))

#define TclListObjIsCanonical(listPtr) \
    (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */







|
|
<
<
<

>

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

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


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


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

>
|
>
|
>
>
>
|
>
>

>
|
>
>
|
>
>
>
>

>
|
>
>
|
>
>
>
>
>
>

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

>
>
>
>
>
|
|
|
|

|
|







2406
2407
2408
2409
2410
2411
2412
2413
2414



2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
 */

#define	TCL_INVOKE_HIDDEN	(1<<0)
#define TCL_INVOKE_NO_UNKNOWN	(1<<1)
#define TCL_INVOKE_NO_TRACEBACK	(1<<2)

/*
 * ListSizeT is the type for holding list element counts. It's defined
 * simplify sharing source between Tcl8 and Tcl9.



 */
#if TCL_MAJOR_VERSION > 8

typedef size_t ListSizeT;

/*
 * SSIZE_MAX, NOT SIZE_MAX as negative differences need to be expressed
 * between values of the ListSizeT type so limit the range to signed
 */
#define ListSizeT_MAX ((ListSizeT)PTRDIFF_MAX)

#else

typedef int ListSizeT;
#define ListSizeT_MAX INT_MAX

#endif

/*
 * ListStore --
 *
 * A Tcl list's internal representation is defined through three structures.
 *
 * A ListStore struct is a structure that includes a variable size array that
 * serves as storage for a Tcl list. A contiguous sequence of slots in the
 * array, the "in-use" area, holds valid pointers to Tcl_Obj values that
 * belong to one or more Tcl lists. The unused slots before and after these
 * are free slots that may be used to prepend and append without having to
 * reallocate the struct. The ListStore may be shared amongst multiple lists
 * and reference counted.
 *
 * A ListSpan struct defines a sequence of slots within a ListStore. This sequence
 * always lies within the "in-use" area of the ListStore. Like ListStore, the
 * structure may be shared among multiple lists and is reference counted.
 *
 * A ListRep struct holds the internal representation of a Tcl list as stored
 * in a Tcl_Obj. It is composed of a ListStore and a ListSpan that together
 * define the content of the list. The ListSpan specifies the range of slots
 * within the ListStore that hold elements for this list. The ListSpan is
 * optional in which case the list includes all the "in-use" slots of the
 * ListStore.
 *
 */
typedef struct ListStore {
    ListSizeT firstUsed;    /* Index of first slot in use within slots[] */
    ListSizeT numUsed;      /* Number of slots in use (starting firstUsed) */
    ListSizeT numAllocated; /* Total number of slots[] array slots. */
    size_t refCount;           /* Number of references to this instance */
    int flags;              /* LISTSTORE_* flags */
    Tcl_Obj *slots[TCLFLEXARRAY];      /* Variable size array. Grown as needed */
} ListStore;

#define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this
                                   store have their string representation
                                   derived from the list representation */

/* Max number of elements that can be contained in a list */
#define LIST_MAX                                               \
    ((ListSizeT_MAX - offsetof(ListStore, slots)) \
		   / sizeof(Tcl_Obj *))
/* Memory size needed for a ListStore to hold numSlots_ elements */
#define LIST_SIZE(numSlots_) \
	(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))

/*
 * ListSpan --
 * See comments above for ListStore
 */
typedef struct ListSpan {
    ListSizeT spanStart;    /* Starting index of the span */
    ListSizeT spanLength;   /* Number of elements in the span */
    size_t refCount;     /* Count of references to this span record */
} ListSpan;
#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */
#define LIST_SPAN_THRESHOLD 101
#endif

/*
 * ListRep --
 * See comments above for ListStore
 */
typedef struct ListRep {
    ListStore *storePtr;/* element array shared amongst different lists */
    ListSpan *spanPtr;  /* If not NULL, the span holds the range of slots
                           within *storePtr that contain this list elements. */
} ListRep;

/*
 * Macros used to get access list internal representations.
 *
 * Naming conventions:
 * ListRep* - expect a pointer to a valid ListRep
 * ListObj* - expect a pointer to a Tcl_Obj whose internal type is known to
 *            be a list (tclListType). Will crash otherwise.
 * TclListObj* - expect a pointer to a Tcl_Obj whose internal type may or may not
 *            be tclListType. These will convert as needed and return error if
 *            conversion not possible.
 */

/* Returns the starting slot for this listRep in the contained ListStore */
#define ListRepStart(listRepPtr_)                               \
    ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \
			    : (listRepPtr_)->storePtr->firstUsed)

/* Returns the number of elements in this listRep */
#define ListRepLength(listRepPtr_)                               \
    ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \
			    : (listRepPtr_)->storePtr->numUsed)

/* Returns a pointer to the first slot containing this ListRep elements */
#define ListRepElementsBase(listRepPtr_) \
    (&(listRepPtr_)->storePtr->slots[ListRepStart(listRepPtr_)])

/* Stores the number of elements and base address of the element array */
#define ListRepElements(listRepPtr_, objc_, objv_) \
    (((objv_) = ListRepElementsBase(listRepPtr_)), \
     ((objc_) = ListRepLength(listRepPtr_)))

/* Returns 1/0 whether the ListRep's ListStore is shared. */
#define ListRepIsShared(listRepPtr_) ((listRepPtr_)->storePtr->refCount > 1)

/* Returns a pointer to the ListStore component */
#define ListObjStorePtr(listObj_) \
    ((ListStore *)((listObj_)->internalRep.twoPtrValue.ptr1))

/* Returns a pointer to the ListSpan component */
#define ListObjSpanPtr(listObj_) \
    ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2))

/* Returns the ListRep internal representaton in a Tcl_Obj */
#define ListObjGetRep(listObj_, listRepPtr_)                 \
    do {                                                     \
	(listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \
	(listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_);   \
    } while (0)

/* Returns the length of the list */
#define ListObjLength(listObj_, len_)                                         \
    ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \
				       : ListObjStorePtr(listObj_)->numUsed)

/* Returns the starting slot index of this list's elements in the ListStore */
#define ListObjStart(listObj_)                                      \
    (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \
			      : ListObjStorePtr(listObj_)->firstUsed)

/* Stores the element count and base address of this list's elements */
#define ListObjGetElements(listObj_, objc_, objv_) \
    (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \
     (ListObjLength(listObj_, (objc_))))

/*
 * Returns 1/0 whether the internal representation (not the Tcl_Obj itself)
 * is shared.  Note by intent this only checks for sharing of ListStore,
 * not spans.
 */
#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1)

/*
 * Certain commands like concat are optimized if an existing string
 * representation of a list object is known to be in canonical format (i.e.
 * generated from the list representation). There are three conditions when
 * this will be the case:
 * (1) No string representation exists which means it will obviously have
 * to be generated from the list representation when needed
 * (2) The ListStore flags is marked canonical. This is done at the time
 * the string representation is generated from the list IF the list
 * representation does not have a span (see comments in UpdateStringOfList).
 * (3) The list representation does not have a span component. This is
 * because list Tcl_Obj's with spans are always created from existing lists
 * and never from strings (see SetListFromAny) and thus their string
 * representation will always be canonical.
 */
#define ListObjIsCanonical(listObj_)                             \
    (((listObj_)->bytes == NULL)                                 \
     || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \
     || ListObjSpanPtr(listObj_) != NULL)

/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count and base address of this list's elements in objcPtr_ and objvPtr_.
 * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be
 * converted to a list.
 */
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_)    \
    (((listObj_)->typePtr == &tclListType)                              \
	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
	    TCL_OK)                                                     \
	 : Tcl_ListObjGetElements(                                      \
	     (interp_), (listObj_), (objcPtr_), (objvPtr_)))

/*
 * Converts the Tcl_Obj to a list if it isn't one and stores the element
 * count in lenPtr_.  Returns TCL_OK on success or TCL_ERROR if the
 * Tcl_Obj cannot be converted to a list.
 */
#define TclListObjLengthM(interp_, listObj_, lenPtr_)         \
    (((listObj_)->typePtr == &tclListType)                   \
	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))

#define TclListObjIsCanonical(listObj_) \
    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
			    ClientData clientData, int *flagPtr, int value);
MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
MODULE_SCOPE void	TclBAConvertIndices(size_t index, unsigned int *hiPtr,
			    unsigned int *loPtr);
MODULE_SCOPE size_t	TclBAInvertIndices(unsigned int hi, unsigned int lo);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    size_t strLen, const unsigned char *pattern,







|







3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
			    void *clientData, int *flagPtr, int value);
MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
MODULE_SCOPE void	TclBAConvertIndices(size_t index, unsigned int *hiPtr,
			    unsigned int *loPtr);
MODULE_SCOPE size_t	TclBAInvertIndices(unsigned int hi, unsigned int lo);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    size_t strLen, const unsigned char *pattern,
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
MODULE_SCOPE double	TclFloor(const void *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,







<
|







3217
3218
3219
3220
3221
3222
3223

3224
3225
3226
3227
3228
3229
3230
3231
MODULE_SCOPE double	TclFloor(const void *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,

			    void *clientData, Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
3115
3116
3117
3118
3119
3120
3121



3122
3123
3124
3125
3126
3127
3128
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, size_t line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);



MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx,
			    size_t toIdx);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);







>
>
>







3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, size_t line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
			    Tcl_Obj *toObj, size_t elemCount,
			    Tcl_Obj *const elemObjv[]);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx,
			    size_t toIdx);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    size_t indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    size_t len);
MODULE_SCOPE void	TclpAlertNotifier(ClientData clientData);
MODULE_SCOPE ClientData	TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
MODULE_SCOPE void	TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int	TclpWaitForEvent(const Tcl_Time *timePtr);
MODULE_SCOPE void	TclpCreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, ClientData clientData);
MODULE_SCOPE int	TclpDeleteFile(const void *path);
MODULE_SCOPE void	TclpDeleteFileHandler(int fd);
MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void	TclpFinalizeNotifier(ClientData clientData);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
			    struct addrinfo **addrlist,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, void *clientData,
			    size_t stackSize, int flags);
MODULE_SCOPE size_t	TclpFindVariable(const char *name, size_t *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE ClientData	TclpInitNotifier(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpGlobalLock(void);
MODULE_SCOPE void	TclpGlobalUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
			    Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
			    int linkType);
MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);







|
|




|




|













|


















|







3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
			    int code, int level, Tcl_Obj *returnOpts);
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
			    Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    size_t len);
MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
MODULE_SCOPE void *TclpNotifierData(void);
MODULE_SCOPE void	TclpServiceModeHook(int mode);
MODULE_SCOPE void	TclpSetTimer(const Tcl_Time *timePtr);
MODULE_SCOPE int	TclpWaitForEvent(const Tcl_Time *timePtr);
MODULE_SCOPE void	TclpCreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, void *clientData);
MODULE_SCOPE int	TclpDeleteFile(const void *path);
MODULE_SCOPE void	TclpDeleteFileHandler(int fd);
MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void	TclpFinalizeNotifier(void *clientData);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
			    struct addrinfo **addrlist,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, void *clientData,
			    size_t stackSize, int flags);
MODULE_SCOPE size_t	TclpFindVariable(const char *name, size_t *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void *TclpInitNotifier(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpGlobalLock(void);
MODULE_SCOPE void	TclpGlobalUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
			    Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void *TclpGetNativeCwd(void *clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
			    int linkType);
MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
	((((unsigned char) *(str)) < 0x80) ?		\
	    ((*(chPtr) = (unsigned char) *(str)), 1)	\
	    : Tcl_UtfToChar16(str, chPtr))
#endif

/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfCharsM(size_t numChars, const char *bytes,
 *				size_t numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfCharsM(numChars, bytes, numBytes) \
    do { \
	size_t _count, _i = (numBytes); \







|
|










|







4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToChar16(str, chPtr))
#endif

/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfCharsM(int | size_t numChars, const char *bytes,
 *				size_t numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfCharsM(numChars, bytes, numBytes) \
    do { \
	size_t _count, _i = (numBytes); \
Changes to generic/tclIntDecls.h.
572
573
574
575
576
577
578
579

580


581
582

583
584
585
586
587
588
589
EXTERN void		TclStaticLibrary(Tcl_Interp *interp,
				const char *prefix,
				Tcl_LibraryInitProc *initProc,
				Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* Slot 259 is reserved */

/* Slot 260 is reserved */


/* 261 */
EXTERN int		TclMSB(size_t n);


typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);







|
>
|
>
>

|
>







572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
EXTERN void		TclStaticLibrary(Tcl_Interp *interp,
				const char *prefix,
				Tcl_LibraryInitProc *initProc,
				Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */
EXTERN int		TclMSB(size_t n);
/* 260 */
EXTERN Tcl_Obj *	TclListTestObj(int length, int leadingSpace,
				int endSpace);
/* 261 */
EXTERN void		TclListObjValidate(Tcl_Interp *interp,
				Tcl_Obj *listObj);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
840
841
842
843
844
845
846
847
848
849


850
851
852
853
854
855
856
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*reserved259)(void);
    void (*reserved260)(void);
    int (*tclMSB) (size_t n); /* 261 */


} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif







<
<
|
>
>







844
845
846
847
848
849
850


851
852
853
854
855
856
857
858
859
860
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */


    int (*tclMSB) (size_t n); /* 259 */
    Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
    void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267




1268
1269
1270
1271
1272
1273
1274
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticLibrary \
	(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
/* Slot 259 is reserved */
/* Slot 260 is reserved */
#define TclMSB \
	(tclIntStubsPtr->tclMSB) /* 261 */





#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticLibrary







<
<

|
>
>
>
>







1261
1262
1263
1264
1265
1266
1267


1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticLibrary \
	(tclIntStubsPtr->tclStaticLibrary) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */


#define TclMSB \
	(tclIntStubsPtr->tclMSB) /* 259 */
#define TclListTestObj \
	(tclIntStubsPtr->tclListTestObj) /* 260 */
#define TclListObjValidate \
	(tclIntStubsPtr->tclListObjValidate) /* 261 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticLibrary
Changes to generic/tclInterp.c.
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843

1844

1845
1846
1847


1848

1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *listPtr;
    List *listRep;
    int flags = TCL_EVAL_INVOKE;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the target interp's global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;


    listPtr = Tcl_NewListObj(cmdc, NULL);

    listRep = ListRepPtr(listPtr);
    listRep->elemCount = cmdc;
    cmdv = listRep->elements;




    prefv = &aliasPtr->objPtr;
    memcpy(cmdv, prefv, (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:







|











>

>
|
|
|
>
>
|
>

|
|







1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *listPtr;
    ListRep listRep;
    int flags = TCL_EVAL_INVOKE;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the target interp's global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;

    /* TODO - encapsulate this into tclListObj.c */
    listPtr = Tcl_NewListObj(cmdc, NULL);
    ListObjGetRep(listPtr, &listRep);
    cmdv = ListRepElementsBase(&listRep);
    listRep.storePtr->numUsed = cmdc;
    if (listRep.spanPtr) {
	listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
	listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
    }

    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:
Changes to generic/tclListObj.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17







































































































18
19
20



21

22



23








24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50






















































































































51
















52












53









54


55























56



57























58










59


















60

61































62





















63








64































65










66

67













68























69


70

71


72






































































73

























































































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

86

87
88
89
90


91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107

















108




109
110
111
112
113
114
115
116
117
118
119




















120
121
122
123
124
125
126
127
128
129
130
131
132
133





































134
135



136

137
138
139





































140














141




142






















143
144
145
146
147
148
149
150
151

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



165


























166





































167




























168
169
170
171
172
173
174

175
176


177
178


179

180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240



241
242
243
244
245
246











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





































































































299
300
301
302
303
304
305



306








307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333

334
335
336


337
338
339


340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386

































































































































































































387
388
389
390
391
392
393
394
395
396
397
398
399


400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482

483
484



485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562

563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596


597


















































































































































598
599
600
601
602
603
604
605



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

623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788

789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816

817
818
819
820

821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850


851
852
853
854
855
856


857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878

879

880
881
882
883
884

885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903



904
905
906
907
908

909
910
911
912
913
914
915
916
917

918


919
920
921
922
923
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947







948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996

997
998


999
1000
1001


1002




1003

1004
1005
















1006

1007










1008
1009

1010
1011
1012



1013


1014



1015
1016
1017
1018
1019

1020
1021


1022



1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034











1035





1036















1037
1038
1039
1040
1041
1042
1043
1044


1045
1046
1047
1048






1049
1050

1051






1052







1053
1054
1055
1056
1057


1058




1059
1060
1061
1062
1063

1064
1065


1066
1067



1068
1069




1070










1071
1072

1073
1074

1075
1076




1077
1078

1079
1080
1081
1082

1083






1084


1085

1086
1087
1088
1089

1090
1091


1092
1093







1094



1095
1096





1097



1098
1099
1100

1101


1102
1103




1104
1105
1106

1107
1108

1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121


1122
1123



1124



1125

1126
1127


















1128
1129






1130
1131
1132







1133
1134
1135
1136
1137









1138














1139
1140
1141
1142


1143



1144

1145
1146

1147
1148






1149
1150
1151


1152

1153






1154
1155
1156
1157
1158





1159
1160
1161
1162






1163
1164
1165
1166
1167


1168
1169
1170
1171
1172
1173
1174



1175
1176
1177



1178
1179

1180


1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201





1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214

1215
1216
1217
1218
1219

1220
1221
1222
1223
1224
1225

1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273



1274
1275
1276

1277
1278




1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318

1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361


1362
1363
1364

1365
1366

1367




1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436

1437

1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457

1458
1459


1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483


1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518







1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558

1559
1560



1561

1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1620

1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647






1648



1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659


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

1682
1683

1684
1685

1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726

1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796

1797

1798

1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833

1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867

1868

1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891

1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903

1904

1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934

1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976


1977
1978
1979
1980
1981



1982

1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007

2008
2009
2010
2011




2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056

2057
2058


2059
2060
2061
2062
2063
2064
2065






2066




2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080

2081
2082

2083
2084

2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110








2111



2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141



2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165























































2166
2167
2168
2169
2170
2171
2172
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *
 * Copyright © 1995-1997 Sun Microsystems, Inc.
 * Copyright © 1998 Scriptics Corporation.
 * Copyright © 2001 Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>

/*







































































































 * Prototypes for functions defined later in this file:
 */




static List *		AttemptNewList(Tcl_Interp *interp, size_t objc,

			    Tcl_Obj *const objv[]);



static List *		NewListInternalRep(size_t objc, Tcl_Obj *const objv[], size_t p);








static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeListInternalRep(Tcl_Obj *listPtr);
static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfList(Tcl_Obj *listPtr);

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is a two-pointer
 * representation. The first pointer designates a List structure that contains
 * an array of pointers to the element objects, together with integers that
 * represent the current element count and the allocated size of the array.
 * The second pointer is normally NULL; during execution of functions in this
 * file that operate on nested sublists, it is occasionally used as working
 * storage to avoid an auxiliary stack.
 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny		/* setFromAnyProc */
};

/* Macros to manipulate the List internal rep */







































































































































#define ListSetInternalRep(objPtr, listRepPtr)				\












    do {								\









	Tcl_ObjInternalRep ir;						\


	ir.twoPtrValue.ptr1 = (listRepPtr);				\























	ir.twoPtrValue.ptr2 = NULL;					\



	(listRepPtr)->refCount++;					\























	Tcl_StoreInternalRep((objPtr), &tclListType, &ir);			\










    } while (0)




















#define ListGetInternalRep(objPtr, listRepPtr)				\































    do {								\





















	const Tcl_ObjInternalRep *irPtr;					\








	irPtr = TclFetchInternalRep((objPtr), &tclListType);		\































	(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL;		\










    } while (0)















#define ListResetInternalRep(objPtr, listRepPtr) \























    TclFetchInternalRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)




#ifndef TCL_MIN_ELEMENT_GROWTH


#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)






































































#endif


























































































/*
 *----------------------------------------------------------------------
 *
 * NewListInternalRep --
 *
 *	Creates a 'List' structure with space for 'objc' elements.  'objc' must
 *	be > 0.  If 'objv' is not NULL, The list is initialized with first
 *	'objc' values in that array.  Otherwise the list is initialized to have
 *	0 elements, with space to add 'objc' more.  Flag value 'p' indicates
 *	how to behave on failure.
 *

 * Value

 *
 *	A new 'List' structure with refCount 0. If some failure
 *	prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
 *	is called if it is not.


 *
 * Effect
 *
 *	The refCount of each value in 'objv' is incremented as it is added
 *	to the list.
 *
 *----------------------------------------------------------------------
 */

static List *
NewListInternalRep(
    size_t objc,
    Tcl_Obj *const objv[],
    size_t p)
{
    List *listRepPtr;



















    listRepPtr = (List *)Tcl_AttemptAlloc(LIST_SIZE(objc));




    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
    listRepPtr->maxElemCount = objc;





















    if (objv) {
	Tcl_Obj **elemPtrs;
	size_t i;

	listRepPtr->elemCount = objc;
	elemPtrs = listRepPtr->elements;
	for (i = 0;  i < objc;  i++) {
	    elemPtrs[i] = objv[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}
    } else {
	listRepPtr->elemCount = 0;
    }





































    return listRepPtr;
}





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





































 *  AttemptNewList --














 *




 *	Like NewListInternalRep, but additionally sets an error message on failure.






















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

static List *
AttemptNewList(
    Tcl_Interp *interp,
    size_t objc,
    Tcl_Obj *const objv[])

{
    List *listRepPtr = NewListInternalRep(objc, objv, 0);

    if (interp != NULL && listRepPtr == NULL) {
	if (objc > LIST_MAX) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc)));
	}



	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);


























    }





































    return listRepPtr;




























}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *

 *	Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
 *	defined, 'Tcl_DbNewListObj' is called instead.


 *
 * Value


 *

 *	A new list 'Tcl_Obj' to which is appended values from 'objv', or if
 *	'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
 *	elements.  The string representation of the new 'Tcl_Obj' is set to
 *	NULL.  The refCount of the list is 0.
 *
 * Effect
 *
 *	The refCount of each elements in 'objv' is incremented as it is added
 *	to the list.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewListObj

Tcl_Obj *
Tcl_NewListObj(
    size_t objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{
    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewListObj(
    size_t objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{
    List *listRepPtr;
    Tcl_Obj *listPtr;

    TclNewObj(listPtr);

    if (objc + 1 <= 1) {
	return listPtr;
    }

    /*
     * Create the internal rep.
     */

    listRepPtr = NewListInternalRep(objc, objv, 1);

    /*
     * Now create the object.
     */

    TclInvalidateStringRep(listPtr);
    ListSetInternalRep(listPtr, listRepPtr);
    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 *  Tcl_DbNewListObj --
 *



 *	Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
 *	file name and line number from its caller.  This simplifies debugging
 *	since the [memory active] command will report the correct file
 *	name and line number when reporting objects that haven't been freed.
 *
 *	When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.











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

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewListObj(
    size_t objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *listPtr;
    List *listRepPtr;

    TclDbNewObj(listPtr, file, line);

    if (objc + 1 <= 1) {
	return listPtr;
    }

    /*
     * Create the internal rep.
     */

    listRepPtr = NewListInternalRep(objc, objv, 1);

    /*
     * Now create the object.
     */

    TclInvalidateStringRep(listPtr);
    ListSetInternalRep(listPtr, listRepPtr);

    return listPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewListObj(
    size_t objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewListObj(objc, objv);
}
#endif /* TCL_MEM_DEBUG */






































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of



 *	creating a new one.








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

void
Tcl_SetListObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    size_t objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{
    List *listRepPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
    }

    /*
     * Free any old string rep and any internal rep for the old type.
     */

    TclFreeInternalRep(objPtr);
    TclInvalidateStringRep(objPtr);

    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type.

     */

    if (objc > 0) {


	listRepPtr = NewListInternalRep(objc, objv, 1);
	ListSetInternalRep(objPtr, listRepPtr);
    } else {


	Tcl_InitStringRep(objPtr, NULL, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
 *	provides for the C level a counterpart of the [lrange $list 0 end]
 *	command, while using internals details to be as efficient as possible.
 *
 * Value
 *
 *	The address of the new 'Tcl_Obj' which shares its internal
 *	representation with 'listPtr', and whose refCount is 0.  If 'listPtr'
 *	is not actually a list, the value is NULL, and an error message is left
 *	in 'interp' if it is not NULL.
 *
 * Effect
 *
 *	'listPtr' is converted to a list if it isn't one already.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyPtr;
    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);
    if (NULL == listRepPtr) {
	if (SetListFromAny(interp, listPtr) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyPtr);
    TclInvalidateStringRep(copyPtr);
    DupListInternalRep(listPtr, copyPtr);
    return copyPtr;

































































































































































































}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjRange --
 *
 *	Makes a slice of a list value.
 *      *listPtr must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced list.
 *      This may be a new object or the same object if not shared.


 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Obj *listPtr,		/* List object to take a range from. */
    size_t fromIdx,		/* Index of first element to include. */
    size_t toIdx)			/* Index of last element to include. */
{
    Tcl_Obj **elemPtrs;
    size_t listLen, i, newLen;
    List *listRepPtr;

    TclListObjGetElementsM(NULL, listPtr, &listLen, &elemPtrs);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }
    if (toIdx + 1 >= listLen + 1) {
	toIdx = listLen-1;
    }
    if (fromIdx + 1 > toIdx + 1) {
	Tcl_Obj *obj;
	TclNewObj(obj);
	return obj;
    }

    newLen = toIdx - fromIdx + 1;

    if (Tcl_IsShared(listPtr) ||
	    ((ListRepPtr(listPtr)->refCount > 1))) {
	return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(listPtr);

    /*
     * Delete elements that should not be included.
     */

    for (i = 0; i < fromIdx; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }
    for (i = toIdx + 1; i < (size_t)listLen; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }

    if (fromIdx > 0) {
	memmove(elemPtrs, &elemPtrs[fromIdx],
		(size_t) newLen * sizeof(Tcl_Obj*));
    }

    listRepPtr = ListRepPtr(listPtr);
    listRepPtr->elemCount = newLen;

    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	Retreive the elements in a list 'Tcl_Obj'.
 *
 * Value
 *
 *	TCL_OK
 *

 *	    A count of list elements is stored, 'objcPtr', And a pointer to the
 *	    array of elements in the list is stored in 'objvPtr'.



 *
 *	    The elements accessible via 'objvPtr' should be treated as readonly
 *	    and the refCount for each object is _not_ incremented; the caller
 *	    must do that if it holds on to a reference. Furthermore, the
 *	    pointer and length returned by this function may change as soon as
 *	    any function is called on the list object. Be careful about
 *	    retaining the pointer in a local data structure.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list. An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *

 *	'listPtr' is converted to a list object if it isn't one already.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ListObjGetElements
int
Tcl_ListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object for which an element array is
				 * to be returned. */
    size_t *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);

    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }
    *objcPtr = listRepPtr->elemCount;
    *objvPtr = listRepPtr->elements;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	Appends the elements of elemListPtr to those of listPtr.

 *
 * Value
 *
 *	TCL_OK
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' or 'elemListPtr' are not valid lists.  An error
 *	    message is left in the interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *
 *	The reference count of each element of 'elemListPtr' as it is added to
 *	'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'

 *	if they are not already. Appending the new elements may cause the
 *	array of element pointers in 'listObj' to grow.  If any objects are
 *	appended to 'listPtr'. Any preexisting string representation of
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object to append elements to. */
    Tcl_Obj *elemListPtr)	/* List obj with elements to append. */
{
    size_t objc;
    Tcl_Obj **objv;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
    }

    /*
     * Pull the elements to append from elemListPtr.
     */

    if (TCL_OK != TclListObjGetElementsM(interp, elemListPtr, &objc, &objv)) {
	return TCL_ERROR;
    }

    /*
     * Insert the new elements starting after the lists's last element.
     * Delete zero existing elements.
     */



    return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);


















































































































































}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	Like 'Tcl_ListObjAppendList', but Appends a single value to a list.



 *
 * Value
 *
 *	TCL_OK
 *
 *	    'objPtr' is appended to the elements of 'listPtr'.
 *
 *	TCL_ERROR
 *
 *	    listPtr does not refer to a list object and the object can not be
 *	    converted to one. An error message will be left in the
 *	    interpreter's result if interp is not NULL.
 *
 * Effect
 *
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.

 *	Appending the new element may cause the the array of element pointers
 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,		/* List object to append objPtr to. */
    Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
{
    List *listRepPtr, *newPtr = NULL;
    size_t numElems, numRequired;
    int needGrow, isShared, attempt;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }

    ListGetInternalRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    Tcl_SetListObj(listPtr, 1, &objPtr);
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }

    numElems = listRepPtr->elemCount;
    numRequired = numElems + 1 ;
    needGrow = (numRequired > listRepPtr->maxElemCount);
    isShared = (listRepPtr->refCount > 1);

    if (numRequired > LIST_MAX) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return TCL_ERROR;
    }

    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared internalrep => try to realloc
	 */

	attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }
    if (isShared || needGrow) {
	Tcl_Obj **dst, **src = listRepPtr->elements;

	/*
	 * Either we have a shared internalrep and we must copy to write, or we
	 * need to grow and realloc attempts failed.  Attempt internalrep copy.
	 */

	attempt = 2 * numRequired;
	newPtr = AttemptNewList(NULL, attempt, NULL);
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = AttemptNewList(NULL, attempt, NULL);
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = AttemptNewList(interp, attempt, NULL);
	}
	if (newPtr == NULL) {
	    /*
	     * All growth attempts failed; throw the error.
	     */

	    return TCL_ERROR;
	}

	dst = newPtr->elements;
	newPtr->refCount++;
	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
	newPtr->elemCount = listRepPtr->elemCount;

	if (isShared) {
	    /*
	     * The original internalrep must remain undisturbed.  Copy into the new
	     * one and bump refcounts
	     */
	    while (numElems--) {
		*dst = *src++;
		Tcl_IncrRefCount(*dst++);
	    }
	    listRepPtr->refCount--;
	} else {
	    /*
	     * Old internalrep to be freed, re-use refCounts.
	     */

	    memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
	    Tcl_Free(listRepPtr);
	}
	listRepPtr = newPtr;
    }
    ListResetInternalRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeInternalRep(listPtr);
    ListSetInternalRep(listPtr, listRepPtr);
    listRepPtr->refCount--;

    /*
     * Add objPtr to the end of listPtr's array of element pointers. Increment
     * the ref count for the (now shared) objPtr.
     */

    listRepPtr->elements[listRepPtr->elemCount] = objPtr;
    Tcl_IncrRefCount(objPtr);
    listRepPtr->elemCount++;

    /*
     * Invalidate any old string representation since the list's internal
     * representation has changed.
     */

    TclInvalidateStringRep(listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 * 	Retrieve a pointer to the element of 'listPtr' at 'index'.  The index
 * 	of the first element is 0.
 *
 * Value

 *
 * 	TCL_OK
 *
 *	    A pointer to the element at 'index' is stored in 'objPtrPtr'.  If
 *	    'index' is out of range, NULL is stored in 'objPtrPtr'.  This
 *	    object should be treated as readonly and its 'refCount' is _not_
 *	    incremented. The caller must do that if it holds on to the
 *	    reference.
 *
 * 	TCL_ERROR
 *
 * 	    'listPtr' is not a valid list. An an error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *
 *  Effect
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjIndex(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object to index into. */
    size_t index,		/* Index of element to return. */
    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
{

    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {

	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }

    if (index >= listRepPtr->elemCount) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = listRepPtr->elements[index];
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 * 	Retrieve the number of elements in a list.


 *
 * Value
 *
 *	TCL_OK
 *
 *	    A count of list elements is stored at the address provided by


 *	    'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
 *	    converted.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.  An error message will be left in
 *	    the interpreter's result if 'interp' is not NULL.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object whose #elements to return. */
    size_t *intPtr)	/* The resulting length is stored here. */
{
    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {

	int result;

	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    *intPtr = 0;

	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }

    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	Replace values in a list.



 *
 *	If 'first' is zero or TCL_INDEX_NONE, it refers to the first element. If
 *	'first' outside the range of elements in the list, no elements are
 *	deleted.
 *

 *	If 'count' is zero or TCL_INDEX_NONE no elements are deleted, and any new
 *	elements are inserted at the beginning of the list.
 *
 * Value
 *
 *	TCL_OK
 *
 *	    The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
 *	    starting at 'first'.  If 'objc' 0, no new elements are added.

 *


 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.   An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *
 *	If 'listPtr' is not of type 'tclListType', it is converted if possible.
 *
 *	The 'refCount' of each element appended to the list is incremented.
 *	Similarly, the 'refCount' for each replaced element is decremented.
 *

 *	If 'listPtr' is modified, any previous string representation is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *listPtr,		/* List object whose elements to replace. */
    size_t first,			/* Index of first element to replace. */
    size_t count,			/* Number of elements to replace. */
    size_t objc,			/* Number of objects to insert. */
    Tcl_Obj *const objv[])	/* An array of objc pointers to Tcl objects to
				 * insert. */
{
    List *listRepPtr;







    Tcl_Obj **elemPtrs;
    size_t numElems, numRequired, numAfterLast, start, i, j;
    int needGrow, isShared;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    ListGetInternalRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (objc == 0) {
		return TCL_OK;
	    }
	    Tcl_SetListObj(listPtr, objc, NULL);
	} else {
	    int result = SetListFromAny(interp, listPtr);

	    if (result != TCL_OK) {
		return result;
	    }
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }

    /*
     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    elemPtrs = listRepPtr->elements;
    numElems = listRepPtr->elemCount;

    if (first == TCL_INDEX_NONE) {
	first = 0;
    }
    if (first >= numElems) {
	first = numElems;	/* So we'll insert after last element. */
    }
    if (count == TCL_INDEX_NONE) {
	count = 0;
    } else if (count > LIST_MAX /* Handle integer overflow */
	    || numElems < first+count) {


	count = numElems - first;


    }

    isShared = (listRepPtr->refCount > 1);


    numRequired = numElems - count + objc; /* Known <= LIST_MAX */




    needGrow = numRequired > listRepPtr->maxElemCount;


    for (i = 0;  i < objc;  i++) {
















	Tcl_IncrRefCount(objv[i]);

    }











    if (needGrow && !isShared) {

	/* Try to use realloc */
	List *newPtr = NULL;
	size_t attempt = 2 * numRequired;



	if (attempt <= LIST_MAX) {


	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));



	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;

	    }
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));


	}



	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    ListResetInternalRep(listPtr, listRepPtr);
	    elemPtrs = listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = numRequired > listRepPtr->maxElemCount;
	}
    }











    if (!needGrow && !isShared) {





	int shift;
















	/*
	 * Can use the current List struct. First "delete" count elements
	 * starting at first.
	 */

	for (j = first;  j < first + count;  j++) {
	    Tcl_Obj *victimPtr = elemPtrs[j];



	    TclDecrRefCount(victimPtr);
	}







	/*
	 * Shift the elements after the last one removed to their new

	 * locations.






	 */








	start = first + count;
	numAfterLast = numElems - start;
	shift = objc - count;	/* numNewElems - numDeleted */
	if ((numAfterLast > 0) && (shift != 0)) {


	    Tcl_Obj **src = elemPtrs + start;





	    memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
	}
    } else {
	/*

	 * Cannot use the current List struct; it is shared, too small, or
	 * both. Allocate a new struct and insert elements into it.


	 */




	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldPtrs = elemPtrs;




	int newMax;











	if (needGrow) {

	    newMax = 2 * numRequired;
	} else {

	    newMax = listRepPtr->maxElemCount;
	}





	listRepPtr = AttemptNewList(NULL, newMax, NULL);

	if (listRepPtr == NULL) {
	    unsigned int limit = LIST_MAX - numRequired;
	    unsigned int extra = numRequired - numElems
		    + TCL_MIN_ELEMENT_GROWTH;

	    int growth = (int) ((extra > limit) ? limit : extra);









	    listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);

	    if (listRepPtr == NULL) {
		listRepPtr = AttemptNewList(interp, numRequired, NULL);
		if (listRepPtr == NULL) {
		    for (i = 0;  i < objc;  i++) {

			/* See bug 3598580 */
			Tcl_DecrRefCount(objv[i]);


		    }
		    return TCL_ERROR;







		}



	    }
	}









	ListResetInternalRep(listPtr, listRepPtr);
	listRepPtr->refCount++;


	elemPtrs = listRepPtr->elements;



	if (isShared) {




	    /*
	     * The old struct will remain in place; need new refCounts for the
	     * new List struct references. Copy over only the surviving

	     * elements.
	     */


	    for (i=0; i < first; i++) {
		elemPtrs[i] = oldPtrs[i];
		Tcl_IncrRefCount(elemPtrs[i]);
	    }
	    for (i = first + count, j = first + objc;
		    j < numRequired; i++, j++) {
		elemPtrs[j] = oldPtrs[i];
		Tcl_IncrRefCount(elemPtrs[j]);
	    }

	    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++) {
		Tcl_Obj *victimPtr = oldPtrs[j];

		TclDecrRefCount(victimPtr);









	    }















	    /*
	     * Copy the elements after the last one removed, shifted to their
	     * new locations.


	     */





	    start = first + count;
	    numAfterLast = numElems - start;

	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,






			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }



	    Tcl_Free(oldListRepPtr);

	}






    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */






    for (i=0,j=first ; i<objc ; i++,j++) {
	elemPtrs[j] = objv[i];
    }







    /*
     * Update the count of elements.
     */



    listRepPtr->elemCount = numRequired;

    /*
     * Invalidate and free any old representations that may not agree
     * with the revised list's internal representation.
     */




    listRepPtr->refCount++;
    TclFreeInternalRep(listPtr);
    ListSetInternalRep(listPtr, listRepPtr);



    listRepPtr->refCount--;


    TclInvalidateStringRep(listPtr);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	Implements the 'lindex' command when objc==3.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
 *	the argument format into required form while taking care to manage
 *	shimmering so as to tend to keep the most useful internalreps
 *	and/or avoid the most expensive conversions.
 *
 * Value
 *
 *	A pointer to the specified element, with its 'refCount' incremented, or
 *	NULL if an error occurred.
 *
 * Notes





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

Tcl_Obj *
TclLindexList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* List being unpacked. */
    Tcl_Obj *argPtr)		/* Index or index list. */
{

    size_t index;			/* Index into the list. */
    Tcl_Obj *indexListCopy;

    List *listRepPtr;

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated

     * shimmering; see TIP#22 and TIP#33 for the details.
     */

    ListGetInternalRep(argPtr, listRepPtr);
    if ((listRepPtr == NULL)
	    && TclGetIntForIndexM(NULL , argPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {

	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

    /*
     * Here we make a private copy of the index list argument to avoid any
     * shimmering issues that might invalidate the indices array below while
     * we are still using it. This is probably unnecessary. It does not appear
     * that any damaging shimmering is possible, and no test has been devised
     * to show any error when this private copy is not made. But it's cheap,
     * and it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of
     * trace or callback permits things to happen that the current
     * implementation does not.
     */

    indexListCopy = TclListObjCopy(NULL, argPtr);
    if (indexListCopy == NULL) {
	/*
	 * argPtr designates something that is neither an index nor a
	 * well-formed list. Report the error via TclLindexFlat.

	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

    ListGetInternalRep(indexListCopy, listRepPtr);

    assert(listRepPtr != NULL);

    listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
		listRepPtr->elements);
    Tcl_DecrRefCount(indexListCopy);
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  TclLindexFlat --
 *
 * 	The core of the 'lindex' command, with all index
 * 	arguments presented as a flat list.
 *
 *  Value



 *
 *	A pointer to the object extracted, with its 'refCount' incremented,  or
 *	NULL if an error occurred.  Thus, the calling code will usually do

 *	something like:
 *




 * 		Tcl_SetObjResult(interp, result);
 * 		Tcl_DecrRefCount(result);
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Tcl object representing the list. */
    size_t indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    size_t i;

    Tcl_IncrRefCount(listPtr);

    for (i=0 ; i<indexCount && listPtr ; i++) {
	size_t index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL, *sublistCopy;

	/*
	 * Here we make a private copy of the current sublist, so we avoid any
	 * shimmering issues that might invalidate the elemPtr array below
	 * while we are still using it. See test lindex-8.4.
	 */

	sublistCopy = TclListObjCopy(interp, listPtr);
	Tcl_DecrRefCount(listPtr);
	listPtr = NULL;

	if (sublistCopy == NULL) {
	    /*
	     * The sublist is not a list at all => error.
	     */

	    break;
	}

	TclListObjGetElementsM(NULL, sublistCopy, &listLen, &elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index >= (size_t)listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(interp, indexArray[i], (size_t)WIDE_MAX - 1, &index)

			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		TclNewObj(listPtr);
	    } else {
		/*
		 * Extract the pointer to the appropriate element.
		 */

		listPtr = elemPtrs[index];
	    }
	    Tcl_IncrRefCount(listPtr);
	}
	Tcl_DecrRefCount(sublistCopy);
    }

    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	The core of [lset] when objc == 4. Objv[2] may be either a
 *	scalar index or a list of indices.
 *      It also handles 'lpop' when given a NULL value.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat', as described


 *	for 'TclLindexList'.
 *
 * Value

 *
 *	The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if

 *	there was an error.




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

Tcl_Obj *
TclLsetList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
    Tcl_Obj *indexArgPtr,	/* Index or index-list arg to 'lset'. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    size_t indexCount = 0;		/* Number of indices in the index list. */
    Tcl_Obj **indices = NULL;	/* Vector of indices in the index list. */
    Tcl_Obj *retValuePtr;	/* Pointer to the list to be returned. */
    size_t index;			/* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;
    List *listRepPtr;

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    ListGetInternalRep(indexArgPtr, listRepPtr);
    if (listRepPtr == NULL
	    && TclGetIntForIndexM(NULL, indexArgPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {
	/*

	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

    }

    indexListCopy = TclListObjCopy(NULL, indexArgPtr);
    if (indexListCopy == NULL) {
	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list. Report the error via TclLsetFlat.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
    }

    TclListObjGetElementsM(NULL, indexArgPtr, &indexCount, &indices);

    /*
     * Let TclLsetFlat handle the actual lset'ting.
     */

    retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);

    Tcl_DecrRefCount(indexListCopy);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Value
 *

 *	The resulting list
 *
 *	    The 'refCount' of 'valuePtr' is incremented.  If 'listPtr' was not

 *	    duplicated, its 'refCount' is incremented.  The reference count of

 *	    an unduplicated object is therefore 2 (one for the returned pointer
 *	    and one for the variable that holds it).  The reference count of a
 *	    duplicate object is 1, reflecting that result is the only active
 *	    reference. The caller is expected to store the result in the
 *	    variable and decrement its reference count. (INST_STORE_* does
 *	    exactly this.)
 *
 *	NULL
 *
 *	    An error occurred.  If 'listPtr' was duplicated, the reference
 *	    count on the duplicate is decremented so that it is 0, causing any
 *	    memory allocated by this function to be freed.
 *
 *
 * Effect
 *
 *	On entry, the reference count of 'listPtr' does not reflect any
 *	references held on the stack. The first action of this function is to
 *	determine whether 'listPtr' is shared and to create a duplicate
 *	unshared copy if it is.  The reference count of the duplicate is

 *	incremented. At this point, the reference count is 1 in either case so
 *	that the object is considered unshared.


 *
 *	The unshared list is altered directly to produce the result.
 *	'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
 *	representations must be spoilt by threading via 'ptr2' of the
 *	two-pointer internal representation. On entry to 'TclLsetFlat', the
 *	values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
 *	Tcl_Obj that has been modified is set to NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLsetFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
    size_t indexCount,		/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    size_t index, len;
    int result;
    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
    Tcl_ObjInternalRep *irPtr;



    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valuePtr just in case.
     */

    if (indexCount == 0) {
	if (valuePtr != NULL) {
	    Tcl_IncrRefCount(valuePtr);
	}
	return valuePtr;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listPtr is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listPtr and
     * all elements to be unchanged.
     */

    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = subListPtr;
    chainPtr = NULL;
    result = TCL_OK;








    /*
     * Loop through all the index arguments, and for each one dive into the
     * appropriate sublist.
     */

    do {
	size_t elemCount;
	Tcl_Obj *parentList, **elemPtrs;

	/*
	 * Check for the possible error conditions...
	 */

	if (TclListObjGetElementsM(interp, subListPtr, &elemCount, &elemPtrs)
		!= TCL_OK) {
	    /* ...the sublist we're indexing into isn't a list at all. */
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * WARNING: the macro TclGetIntForIndexM is not safe for
	 * post-increments, avoid '*indexArray++' here.
	 */

	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
		!= TCL_OK)  {
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++;
	    break;
	}
	indexArray++;

	if (index > elemCount
		|| (valuePtr == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(

			"index \"%s\" out of range", Tcl_GetString(indexArray[-1])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"



			"OUTOFRANGE", NULL);

	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop, and
	 * take steps to make sure it is an unshared copy, as we intend to
	 * modify it.
	 */

	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == (size_t)elemCount) {
		TclNewObj(subListPtr);
	    } else {
		subListPtr = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its internalrep with other
	     * Tcl_Obj's.  Dealing with the shared internalrep case can cause
	     * subListPtr to become shared again, so detect that case and make
	     * and store another copy.
	     */

	    if (index == (size_t)elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep of
	     * parentList, and that's fine for now, since all we've done so
	     * far is replace a list element with an unshared copy.  The list
	     * value remains the same, so the string rep. is still valid, and
	     * unchanged, which is good because if this whole routine returns
	     * NULL, we'd like to leave no change to the value of the lset
	     * variable.  Later on, when we set valuePtr in its proper place,
	     * then all containing lists will have their values changed, and

	     * will need their string reps spoiled.  We maintain a list of all
	     * those Tcl_Obj's (via a little internalrep surgery) so we can spoil
	     * them at that time.
	     */

	    irPtr = TclFetchInternalRep(parentList, &tclListType);
	    irPtr->twoPtrValue.ptr2 = chainPtr;
	    chainPtr = parentList;

	}
    } while (indexCount > 0);

    /*
     * Either we've detected and error condition, and exited the loop with
     * result == TCL_ERROR, or we've successfully reached the last index, and
     * we're ready to store valuePtr.  In either case, we need to clean up our

     * string spoiling list of Tcl_Obj's.
     */

    while (chainPtr) {
	Tcl_Obj *objPtr = chainPtr;
	List *listRepPtr;

	/*
	 * Clear away our internalrep surgery mess.
	 */

	irPtr = TclFetchInternalRep(objPtr, &tclListType);
	listRepPtr = (List *)irPtr->twoPtrValue.ptr1;
	chainPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps of all
	     * containing lists.






	     */




	    listRepPtr->refCount++;
	    TclFreeInternalRep(objPtr);
	    ListSetInternalRep(objPtr, listRepPtr);
	    listRepPtr->refCount--;

	    TclInvalidateStringRep(objPtr);
	} else {
	    irPtr->twoPtrValue.ptr2 = NULL;
	}
    }



    if (result != TCL_OK) {
	/*
	 * Error return; message is already in interp. Clean up any excess
	 * memory.
	 */

	if (retValuePtr != listPtr) {
	    Tcl_DecrRefCount(retValuePtr);
	}
	return NULL;
    }

    /*
     * Store valuePtr in proper sublist and return. The TCL_INDEX_NONE is
     * to avoid a compiler warning (not a problem because we checked that
     * we have a proper list - or something convertible to one - above).
     */

    len = TCL_INDEX_NONE;
    TclListObjLengthM(NULL, subListPtr, &len);
    if (valuePtr == NULL) {

	Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
    } else if (index == (size_t)len) {

	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
    } else {

	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
	TclInvalidateStringRep(subListPtr);
    }
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value.
 *
 *	It is the caller's responsibility to invalidate the string
 *	representation of the 'listPtr'.
 *
 * Value
 *
 * 	TCL_OK
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' does not refer to a list object and cannot be converted
 *	    to one.  An error message will be left in the interpreter result if
 *	    interp is not NULL.
 *
 *	TCL_ERROR
 *
 *	    An index designates an element outside the range [0..listLength-1],
 *	    where 'listLength' is the count of elements in the list object
 *	    designated by 'listPtr'.  An error message is left in the
 *	    interpreter result.
 *
 * Effect
 *
 *	If 'listPtr' designates a shared object, 'Tcl_Panic' is called.  If
 *	'listPtr' is not already of type 'tclListType', it is converted and the
 *	internal representation is unshared. The 'refCount' of the element at

 *	'index' is decremented and replaced in the list with the 'valuePtr',
 *	whose 'refCount' in turn is incremented.
 *
 *
 *----------------------------------------------------------------------
 */

int
TclListObjSetElement(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
				 * if not NULL. */
    Tcl_Obj *listPtr,		/* List object in which element should be
				 * stored. */
    size_t index,			/* Index of element to store. */
    Tcl_Obj *valuePtr)		/* Tcl object to store in the designated list
				 * element. */
{
    List *listRepPtr;		/* Internal representation of the list being
				 * modified. */
    Tcl_Obj **elemPtrs;		/* Pointers to elements of the list. */
    size_t elemCount;		/* Number of elements in the list. */

    /*
     * Ensure that the listPtr parameter designates an unshared list.
     */

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }

    ListGetInternalRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) Tcl_GetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%" TCL_Z_MODIFIER "u\" out of range", index));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
			"OUTOFRANGE", NULL);
	    }
	    return TCL_ERROR;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetInternalRep(listPtr, listRepPtr);
    }

    elemCount = listRepPtr->elemCount;

    /*
     * Ensure that the index is in bounds.
     */

    if (index>=elemCount) {
	if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%" TCL_Z_MODIFIER "u\" out of range", index));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
		    "OUTOFRANGE", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * If the internal rep is shared, replace it with an unshared copy.

     */



    if (listRepPtr->refCount > 1) {
	Tcl_Obj **dst, **src = listRepPtr->elements;
	List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);

	if (newPtr == NULL) {
	    newPtr = AttemptNewList(interp, elemCount, NULL);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	}
	newPtr->refCount++;
	newPtr->elemCount = elemCount;
	newPtr->canonicalFlag = listRepPtr->canonicalFlag;

	dst = newPtr->elements;
	while (elemCount--) {
	    *dst = *src++;
	    Tcl_IncrRefCount(*dst++);
	}

	listRepPtr->refCount--;

	listRepPtr = newPtr;
	ListResetInternalRep(listPtr, listRepPtr);
    }
    elemPtrs = listRepPtr->elements;

    /*
     * Add a reference to the new list element.
     */

    Tcl_IncrRefCount(valuePtr);

    /*
     * Remove a reference from the old list element.

     */

    Tcl_DecrRefCount(elemPtrs[index]);

    /*
     * Stash the new object in the list.
     */

    elemPtrs[index] = valuePtr;

    /*
     * Invalidate outdated internalreps.
     */

    ListGetInternalRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeInternalRep(listPtr);
    ListSetInternalRep(listPtr, listRepPtr);
    listRepPtr->refCount--;

    TclInvalidateStringRep(listPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with the internal representation of a
 *	a list object.
 *
 * Effect

 *

 *	Frees listPtr's List* internal representation, if no longer shared.
 *	May decrement the ref counts of element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);
    assert(listRepPtr != NULL);

    if (listRepPtr->refCount-- <= 1) {
	Tcl_Obj **elemPtrs = listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	Tcl_Free(listRepPtr);

    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list 'Tcl_Obj' to share the
 *	internal representation of an existing list object.
 *
 * Effect

 *

 *	The 'refCount' of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr;

    ListGetInternalRep(srcPtr, listRepPtr);
    assert(listRepPtr != NULL);
    ListSetInternalRep(copyPtr, listRepPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Convert any object to a list.
 *
 * Value
 *
 *    TCL_OK
 *
 *	Success.  The internal representation of 'objPtr' is set, and the type
 *	of 'objPtr' is 'tclListType'.

 *
 *    TCL_ERROR
 *
 *	An error occured during conversion. An error message is left in the
 *	interpreter's result if 'interp' is not NULL.
 *
 *
 *----------------------------------------------------------------------
 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    List *listRepPtr;
    Tcl_Obj **elemPtrs;


    /*
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).
     */

    if (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, &tclDictType)) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	size_t size;

	/*
	 * Create the new list representation. Note that we do not need to do
	 * anything with the string representation as the transformation (and
	 * the reverse back to a dictionary) are both order-preserving. Also
	 * note that since we know we've got a valid dictionary (by
	 * representation) we also know that fetching the size of the
	 * dictionary or iterating over it will not fail.
	 */

	Tcl_DictObjSize(NULL, objPtr, &size);


	listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
	if (!listRepPtr) {
	    return TCL_ERROR;
	}
	listRepPtr->elemCount = 2 * size;





	/*
	 * Populate the list representation.
	 */

	elemPtrs = listRepPtr->elements;
	Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	size_t estCount, length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);
	estCount += (estCount == 0);	/* Smallest list struct holds 1
					 * element. */

	listRepPtr = AttemptNewList(interp, estCount, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}




	elemPtrs = listRepPtr->elements;

	/*
	 * Each iteration, parse and store a list element.
	 */

	while (nextElem < limit) {
	    const char *elemStart;
	    char *check;
	    size_t elemSize;
	    int literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
	    fail:
		while (--elemPtrs >= listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		Tcl_Free(listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    TclNewObj(*elemPtrs);
	    TclInvalidateStringRep(*elemPtrs);
	    check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
		    elemSize);
	    if (elemSize && check == NULL) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "cannot construct list, out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		goto fail;
	    }
	    if (!literal) {
		Tcl_InitStringRep(*elemPtrs, NULL,
			TclCopyAndCollapse(elemSize, elemStart, check));
	    }

	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}


 	listRepPtr->elemCount = elemPtrs - listRepPtr->elements;
    }



    /*
     * Store the new internalRep. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use the old internalRep.
     */







    ListSetInternalRep(objPtr, listRepPtr);




    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *
 *	Any previously-exising string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *
 * Effect

 *
 *	The string representation of 'listPtr' is set to the resulting string.

 *	This string will be empty if the list has no elements. It is assumed
 *	that the list internal representation is not NULL.

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

static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    size_t numElems, i, length, bytesNeeded = 0;
    const char *elem, *start;
    char *dst;
    Tcl_Obj **elemPtrs;
    List *listRepPtr;

    ListGetInternalRep(listPtr, listRepPtr);

    assert(listRepPtr != NULL);

    numElems = listRepPtr->elemCount;

    /*
     * Mark the list as being canonical; although it will now have a string
     * rep, it is one we derived through proper "canonical" quoting and so
     * it's known to be free from nasties relating to [concat] and [eval].








     */




    listRepPtr->canonicalFlag = 1;

    /*
     * Handle empty list case first, so rest of the routine is simpler.
     */

    if (numElems == 0) {
	Tcl_InitStringRep(listPtr, NULL, 0);
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    elemPtrs = listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);



    }
    bytesNeeded += numElems - 1;

    /*
     * Pass 2: copy into string rep buffer.
     */

    start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}
























































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */





<
<
|









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

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





|
<
<
<
<
<
<











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

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

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




|

|
|
<
|
|

>
|
>

<
|
|
>
>

|
<
|
|



<
|
|
|

|

|
>

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






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


|
<
|
<
<
<
<
<
<

|

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



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



<
|
|

|
|
>

|

|

|
<
<

<
<
|

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







>
|
<
>
>

<
>
>

>
|
|
|
|

|
<
|
|









|









|


|
|

|


|


<
<
<
|
<
|
<
<
<

<
<
|






|

>
>
>
|
|
|
|

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








|






|
|

|


|


<
<
<
|
<
|
<
<
<

<
<
<
|






|







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






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



<



|


<
<




<
<
<
<
<
<
<



|
>


|
>
>
|
|

>
>









|
|
|

|
|
|
|
|
<

|
|
<







|


|
<

|
<
|




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








|




>
>










|
|
|

<
|
|

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

<
<
<
<
|
<

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







|
|
<

<
|
>
|
|
>
>
>

|
|
|
|
|
|

<
<
<
<
<
|
<
>
|








|

|




|

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








|
>

|
<
|
<
<
<
|
<
<
|

|
<
|
<
>
|
|
|
<



<



|
|

|


|



<
<
<
<
|








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







|
>
>
>

|
<
|
<
<
|
<
<
|
|
|

|
<
<
|
>
|
|
|



<



|
|

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







|
|
|
|
>

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

|
<
|



<


|
|
|
|

>
|

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


|










|
>
>

|
<
|
<
|
>
>
|
<

<
|
|
<







|
|
|

|

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








|
>
>
>

|
|
|
<
>
|
|

<
<
<
|
|
|
>

>
>
|
<
|
|

|
<
<
|
<
|
<
>
|
|



<



|
|
|
|
|
<

|
>
>
>
>
>
>
>
|
<
|

|



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



|
|

|
|
|
|
>
|
|
>
>


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

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

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

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

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

>
>
>
|
<
|
>
|
>
>

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

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

|

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

<
<
>
>

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

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

>
>
>
>
>
>
|
<
<
<

>
>
|

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








|

|
|
|
|

|
|
<
<

|
>
>
>
>
>



<



|
|

<
|

>
|




>
|

<
|
<
|
>



<
|














|


|
|
>

<
|


<
|
<
<
|
<

|





|

|
|

|
>
>
>

<
<
>
|

>
>
>
>
|
|

<


<



|
|



|

|

|
|








|
|
|


<
|
<
<


>
|



|






|
>





|

<
|
<
<
|

|




|







|



|
>
>
|

|
>

<
>
|
>
>
>
>



<



|
|
|

|

|
|

<







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





<
|

>
|





|


|










|
|
>
|

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

|
|
|

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

<
<
<
<
<
<
<


<



|
|


|

|
|
|
|
>
>




|



|
|

|





|



|



|






|
<

>
>
>
>
>
>
>







|






|
|











|


|





|


|
>
|
|
>
>
>
|
>







|
|
|



|
|
|

|

|
|






|
|
|


|
|

|

|
|
|



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


<
<
|
>






|
>
|

|
|
|
<

<
<
<
|
<
|
<

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







|
|





|
|
|


|
|
|
>
|
|
>
|

>
|
|

|
|







|

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

|
<
|
|
<
>
|
|

<


<




|

|
|


|
<
|
|

<
|
<

|



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

<
|
<
<











|
>

>

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

<
<
<
|
|


|
>

|

<
<
<
<
<
|

<
<
<
|
<
<
<
<
<
|
<









|
|

|
>

>





<


|

|

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








|


|
>

>
|



<


|
|

|
|
<
|
<







|

|
<
|
<
|
<
>

|
<
|
<
|



<





<

>













|











>
>
|
|


|
>
>
>

>
|
|
<

|









|










>
|
|


>
>
>
>
|

<
|
<




|




|
|


|











|
<
<
<
<










>
|

>
>







>
>
>
>
>
>
|
>
>
>
>








|
<
|
|

|
>

|
>
|
|
>



<


|



|



|

<
|
|

|





>
>
>
>
>
>
>
>

>
>
>
|
<

<
|
<


|



<
|
<




<
|
<
<


<




>
>
>







|









|






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







1
2
3
4
5


6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149






150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728

729
730
731
732
733
734
735

736
737
738
739
740
741

742
743
744
745
746

747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785

786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810

811






812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953
954
955
956


957


958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065

1066
1067
1068

1069
1070
1071
1072
1073
1074
1075
1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111



1112

1113



1114


1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167



1168

1169



1170



1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314


1315
1316
1317
1318







1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351

1352
1353
1354

1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365

1366
1367

1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598

1599
1600
1601

1602
1603








1604












1605




1606

1607



1608


1609



1610




1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624

1625

1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640





1641

1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660

1661








1662







1663

1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675

1676



1677


1678
1679
1680

1681

1682
1683
1684
1685

1686
1687
1688

1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701




1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872

1873


1874


1875
1876
1877
1878
1879


1880
1881
1882
1883
1884
1885
1886
1887

1888
1889
1890
1891
1892
1893









































1894


1895


















































1896








1897









1898



























1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915
1916
1917

1918


1919
1920
1921

1922
1923
1924
1925

1926
1927
1928
1929
1930
1931
1932
1933
1934
1935


1936
1937
1938
1939
1940
1941
1942


1943
1944
1945
1946



1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965

1966

1967
1968
1969
1970

1971

1972
1973

1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986


1987
1988
1989
1990
1991
1992

1993
1994
1995
1996






1997

1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013

2014
2015
2016
2017



2018
2019
2020
2021
2022
2023
2024
2025

2026
2027
2028
2029


2030

2031

2032
2033
2034
2035
2036
2037

2038
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048
2049
2050
2051
2052
2053
2054
2055

2056
2057
2058
2059
2060
2061



2062



2063
2064



2065


2066



2067







2068



2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085

2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130

2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141




2142
2143
2144
2145
2146
2147
2148
2149
2150




2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192




2193


2194
2195
2196

2197
2198
2199
2200
2201
2202
2203
2204
2205

2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224


2225
2226
2227
2228
2229
2230
2231
2232

2233

2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265

2266
2267
2268
2269
2270
2271
2272
2273

2274
2275


2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295

2296
2297
2298

2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321

2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333


2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347


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

2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399


2400

2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426


2427
2428
2429
2430
2431
2432
2433
2434
2435

2436
2437

2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459



2460
2461
2462
2463
2464
2465


2466
2467
2468
2469
2470
2471
2472
2473



2474
2475
2476
2477
2478

2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514


2515
2516
2517
2518
2519
2520
2521
2522
2523
2524

2525
2526
2527
2528
2529
2530

2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541

2542

2543
2544
2545
2546
2547

2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569

2570
2571
2572

2573


2574

2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591


2592
2593
2594
2595
2596
2597
2598
2599
2600
2601

2602
2603

2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630

2631


2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654

2655


2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682

2683
2684
2685
2686
2687
2688
2689
2690
2691

2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703

2704
2705
2706
2707
2708
2709
2710
2711

2712

2713
2714

2715
2716
2717
2718

2719
2720
2721
2722
2723
2724

2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752

2753
2754
2755
2756
2757


2758


2759
2760
2761
2762
2763
2764



2765

2766
2767
2768
2769
2770
2771
2772
2773







2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823

2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936


2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951

2952



2953

2954

2955
2956

2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970




2971



2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018



3019

3020





3021
3022




3023
3024
3025
3026
3027
3028

3029
3030

3031
3032
3033
3034

3035
3036

3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047

3048
3049
3050

3051

3052
3053
3054
3055
3056




3057








3058
3059



3060



3061
3062

3063


3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082

3083









3084





3085
3086
3087




3088



3089
3090
3091
3092
3093
3094
3095
3096
3097





3098
3099



3100





3101

3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122

3123
3124
3125
3126
3127
3128


3129
3130
3131
3132
3133

3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156

3157
3158
3159
3160
3161
3162
3163

3164

3165
3166
3167
3168
3169
3170
3171
3172
3173
3174

3175

3176

3177
3178
3179

3180

3181
3182
3183
3184

3185
3186
3187
3188
3189

3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230

3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263

3264

3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290




3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332

3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346

3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358

3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380

3381

3382

3383
3384
3385
3386
3387
3388

3389

3390
3391
3392
3393

3394


3395
3396

3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
/*
 * tclListObj.c --
 *
 *	This file contains functions that implement the Tcl list object type.
 *


 * Copyright © 2022 Ashok P. Nadkarni.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include <assert.h>

/*
 * TODO - memmove is fast. Measure at what size we should prefer memmove
 * (for unshared objects only) in lieu of range operations. On the other
 * hand, more cache dirtied?
 */

/*
 * Macros for validation and bug checking.
 */

/*
 * Control whether asserts are enabled. Always enable in debug builds. In non-debug
 * builds, can be set with cdebug="-DENABLE_LIST_ASSERTS" on the nmake command line.
 */
#ifdef ENABLE_LIST_ASSERTS
# ifdef NDEBUG
#  undef NDEBUG /* Activate assert() macro */
# endif
#else
# ifndef NDEBUG
#  define ENABLE_LIST_ASSERTS /* Always activate list asserts in debug mode */
# endif
#endif

#ifdef ENABLE_LIST_ASSERTS

#define LIST_ASSERT(cond_) assert(cond_) /* TODO - is there a Tcl-specific one? */
/*
 * LIST_INDEX_ASSERT is to catch errors with negative indices and counts
 * being passed AFTER validation. On Tcl9 length types are unsigned hence
 * the checks against LIST_MAX. On Tcl8 length types are signed hence the
 * also checks against 0.
 */
#define LIST_INDEX_ASSERT(idxarg_)                                 \
    do {                                                           \
	ListSizeT idx_ = (idxarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(idx_ != TCL_INDEX_NONE && idx_ < LIST_MAX);                 \
    } while (0)
/* Ditto for counts except upper limit is different */
#define LIST_COUNT_ASSERT(countarg_)                                   \
    do {                                                               \
	ListSizeT count_ = (countarg_); /* To guard against ++ etc. */ \
	LIST_ASSERT(count_ != TCL_INDEX_NONE && count_ <= LIST_MAX);                \
    } while (0)

#else

#define LIST_ASSERT(cond_) ((void) 0)
#define LIST_INDEX_ASSERT(idx_) ((void) 0)
#define LIST_COUNT_ASSERT(count_) ((void) 0)

#endif

/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
    LIST_ASSERT((listObj_)->typePtr == &tclListType);


/*
 * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
 * command line), the entire list internal representation is checked for
 * inconsistencies. This has a non-trivial cost so has to be separately
 * enabled and not part of assertions checking. However, the test suite does
 * invoke ListRepValidate directly even without ENABLE_LIST_INVARIANTS.
 */
#ifdef ENABLE_LIST_INVARIANTS
#define LISTREP_CHECK(listRepPtr_) ListRepValidate(listRepPtr_, __FILE__, __LINE__)
#else
#define LISTREP_CHECK(listRepPtr_) (void) 0
#endif

/*
 * Flags used for controlling behavior of allocation of list
 * internal representations.
 *
 * If the LISTREP_PANIC_ON_FAIL bit is set, the function will panic if
 * list is too large or memory cannot be allocated. Without the flag
 * a NULL pointer is returned.
 *
 * The LISTREP_SPACE_FAVOR_NONE, LISTREP_SPACE_FAVOR_FRONT,
 * LISTREP_SPACE_FAVOR_BACK, LISTREP_SPACE_ONLY_BACK flags are used to
 * control additional space when allocating.
 * - If none of these flags is present, the exact space requested is
 *   allocated, nothing more.
 * - Otherwise, if only LISTREP_FAVOR_FRONT is present, extra space is
 *   allocated with more towards the front.
 * - Conversely, if only LISTREP_FAVOR_BACK is present extra space is allocated
 *   with more to the back.
 * - If both flags are present (LISTREP_SPACE_FAVOR_NONE), the extra space
 *   is equally apportioned.
 * - Finally if LISTREP_SPACE_ONLY_BACK is present, ALL extra space is at
 *   the back.
 */
#define LISTREP_PANIC_ON_FAIL         0x00000001
#define LISTREP_SPACE_FAVOR_FRONT     0x00000002
#define LISTREP_SPACE_FAVOR_BACK      0x00000004
#define LISTREP_SPACE_ONLY_BACK       0x00000008
#define LISTREP_SPACE_FAVOR_NONE \
    (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK)
#define LISTREP_SPACE_FLAGS                               \
    (LISTREP_SPACE_FAVOR_FRONT | LISTREP_SPACE_FAVOR_BACK \
     | LISTREP_SPACE_ONLY_BACK)

/*
 * Prototypes for non-inline static functions defined later in this file:
 */
static int	MemoryAllocationError(Tcl_Interp *, size_t size);
static int	ListLimitExceededError(Tcl_Interp *);
static ListStore *ListStoreNew(ListSizeT objc, Tcl_Obj *const objv[], int flags);
static int	ListRepInit(ListSizeT objc, Tcl_Obj *const objv[], int flags, ListRep *);
static int	ListRepInitAttempt(Tcl_Interp *,
		    ListSizeT objc,
		    Tcl_Obj *const objv[],
		    ListRep *);
static void	ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags);
static void	ListRepUnsharedFreeUnreferenced(const ListRep *repPtr);
static int	TclListObjGetRep(Tcl_Interp *, Tcl_Obj *listPtr, ListRep *repPtr);
static void	ListRepRange(ListRep *srcRepPtr,
		    ListSizeT rangeStart,
		    ListSizeT rangeEnd,
		    int preserveSrcRep,
		    ListRep *rangeRepPtr);
static ListStore *ListStoreReallocate(ListStore *storePtr, ListSizeT numSlots);
static void	ListRepValidate(const ListRep *repPtr, const char *file,
		    int lineNum);
static void	DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void	FreeListInternalRep(Tcl_Obj *listPtr);
static int	SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void	UpdateStringOfList(Tcl_Obj *listPtr);

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is ListRep defined in tcl.h.






 */

const Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny		/* setFromAnyProc */
};

/* Macros to manipulate the List internal rep */
#define ListRepIncrRefs(repPtr_)            \
    do {                                    \
	(repPtr_)->storePtr->refCount++;    \
	if ((repPtr_)->spanPtr)             \
	    (repPtr_)->spanPtr->refCount++; \
    } while (0)

/* Returns number of free unused slots at the back of the ListRep's ListStore */
#define ListRepNumFreeTail(repPtr_) \
    ((repPtr_)->storePtr->numAllocated \
     - ((repPtr_)->storePtr->firstUsed + (repPtr_)->storePtr->numUsed))

/* Returns number of free unused slots at the front of the ListRep's ListStore */
#define ListRepNumFreeHead(repPtr_) ((repPtr_)->storePtr->firstUsed)

/* Returns a pointer to the slot corresponding to list index listIdx_ */
#define ListRepSlotPtr(repPtr_, listIdx_) \
    (&(repPtr_)->storePtr->slots[ListRepStart(repPtr_) + (listIdx_)])

/*
 * Macros to replace the internal representation in a Tcl_Obj. There are
 * subtle differences in each so make sure to use the right one to avoid
 * memory leaks, access to freed memory and the like.
 *
 * ListObjStompRep - assumes the Tcl_Obj internal representation can be
 * overwritten AND that the passed ListRep already has reference counts that
 * include the reference from the Tcl_Obj. Basically just copies the pointers
 * and sets the internal Tcl_Obj type to list
 *
 * ListObjOverwriteRep - like ListObjOverwriteRep but additionally
 * increments reference counts on the passed ListRep. Generally used when
 * the string representation of the Tcl_Obj is not to be modified.
 *
 * ListObjReplaceRepAndInvalidate - Like ListObjOverwriteRep but additionally
 * assumes the Tcl_Obj internal rep is valid (and possibly even same as
 * passed ListRep) and frees it first. Additionally invalidates the string
 * representation. Generally used when modifying a Tcl_Obj value.
 */
#define ListObjStompRep(objPtr_, repPtr_)                              \
    do {                                                               \
	(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
	(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr;  \
	(objPtr_)->typePtr = &tclListType;                             \
    } while (0)

#define ListObjOverwriteRep(objPtr_, repPtr_) \
    do {                                      \
	ListRepIncrRefs(repPtr_);             \
	ListObjStompRep(objPtr_, repPtr_);    \
    } while (0)

#define ListObjReplaceRepAndInvalidate(objPtr_, repPtr_)           \
    do {                                                           \
	/* Note order important, don't use ListObjOverwriteRep! */ \
	ListRepIncrRefs(repPtr_);                                  \
	TclFreeInternalRep(objPtr_);                               \
	TclInvalidateStringRep(objPtr_);                           \
	ListObjStompRep(objPtr_, repPtr_);                         \
    } while (0)

/*
 *------------------------------------------------------------------------
 *
 * ListSpanNew --
 *
 *    Allocates and initializes memory for a new ListSpan. The reference
 *    count on the returned struct is 0.
 *
 * Results:
 *    Non-NULL pointer to the allocated ListSpan.
 *
 * Side effects:
 *    The function will panic on memory allocation failure.
 *
 *------------------------------------------------------------------------
 */
static inline ListSpan *
ListSpanNew(
    ListSizeT firstSlot, /* Starting slot index of the span */
    ListSizeT numSlots)  /* Number of slots covered by the span */
{
    ListSpan *spanPtr = (ListSpan *) Tcl_Alloc(sizeof(*spanPtr));
    spanPtr->refCount = 0;
    spanPtr->spanStart = firstSlot;
    spanPtr->spanLength = numSlots;
    return spanPtr;
}

/*
 *------------------------------------------------------------------------
 *
 * ListSpanDecrRefs --
 *
 *   Decrements the reference count on a span, freeing the memory if
 *   it drops to zero or less.
 *
 * Results:
 *   None.
 *
 * Side effects:
 *   The memory may be freed.
 *
 *------------------------------------------------------------------------
 */
static inline void
ListSpanDecrRefs(ListSpan *spanPtr)
{
    if (spanPtr->refCount <= 1) {
	Tcl_Free(spanPtr);
    } else {
	spanPtr->refCount -= 1;
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ListSpanMerited --
 *
 *    Creation of a new list may sometimes be done as a span on existing
 *    storage instead of allocating new. The tradeoff is that if the
 *    original list is released, the new span-based list may hold on to
 *    more memory than desired. This function implements heuristics for
 *    deciding which option is better.
 *
 * Results:
 *    Returns non-0 if a span-based list is likely to be more optimal
 *    and 0 if not.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
static inline int
ListSpanMerited(
    ListSizeT length,                 /* Length of the proposed span */
    ListSizeT usedStorageLength,      /* Number of slots currently in used */
    ListSizeT allocatedStorageLength) /* Length of the currently allocation */
{
    /*
     TODO
     - heuristics thresholds need to be determined
     - currently, information about the sharing (ref count) of existing
       storage is not passed. Perhaps it should be. For example if the
       existing storage has a "large" ref count, then it might make sense
       to do even a small span.
     */

    if (length < LIST_SPAN_THRESHOLD) {
	return 0;/* No span for small lists */
    }
    if (length < (allocatedStorageLength / 2 - allocatedStorageLength / 8)) {
	return 0; /* No span if less than 3/8 of allocation */
    }
    if (length < usedStorageLength / 2) {
	return 0; /* No span if less than half current storage */
    }

    return 1;
}

/*
 *------------------------------------------------------------------------
 *
 * ListStoreUpSize --
 *
 *    For reasons of efficiency, extra space is allocated for a ListStore
 *    compared to what was requested. This function calculates how many
 *    slots should actually be allocated for a given request size.
 *
 * Results:
 *    Number of slots to allocate.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
static inline ListSizeT
ListStoreUpSize(ListSizeT numSlotsRequested) {
    /* TODO -how much extra? May be double only for smaller requests? */
    return numSlotsRequested < (LIST_MAX / 2) ? 2 * numSlotsRequested
						 : LIST_MAX;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepFreeUnreferenced --
 *
 *    Inline wrapper for ListRepUnsharedFreeUnreferenced that does quick checks
 *    before calling it.
 *
 *    IMPORTANT: this function must not be called on an internal
 *    representation of a Tcl_Obj that is itself shared.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    See comments for ListRepUnsharedFreeUnreferenced.
 *
 *------------------------------------------------------------------------
 */
static inline void
ListRepFreeUnreferenced(const ListRep *repPtr)
{
    if (! ListRepIsShared(repPtr) && repPtr->spanPtr) {
        /* T:listrep-1.5.1 */
	ListRepUnsharedFreeUnreferenced(repPtr);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ObjArrayIncrRefs --
 *
 *    Increments the reference counts for Tcl_Obj's in a subarray.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    As above.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayIncrRefs(
    Tcl_Obj * const *objv,  /* Pointer to the array */
    ListSizeT startIdx,     /* Starting index of subarray within objv */
    ListSizeT count)        /* Number of elements in the subarray */
{
    Tcl_Obj * const *end;
    LIST_INDEX_ASSERT(startIdx);
    LIST_COUNT_ASSERT(count);
    objv += startIdx;
    end = objv + count;
    while (objv < end) {
	Tcl_IncrRefCount(*objv);
	++objv;
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ObjArrayDecrRefs --
 *
 *    Decrements the reference counts for Tcl_Obj's in a subarray.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    As above.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayDecrRefs(
    Tcl_Obj * const *objv, /* Pointer to the array */
    ListSizeT startIdx,    /* Starting index of subarray within objv */
    ListSizeT count)       /* Number of elements in the subarray */
{
    Tcl_Obj * const *end;
    LIST_INDEX_ASSERT(startIdx);
    LIST_COUNT_ASSERT(count);
    objv += startIdx;
    end = objv + count;
    while (objv < end) {
	Tcl_DecrRefCount(*objv);
	++objv;
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ObjArrayCopy --
 *
 *    Copies an array of Tcl_Obj* pointers.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Reference counts on copied Tcl_Obj's are incremented.
 *
 *------------------------------------------------------------------------
 */
static inline void
ObjArrayCopy(
    Tcl_Obj **to,          /* Destination */
    ListSizeT count,       /* Number of pointers to copy */
    Tcl_Obj *const from[]) /* Source array of Tcl_Obj* */
{
    Tcl_Obj **end;
    LIST_COUNT_ASSERT(count);
    end = to + count;
    /* TODO - would memmove followed by separate IncrRef loop be faster? */
    while (to < end) {
	Tcl_IncrRefCount(*from);
	*to++ = *from++;
    }
}

/*
 *------------------------------------------------------------------------
 *
 * MemoryAllocationError --
 *
 *    Generates a memory allocation failure error.
 *
 * Results:
 *    Always TCL_ERROR.
 *
 * Side effects:
 *    Error message and code are stored in the interpreter if not NULL.
 *
 *------------------------------------------------------------------------
 */
static int
MemoryAllocationError(
    Tcl_Interp *interp, /* Interpreter for error message. May be NULL */
    ListSizeT size)        /* Size of attempted allocation that failed */
{
    if (interp != NULL) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_ObjPrintf(
		"list construction failed: unable to alloc %" TCL_LL_MODIFIER
		"u bytes",
		(Tcl_WideInt)size));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return TCL_ERROR;
}

/*
 *------------------------------------------------------------------------
 *
 * ListLimitExceeded --
 *
 *    Generates an error for exceeding maximum list size.
 *
 * Results:
 *    Always TCL_ERROR.
 *
 * Side effects:
 *    Error message and code are stored in the interpreter if not NULL.
 *
 *------------------------------------------------------------------------
 */
static int
ListLimitExceededError(Tcl_Interp *interp)
{
    if (interp != NULL) {
	Tcl_SetObjResult(
	    interp,
	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return TCL_ERROR;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepUnsharedShiftDown --
 *
 *    Shifts the "in-use" contents in the ListStore for a ListRep down
 *    by the given number of slots. The ListStore must be unshared and
 *    the free space at the front of the storage area must be big enough.
 *    It is the caller's responsibility to check.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The contents of the ListRep's ListStore area are shifted down in the
 *    storage area. The ListRep's ListSpan is updated accordingly.
 *
 *------------------------------------------------------------------------
 */
static inline void
ListRepUnsharedShiftDown(ListRep *repPtr, ListSizeT shiftCount)
{
    ListStore *storePtr;

    LISTREP_CHECK(repPtr);
    LIST_ASSERT(!ListRepIsShared(repPtr));

    storePtr = repPtr->storePtr;

    LIST_COUNT_ASSERT(shiftCount);
    LIST_ASSERT(storePtr->firstUsed >= shiftCount);

    memmove(&storePtr->slots[storePtr->firstUsed - shiftCount],
	    &storePtr->slots[storePtr->firstUsed],
	    storePtr->numUsed * sizeof(Tcl_Obj *));
    storePtr->firstUsed -= shiftCount;
    if (repPtr->spanPtr) {
	repPtr->spanPtr->spanStart -= shiftCount;
	LIST_ASSERT(repPtr->spanPtr->spanLength == storePtr->numUsed);
    } else {
	/*
	 * If there was no span, firstUsed must have been 0 (Invariant)
	 * AND shiftCount must have been 0 (<= firstUsed on call)
	 * In other words, this would have been a no-op
	 */

	LIST_ASSERT(storePtr->firstUsed == 0);
	LIST_ASSERT(shiftCount == 0);
    }

    LISTREP_CHECK(repPtr);
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepUnsharedShiftUp --
 *
 *    Shifts the "in-use" contents in the ListStore for a ListRep up
 *    by the given number of slots. The ListStore must be unshared and
 *    the free space at the back of the storage area must be big enough.
 *    It is the caller's responsibility to check.
 *    TODO - this function is not currently used.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The contents of the ListRep's ListStore area are shifted up in the
 *    storage area. The ListRep's ListSpan is updated accordingly.
 *
 *------------------------------------------------------------------------
 */
#if 0
static inline void
ListRepUnsharedShiftUp(ListRep *repPtr, ListSizeT shiftCount)
{
    ListStore *storePtr;

    LISTREP_CHECK(repPtr);
    LIST_ASSERT(!ListRepIsShared(repPtr));
    LIST_COUNT_ASSERT(shiftCount);

    storePtr = repPtr->storePtr;
    LIST_ASSERT((storePtr->firstUsed + storePtr->numUsed + shiftCount)
		<= storePtr->numAllocated);

    memmove(&storePtr->slots[storePtr->firstUsed + shiftCount],
	    &storePtr->slots[storePtr->firstUsed],
	    storePtr->numUsed * sizeof(Tcl_Obj *));
    storePtr->firstUsed += shiftCount;
    if (repPtr->spanPtr) {
	repPtr->spanPtr->spanStart += shiftCount;
    } else {
	/* No span means entire original list is span */
	/* Should have been zero before shift - Invariant TBD */
	LIST_ASSERT(storePtr->firstUsed == shiftCount);
	repPtr->spanPtr = ListSpanNew(shiftCount, storePtr->numUsed);
    }

    LISTREP_CHECK(repPtr);
}
#endif

/*
 *------------------------------------------------------------------------
 *
 * ListRepValidate --
 *
 *	Checks all invariants for a ListRep and panics on failure.
 *	Note this is independent of NDEBUG, assert etc.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Panics if any invariant is not met.
 *
 *------------------------------------------------------------------------
 */
static void
ListRepValidate(const ListRep *repPtr, const char *file, int lineNum)
{
    ListStore *storePtr = repPtr->storePtr;
    const char *condition;

    (void)storePtr; /* To stop gcc from whining about unused vars */

#define INVARIANT(cond_)        \
    do {                        \
	if (!(cond_)) {         \
	    condition = #cond_; \
	    goto failure;       \
	}                       \
    } while (0)

    /* Separate each condition so line number gives exact reason for failure */
    INVARIANT(storePtr != NULL);
    INVARIANT(storePtr->numAllocated <= LIST_MAX);
    INVARIANT(storePtr->firstUsed < storePtr->numAllocated);
    INVARIANT(storePtr->numUsed <= storePtr->numAllocated);
    INVARIANT(storePtr->firstUsed <= (storePtr->numAllocated - storePtr->numUsed));

    if (! ListRepIsShared(repPtr)) {
	/*
	 * If this is the only reference and there is no span, then store
	 * occupancy must begin at 0
	 */
	INVARIANT(repPtr->spanPtr || repPtr->storePtr->firstUsed == 0);
    }

    INVARIANT(ListRepStart(repPtr) >= storePtr->firstUsed);
    INVARIANT(ListRepLength(repPtr) <= storePtr->numUsed);
    INVARIANT(ListRepStart(repPtr) <= (storePtr->firstUsed + storePtr->numUsed - ListRepLength(repPtr)));

#undef INVARIANT

    return;

failure:
    Tcl_Panic("List internal failure in %s line %d. Condition: %s",
	      file,
	      lineNum,
	      condition);
}

/*
 *------------------------------------------------------------------------
 *
 * TclListObjValidate --
 *
 *    Wrapper around ListRepValidate. Primarily used from test suite.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Will panic if internal structure is not consistent or if object
 *    cannot be converted to a list object.
 *
 *------------------------------------------------------------------------
 */
void
TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
{
    ListRep listRep;
    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	Tcl_Panic("Object passed to TclListObjValidate cannot be converted to "
		  "a list object.");
    }
    ListRepValidate(&listRep, __FILE__, __LINE__);
}

/*
 *----------------------------------------------------------------------
 *
 * ListStoreNew --
 *
 *	Allocates a new ListStore with space for at least objc elements. objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values

 *	in that array.  If objv==NULL, initalize 0 elements, with space
 *	to add objc more.
 *
 *      Normally the function allocates the exact space requested unless
 *      the flags arguments has any LISTREP_SPACE_*
 *      bits set. See the comments for those #defines.
 *

 * Results:
 *      On success, a pointer to the allocated ListStore is returned.
 *      On allocation failure, panics if LISTREP_PANIC_ON_FAIL is set in
 *      flags; otherwise returns NULL.
 *
 * Side effects:

 *	The ref counts of the elements in objv are incremented on success
 *	since the returned ListStore references them.
 *
 *----------------------------------------------------------------------
 */

static ListStore *
ListStoreNew(
    ListSizeT objc,
    Tcl_Obj *const objv[],
    int flags)
{
    ListStore *storePtr;
    ListSizeT capacity;

    /*
     * First check to see if we'd overflow and try to allocate an object
     * larger than our memory allocator allows.
     */
    if (objc > LIST_MAX) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("max length of a Tcl list exceeded");
	}
	return NULL;
    }

    if (flags & LISTREP_SPACE_FLAGS) {
	capacity = ListStoreUpSize(objc);
    } else {
	capacity = objc;
    }

    storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
    if (storePtr == NULL && capacity != objc) {
	capacity = objc; /* Try allocating exact size */
	storePtr = (ListStore *)Tcl_AttemptAlloc(LIST_SIZE(capacity));
    }
    if (storePtr == NULL) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }


    storePtr->refCount = 0;
    storePtr->flags = 0;
    storePtr->numAllocated = capacity;
    if (capacity == objc) {
	storePtr->firstUsed = 0;
    } else {
	ListSizeT extra = capacity - objc;
	int spaceFlags = flags & LISTREP_SPACE_FLAGS;
	if (spaceFlags == LISTREP_SPACE_ONLY_BACK) {
	    storePtr->firstUsed = 0;
	} else if (spaceFlags == LISTREP_SPACE_FAVOR_FRONT) {
	    /* Leave more space in the front */
	    storePtr->firstUsed =
		extra - (extra / 4); /* NOT same as 3*extra/4 */
	} else if (spaceFlags == LISTREP_SPACE_FAVOR_BACK) {
	    /* Leave more space in the back */
	    storePtr->firstUsed = extra / 4;
	} else {
	    /* Apportion equally */
	    storePtr->firstUsed = extra / 2;
	}
    }

    if (objv) {
	storePtr->numUsed = objc;

	ObjArrayCopy(&storePtr->slots[storePtr->firstUsed], objc, objv);






    } else {
	storePtr->numUsed = 0;
    }

    return storePtr;
}

/*
 *------------------------------------------------------------------------
 *
 * ListStoreReallocate --
 *
 *    Reallocates the memory for a ListStore.
 *
 * Results:
 *    Pointer to the ListStore which may be the same as storePtr or pointer
 *    to a new block of memory. On reallocation failure, NULL is returned.
 *
 *
 * Side effects:
 *    The memory pointed to by storePtr is freed if it a new block has to
 *    be returned.
 *
 *
 *------------------------------------------------------------------------
 */
ListStore *
ListStoreReallocate (ListStore *storePtr, ListSizeT numSlots)
{
    ListSizeT newCapacity;
    ListStore *newStorePtr;

    newCapacity = ListStoreUpSize(numSlots);
    newStorePtr =
	(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
    if (newStorePtr == NULL) {
	newCapacity = numSlots;
	newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr,
						    LIST_SIZE(newCapacity));
	if (newStorePtr == NULL)
	    return NULL;
    }
    /* Only the capacity has changed, fix it in the header */
    newStorePtr->numAllocated = newCapacity;
    return newStorePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInit --
 *
 *      Initializes a ListRep to hold a list internal representation
 *      with space for objc elements.
 *
 *      objc must be > 0. If objv!=NULL, initializes with the first objc
 *      values in that array. If objv==NULL, initalize list internal rep to
 *      have 0 elements, with space to add objc more.
 *
 *	Normally the function allocates the exact space requested unless
 *	the flags arguments has one of the LISTREP_SPACE_* bits set.
 *	See the comments for those #defines.
 *
 *      The reference counts of the ListStore and ListSpan (if present)
 *	pointed to by the initialized repPtr are set to zero.
 *	Caller has to manage them as necessary.
 *
 * Results:
 *      On success, TCL_OK is returned with *listRepPtr initialized.
 *      On failure, panics if LISTREP_PANIC_ON_FAIL is set in flags; otherwise
 *	returns TCL_ERROR with *listRepPtr fields set to NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */
static int
ListRepInit(
    ListSizeT objc,
    Tcl_Obj *const objv[],
    int flags,
    ListRep *repPtr
    )
{
    ListStore *storePtr;

    storePtr = ListStoreNew(objc, objv, flags);
    if (storePtr) {
	repPtr->storePtr = storePtr;
	if (storePtr->firstUsed == 0) {
	    repPtr->spanPtr = NULL;
	} else {
	    repPtr->spanPtr =
		ListSpanNew(storePtr->firstUsed, storePtr->numUsed);
	}
	return TCL_OK;
    }
    /*
     * Initialize to keep gcc happy at the call site. Else it complains
     * about possibly uninitialized use.
     */
    repPtr->storePtr = NULL;
    repPtr->spanPtr = NULL;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInitAttempt --
 *
 *	Creates a list internal rep with space for objc elements. See
 *	ListRepInit for requirements for parameters (in particular objc must
 *	be > 0). This function only adds error messages to the interpreter if
 *	not NULL.
 *
 *      The reference counts of the ListStore and ListSpan (if present)
 *	pointed to by the initialized repPtr are set to zero.
 *	Caller has to manage them as necessary.
 *
 * Results:
 *      On success, TCL_OK is returned with *listRepPtr initialized.
 *	On allocation failure, returnes TCL_ERROR with an error message
 *	in the interpreter if non-NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static int
ListRepInitAttempt(
    Tcl_Interp *interp,
    ListSizeT objc,
    Tcl_Obj *const objv[],
    ListRep *repPtr)
{
    int result = ListRepInit(objc, objv, 0, repPtr);

    if (result != TCL_OK && interp != NULL) {
	if (objc > LIST_MAX) {
	    ListLimitExceededError(interp);


	} else {


	    MemoryAllocationError(interp, LIST_SIZE(objc));
	}
    }
    return result;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepClone --
 *
 *    Does a deep clone of an existing ListRep.
 *
 *    Normally the function allocates the exact space needed unless
 *    the flags arguments has one of the LISTREP_SPACE_* bits set.
 *    See the comments for those #defines.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The toRepPtr location is initialized with the ListStore and ListSpan
 *    (if needed) containing a copy of the list elements in fromRepPtr.
 *    The function will panic if memory cannot be allocated.
 *
 *------------------------------------------------------------------------
 */
static void
ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags)
{
    Tcl_Obj **fromObjs;
    ListSizeT numFrom;

    ListRepElements(fromRepPtr, numFrom, fromObjs);
    ListRepInit(numFrom, fromObjs, flags | LISTREP_PANIC_ON_FAIL, toRepPtr);
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepUnsharedFreeUnreferenced --
 *
 *    Frees any Tcl_Obj's from the "in-use" area of the ListStore for a
 *    ListRep that are not actually references from any lists.
 *
 *    IMPORTANT: this function must not be called on a shared internal
 *    representation or the internal representation of a shared Tcl_Obj.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    The firstUsed and numUsed fields of the ListStore are updated to
 *    reflect the new "in-use" extent.
 *
 *------------------------------------------------------------------------
 */
static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr)
{
    ListSizeT count;
    ListStore *storePtr;
    ListSpan *spanPtr;

    LIST_ASSERT(!ListRepIsShared(repPtr));
    LISTREP_CHECK(repPtr);

    storePtr = repPtr->storePtr;
    spanPtr = repPtr->spanPtr;
    if (spanPtr == NULL) {
	LIST_ASSERT(storePtr->firstUsed == 0); /* Invariant TBD */
	return;
    }

    /* Collect garbage at front */
    count = spanPtr->spanStart - storePtr->firstUsed;
    LIST_COUNT_ASSERT(count);
    if (count > 0) {
        /* T:listrep-1.5.1,6.{1:8} */
	ObjArrayDecrRefs(storePtr->slots, storePtr->firstUsed, count);
	storePtr->firstUsed = spanPtr->spanStart;
	LIST_ASSERT(storePtr->numUsed >= count);
	storePtr->numUsed -= count;
    }

    /* Collect garbage at back */
    count = (storePtr->firstUsed + storePtr->numUsed)
	  - (spanPtr->spanStart + spanPtr->spanLength);
    LIST_COUNT_ASSERT(count);
    if (count > 0) {
        /* T:listrep-6.{1:8} */
	ObjArrayDecrRefs(
	    storePtr->slots, spanPtr->spanStart + spanPtr->spanLength, count);
	LIST_ASSERT(storePtr->numUsed >= count);
	storePtr->numUsed -= count;
    }

    LIST_ASSERT(ListRepStart(repPtr) == storePtr->firstUsed);
    LIST_ASSERT(ListRepLength(repPtr) == storePtr->numUsed);
    LISTREP_CHECK(repPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *
 *	This function is normally called when not debugging: i.e., when
 *	TCL_MEM_DEBUG is not defined. It creates a new list object from an

 *	(objc,objv) array: that is, each of the objc elements of the array
 *	referenced by objv is inserted as an element into a new Tcl object.
 *

 *	When TCL_MEM_DEBUG is defined, this function just returns the result
 *	of calling the debugging version Tcl_DbNewListObj.
 *
 * Results:
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The resulting new list object has ref count 0.
 *
 * Side effects:

 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewListObj

Tcl_Obj *
Tcl_NewListObj(
    ListSizeT objc,		/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{
    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewListObj(
    ListSizeT objc,		/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{
    ListRep listRep;
    Tcl_Obj *listObj;

    TclNewObj(listObj);

    if (objc + 1 <= 1) {
	return listObj;
    }




    ListRepInit(objc, objv, LISTREP_PANIC_ON_FAIL, &listRep);

    ListObjReplaceRepAndInvalidate(listObj, &listRep);






    return listObj;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewListObj --
 *
 *	This function is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
 *	as the Tcl_NewListObj function above except that it calls
 *	Tcl_DbCkalloc directly with the file name and line number from its
 *	caller. This simplifies debugging since then the [memory active]
 *	command will report the correct file name and line number when
 *	reporting objects that haven't been freed.
 *
 *	When TCL_MEM_DEBUG is not defined, this function just returns the
 *	result of calling Tcl_NewListObj.
 *
 * Results:
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The new list object has ref count 0.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewListObj(
    ListSizeT objc,		/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *listObj;
    ListRep listRep;

    TclDbNewObj(listObj, file, line);

    if (objc + 1 <= 1) {
	return listObj;
    }




    ListRepInit(objc, objv, LISTREP_PANIC_ON_FAIL, &listRep);

    ListObjReplaceRepAndInvalidate(listObj, &listRep);







    return listObj;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewListObj(
    ListSizeT objc,		/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewListObj(objc, objv);
}
#endif /* TCL_MEM_DEBUG */

/*
 *------------------------------------------------------------------------
 *
 * TclNewListObj2 --
 *
 *    Create a new Tcl_Obj list comprising of the concatenation of two
 *    Tcl_Obj* arrays.
 *    TODO - currently this function is not used within tclListObj but
 *    need to see if it would be useful in other files that preallocate
 *    lists and then append.
 *
 * Results:
 *    Non-NULL pointer to the allocate Tcl_Obj.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
Tcl_Obj *
TclNewListObj2(
    ListSizeT objc1,		/* Count of objects referenced by objv1. */
    Tcl_Obj *const objv1[],	/* First array of pointers to Tcl objects. */
    ListSizeT objc2,		/* Count of objects referenced by objv2. */
    Tcl_Obj *const objv2[]	/* Second array of pointers to Tcl objects. */
)
{
    Tcl_Obj *listObj;
    ListStore *storePtr;
    ListSizeT objc = objc1 + objc2;

    listObj = Tcl_NewListObj(objc, NULL);
    if (objc == 0) {
	return listObj; /* An empty object */
    }
    LIST_ASSERT_TYPE(listObj);

    storePtr = ListObjStorePtr(listObj);

    LIST_ASSERT(ListObjSpanPtr(listObj) == NULL);
    LIST_ASSERT(storePtr->firstUsed == 0);
    LIST_ASSERT(storePtr->numUsed == 0);
    LIST_ASSERT(storePtr->numAllocated >= objc);

    if (objc1) {
	ObjArrayCopy(storePtr->slots, objc1, objv1);
    }
    if (objc2) {
	ObjArrayCopy(&storePtr->slots[objc1], objc2, objv2);
    }
    storePtr->numUsed = objc;
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjGetRep --
 *
 *	This function returns a copy of the ListRep stored
 *	as the internal representation of an object. The reference
 *	counts of the (ListStore, ListSpan) contained in the representation
 *	are NOT incremented.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *listRepP
 *	is set to a copy of the descriptor stored as the internal
 *	representation of the Tcl_Obj containing a list. if listPtr does not
 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object. *repPtr is initialized to the internal rep
 *      if result is TCL_OK, or set to NULL on error.
 *----------------------------------------------------------------------
 */

static int
TclListObjGetRep(
    Tcl_Interp *interp, /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,   /* List object for which an element array is
			 * to be returned. */
    ListRep *repPtr) /* Location to store descriptor */
{
    if (!TclHasInternalRep(listObj, &tclListType)) {
	int result;
	result = SetListFromAny(interp, listObj);
	if (result != TCL_OK) {
	    /* Init to keep gcc happy wrt uninitialized fields at call site */
	    repPtr->storePtr = NULL;
	    repPtr->spanPtr = NULL;
	    return result;
	}
    }
    ListObjGetRep(listObj, repPtr);
    LISTREP_CHECK(repPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	Modify an object to be a list containing each of the objc elements of
 *	the object array referenced by objv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object is made a list object and is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The ref counts of the elements in objv are incremented since the
 *	list now refers to them. The object's old string and internal
 *	representations are freed and its type is set NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetListObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    ListSizeT objc,		/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
{


    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
    }








    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type. NOTE ListRepInit must
     * not be called with objc == 0!
     */

    if (objc + 1 > 1) {
	ListRep listRep;
	/* TODO - perhaps ask for extra space? */
	ListRepInit(objc, objv, LISTREP_PANIC_ON_FAIL, &listRep);
	ListObjReplaceRepAndInvalidate(objPtr, &listRep);
    } else {
	TclFreeInternalRep(objPtr);
	TclInvalidateStringRep(objPtr);
	Tcl_InitStringRep(objPtr, NULL, 0);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Makes a "pure list" copy of a list value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Results:
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
 *	zero. If *listPtr does not hold a list, NULL is returned, and if
 *	interp is non-NULL, an error message is recorded there.

 *
 * Side effects:
 *	None.

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

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listObj)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyObj;


    if (!TclHasInternalRep(listObj, &tclListType)) {

	if (SetListFromAny(interp, listObj) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyObj);
    TclInvalidateStringRep(copyObj);
    DupListInternalRep(listObj, copyObj);
    return copyObj;
}

/*
 *------------------------------------------------------------------------
 *
 * ListRepRange --
 *
 *	Initializes a ListRep as a range within the passed ListRep.
 *	The range limits are clamped to the list boundaries.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *      The ListStore and ListSpan referenced by in the returned ListRep
 *      may or may not be the same as those passed in. For example, the
 *      ListStore may differ because the range is small enough that a new
 *      ListStore is more memory-optimal. The ListSpan may differ because
 *      it is NULL or shared. Regardless, reference counts on the returned
 *      values are not incremented. Generally, ListObjReplaceRepAndInvalidate
 *      may be used to store the new ListRep back into an object or a
 *      ListRepIncrRefs followed by ListRepDecrRefs to free in case of errors.
 *	Any other use should be carefully reconsidered.
 *      TODO WARNING:- this is an awkward interface and easy for caller
 *      to get wrong. Mostly due to refcount combinations. Perhaps passing
 *      in the source listObj instead of source listRep might simplify.
 *
 *------------------------------------------------------------------------
 */
static void
ListRepRange(
    ListRep *srcRepPtr,    /* Contains source of the range */
    ListSizeT rangeStart,  /* Index of first element to include */
    ListSizeT rangeEnd,    /* Index of last element to include */
    int preserveSrcRep,    /* If true, srcRepPtr contents must not be
			      modified (generally because a shared Tcl_Obj
			      references it) */
    ListRep *rangeRepPtr)  /* Output. Must NOT be == srcRepPtr */
{
    Tcl_Obj **srcElems;
    ListSizeT numSrcElems = ListRepLength(srcRepPtr);
    ListSizeT rangeLen;
    ListSizeT numAfterRangeEnd;

    LISTREP_CHECK(srcRepPtr);

    /* Take the opportunity to garbage collect */
    /* TODO - we probably do not need the preserveSrcRep here unlike later */
    if (!preserveSrcRep) {
        /* T:listrep-1.{4,5,8,9},2.{4:7},3.{15:18},4.{7,8} */
	ListRepFreeUnreferenced(srcRepPtr);
    } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */

    if (rangeStart == TCL_INDEX_NONE) {
	rangeStart = 0;
    }
    if ((rangeEnd != TCL_INDEX_NONE) && (rangeEnd >= numSrcElems)) {
	rangeEnd = numSrcElems - 1;
    }
    if (rangeStart + 1 > rangeEnd + 1) {
	/* Empty list of capacity 1. */
	ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr);
	return;
    }

    rangeLen = rangeEnd - rangeStart + 1;

    /*
     * We can create a range one of four ways:
     *  (0) Range encapsulates entire list
     *  (1) Special case: deleting in-place from end of an unshared object
     *  (2) Use a ListSpan referencing the current ListStore
     *  (3) Creating a new ListStore
     *  (4) Removing all elements outside the range in the current ListStore
     * Option (4) may only be done if caller has not disallowed it AND
     * the ListStore is not shared.
     *
     * The choice depends on heuristics related to speed and memory.
     * TODO - heuristics below need to be measured and tuned.
     *
     * Note: Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end] so the Tcl_Obj should not
     * be returned as is even if the range encompasses the whole list.
     */
    if (rangeStart == 0 && rangeEnd == (numSrcElems-1)) {
	/* Option 0 - entire list. This may be used to canonicalize */
        /* T:listrep-1.10.1,2.8.1 */
	*rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */
    } else if (rangeStart == 0 && (!preserveSrcRep)
	       && (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) {
	/* Option 1 - Special case unshared, exclude end elements, no span  */
	LIST_ASSERT(srcRepPtr->storePtr->firstUsed == 0); /* If no span */
	ListRepElements(srcRepPtr, numSrcElems, srcElems);
	numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
	/* Assert: Because numSrcElems > rangeEnd earlier */
	if (numAfterRangeEnd != 0) {
            /* T:listrep-1.{8,9} */
	    ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
	}
	/* srcRepPtr->storePtr->firstUsed,numAllocated unchanged */
	srcRepPtr->storePtr->numUsed = rangeLen;
	srcRepPtr->storePtr->flags = 0;
	rangeRepPtr->storePtr = srcRepPtr->storePtr; /* Note no incr ref */
	rangeRepPtr->spanPtr = NULL;
    } else if (ListSpanMerited(rangeLen,
			       srcRepPtr->storePtr->numUsed,
			       srcRepPtr->storePtr->numAllocated)) {
	/* Option 2 - because span would be most efficient */
	ListSizeT spanStart = ListRepStart(srcRepPtr) + rangeStart;
	if (!preserveSrcRep && srcRepPtr->spanPtr
	    && srcRepPtr->spanPtr->refCount <= 1) {
	    /* If span is not shared reuse it */
            /* T:listrep-2.7.3,3.{16,18} */
	    srcRepPtr->spanPtr->spanStart = spanStart;
	    srcRepPtr->spanPtr->spanLength = rangeLen;
	    *rangeRepPtr = *srcRepPtr;
	} else {
	    /* Span not present or is shared. */
            /* T:listrep-1.5,2.{5,7},4.{7,8} */
	    rangeRepPtr->storePtr = srcRepPtr->storePtr;
	    rangeRepPtr->spanPtr = ListSpanNew(spanStart, rangeLen);
	}
        /*
         * We have potentially created a new internal representation that
         * references the same storage as srcRep but not yet incremented its
         * reference count. So do NOT call freezombies if preserveSrcRep
         * is mandated.
         */
	if (!preserveSrcRep) {
            /* T:listrep-1.{5.1,5.2,5.4},2.{5,7},3.{16,18},4.{7,8} */
	    ListRepFreeUnreferenced(rangeRepPtr);
	}
    } else if (preserveSrcRep || ListRepIsShared(srcRepPtr)) {
	/* Option 3 - span or modification in place not allowed/desired */
        /* T:listrep-2.{4,6} */
	ListRepElements(srcRepPtr, numSrcElems, srcElems);
	/* TODO - allocate extra space? */
	ListRepInit(rangeLen,
		    &srcElems[rangeStart],
		    LISTREP_PANIC_ON_FAIL,
		    rangeRepPtr);
    } else {
	/*
	 * Option 4 - modify in place. Note that because of the invariant
	 * that spanless list stores must start at 0, we have to move
	 * everything to the front.
	 * TODO - perhaps if a span already exists, no need to move to front?
	 * or maybe no need to move all the way to the front?
	 * TODO - if range is small relative to allocation, allocate new?
	 */

	/* Asserts follow from call to ListRepFreeUnreferenced earlier */
	LIST_ASSERT(!preserveSrcRep);
	LIST_ASSERT(!ListRepIsShared(srcRepPtr));
	LIST_ASSERT(ListRepStart(srcRepPtr) == srcRepPtr->storePtr->firstUsed);
	LIST_ASSERT(ListRepLength(srcRepPtr) == srcRepPtr->storePtr->numUsed);

	ListRepElements(srcRepPtr, numSrcElems, srcElems);

	/* Free leading elements outside range */
	if (rangeStart != 0) {
            /* T:listrep-1.4,3.15 */
	    ObjArrayDecrRefs(srcElems, 0, rangeStart);
	}
	/* Ditto for trailing */
	numAfterRangeEnd = numSrcElems - (rangeEnd + 1);
	/* Assert: Because numSrcElems > rangeEnd earlier */
	if (numAfterRangeEnd != 0) {
            /* T:listrep-3.17 */
	    ObjArrayDecrRefs(srcElems, rangeEnd + 1, numAfterRangeEnd);
	}
	memmove(&srcRepPtr->storePtr->slots[0],
		&srcRepPtr->storePtr
		     ->slots[srcRepPtr->storePtr->firstUsed + rangeStart],
		rangeLen * sizeof(Tcl_Obj *));
	srcRepPtr->storePtr->firstUsed = 0;
	srcRepPtr->storePtr->numUsed = rangeLen;
	srcRepPtr->storePtr->flags = 0;
	if (srcRepPtr->spanPtr) {
	    /* In case the source has a span, update it for consistency */
            /* T:listrep-3.{15,17} */
	    srcRepPtr->spanPtr->spanStart = srcRepPtr->storePtr->firstUsed;
	    srcRepPtr->spanPtr->spanLength = srcRepPtr->storePtr->numUsed;
	}
	rangeRepPtr->storePtr = srcRepPtr->storePtr;
	rangeRepPtr->spanPtr = NULL;
    }

    /* TODO - call freezombies here if !preserveSrcRep? */

    /* Note ref counts intentionally not incremented */
    LISTREP_CHECK(rangeRepPtr);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjRange --
 *
 *	Makes a slice of a list value.
 *      *listObj must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced list.
 *      This may be a new object or the same object if not shared.
 *	Returns NULL if passed listObj was not a list and could not be
 *	converted to one.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Obj *listObj,		/* List object to take a range from. */
    ListSizeT rangeStart,	/* Index of first element to include. */
    ListSizeT rangeEnd)		/* Index of last element to include. */
{

    ListRep listRep;
    ListRep resultRep;


    int isShared;
    if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK)








	return NULL;

















    isShared = Tcl_IsShared(listObj);





    ListRepRange(&listRep, rangeStart, rangeEnd, isShared, &resultRep);






    if (isShared) {




        /* T:listrep-1.10.1,2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */
	TclNewObj(listObj);
    } /* T:listrep-1.{4.3,5.1,5.2} */
    ListObjReplaceRepAndInvalidate(listObj, &resultRep);
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	object.

 *

 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *





 * Side effects:

 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ListObjGetElements
int
Tcl_ListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *objPtr,		/* List object for which an element array is
				 * to be returned. */
    ListSizeT *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    ListRep listRep;


    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)








	return TCL_ERROR;







    ListRepElements(&listRep, *objcPtr, *objvPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	This function appends the elements in the list fromObj
 *	to toObj. toObj must not be shared else the function will panic.
 *
 * Results:

 *	The return value is normally TCL_OK. If fromObj or toObj do not



 *	refer to list values, TCL_ERROR is returned and an error message is


 *	left in the interpreter's result if interp is not NULL.
 *
 * Side effects:

 *	The reference counts of the elements in fromObj are incremented

 *	since the list now refers to them. toObj and fromObj are
 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause toObj's array of element pointers to grow.
 *	toObj's old string representation, if any, is invalidated.

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

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elements to. */
    Tcl_Obj *fromObj)		/* List obj with elements to append. */
{
    ListSizeT objc;
    Tcl_Obj **objv;

    if (Tcl_IsShared(toObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
    }





    if (TclListObjGetElementsM(interp, fromObj, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Insert the new elements starting after the lists's last element.
     * Delete zero existing elements.
     */

    return TclListObjAppendElements(interp, toObj, objc, objv);
}

/*
 *------------------------------------------------------------------------
 *
 * TclListObjAppendElements --
 *
 *      Appends multiple elements to a Tcl_Obj list object. If
 *      the passed Tcl_Obj is not a list object, it will be converted to one
 *      and an error raised if the conversion fails.
 *
 * 	The Tcl_Obj must not be shared though the internal representation
 * 	may be.
 *
 * Results:
 *	On success, TCL_OK is returned with the specified elements appended.
 *	On failure, TCL_ERROR is returned with an error message in the
 *	interpreter if not NULL.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
 int TclListObjAppendElements (
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append */
    ListSizeT elemCount,        /* Number of elements in elemObjs[] */
    Tcl_Obj * const elemObjv[])	/* Objects to append to toObj's list. */
{
    ListRep listRep;
    Tcl_Obj **toObjv;
    ListSizeT toLen;
    ListSizeT finalLen;

    if (Tcl_IsShared(toObj)) {
	Tcl_Panic("%s called with shared object", "TclListObjAppendElements");
    }

    if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK)
	return TCL_ERROR; /* Cannot be converted to a list */

    if (elemCount == 0)
	return TCL_OK; /* Nothing to do. Note AFTER check for list above */

    ListRepElements(&listRep, toLen, toObjv);
    if (elemCount > LIST_MAX || toLen > (LIST_MAX - elemCount)) {
	return ListLimitExceededError(interp);
    }

    finalLen = toLen + elemCount;
    if (!ListRepIsShared(&listRep)) {
	/*
	 * Reuse storage if possible. Even if too small, realloc-ing instead
	 * of creating a new ListStore will save us on manipulating Tcl_Obj
	 * reference counts on the elements which is a substantial cost
	 * if the list is not small.
	 */
	ListSizeT numTailFree;

	ListRepFreeUnreferenced(&listRep); /* Collect garbage before checking room */

	LIST_ASSERT(ListRepStart(&listRep) == listRep.storePtr->firstUsed);
	LIST_ASSERT(ListRepLength(&listRep) == listRep.storePtr->numUsed);
	LIST_ASSERT(toLen == listRep.storePtr->numUsed);

	if (finalLen > listRep.storePtr->numAllocated) {
	    /* T:listrep-1.{2,11},3.6 */
	    ListStore *newStorePtr;
	    newStorePtr = ListStoreReallocate(listRep.storePtr, finalLen);
	    if (newStorePtr == NULL) {
		return MemoryAllocationError(interp, LIST_SIZE(finalLen));
	    }
	    LIST_ASSERT(newStorePtr->numAllocated >= finalLen);
	    listRep.storePtr = newStorePtr;
	    /*
	     * WARNING: at this point the Tcl_Obj internal rep potentially
	     * points to freed storage if the reallocation returned a
	     * different location. Overwrite it to bring it back in sync.
	     */
	    ListObjStompRep(toObj, &listRep);
	} /* else T:listrep-3.{4,5} */
	LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen);
	/* Current store big enough */
	numTailFree = ListRepNumFreeTail(&listRep);
	LIST_ASSERT((numTailFree + listRep.storePtr->firstUsed)
		    >= elemCount); /* Total free */
	if (numTailFree < elemCount) {
	    /* Not enough room at back. Move some to front */
            /* T:listrep-3.5 */
	    ListSizeT shiftCount = elemCount - numTailFree;
	    /* Divide remaining space between front and back */
	    shiftCount += (listRep.storePtr->numAllocated - finalLen) / 2;
	    LIST_ASSERT(shiftCount <= listRep.storePtr->firstUsed);
	    if (shiftCount) {
                /* T:listrep-3.5 */
		ListRepUnsharedShiftDown(&listRep, shiftCount);
            }
	} /* else T:listrep-3.{4,6} */
	ObjArrayCopy(&listRep.storePtr->slots[ListRepStart(&listRep)
					      + ListRepLength(&listRep)],
		     elemCount,
		     elemObjv);
	listRep.storePtr->numUsed = finalLen;
	if (listRep.spanPtr) {
            /* T:listrep-3.{4,5,6} */
	    LIST_ASSERT(listRep.spanPtr->spanStart
			== listRep.storePtr->firstUsed);
	    listRep.spanPtr->spanLength = finalLen;
	} /* else T:listrep-3.6.3 */
	LIST_ASSERT(ListRepStart(&listRep) == listRep.storePtr->firstUsed);
	LIST_ASSERT(ListRepLength(&listRep) == finalLen);
	LISTREP_CHECK(&listRep);

	ListObjReplaceRepAndInvalidate(toObj, &listRep);
	return TCL_OK;
    }

    /*
     * Have to make a new list rep, either shared or no room in old one.
     * If the old list did not have a span (all elements at front), do
     * not leave space in the front either, assuming all appends and no
     * prepends.
     */
    if (ListRepInit(finalLen,
		    NULL,
		    listRep.spanPtr ? LISTREP_SPACE_FAVOR_BACK
				    : LISTREP_SPACE_ONLY_BACK,
		    &listRep)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen);

    if (toLen) {
        /* T:listrep-2.{2,9},4.5 */
	ObjArrayCopy(ListRepSlotPtr(&listRep, 0), toLen, toObjv);
    }
    ObjArrayCopy(ListRepSlotPtr(&listRep, toLen), elemCount, elemObjv);
    listRep.storePtr->numUsed = finalLen;
    if (listRep.spanPtr) {
        /* T:listrep-4.5 */
	LIST_ASSERT(listRep.spanPtr->spanStart == listRep.storePtr->firstUsed);
	listRep.spanPtr->spanLength = finalLen;
    }
    LISTREP_CHECK(&listRep);
    ListObjReplaceRepAndInvalidate(toObj, &listRep);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	This function is a special purpose version of Tcl_ListObjAppendList:
 *	it appends a single object referenced by elemObj to the list object
 *	referenced by toObj. If toObj is not already a list object, an
 *	attempt will be made to convert it to one.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case elemObj is added to


 *	the end of toObj's list. If toObj does not refer to a list object


 *	and the object can not be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Side effects:


 *	The ref count of elemObj is incremented since the list now refers to
 *	it. toObj will be converted, if necessary, to a list object. Also,
 *	appending the new element may cause listObj's array of element
 *	pointers to grow. toObj's old string representation, if any, is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *toObj,		/* List object to append elemObj to. */
    Tcl_Obj *elemObj)		/* Object to append to toObj's list. */
{









































    /*


     * TODO - compare perf with 8.6 to see if worth optimizing single


















































     * element case








     */









    return TclListObjAppendElements(interp, toObj, 1, &elemObj);



























}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 *	This function returns a pointer to the index'th object from the list
 *	referenced by listPtr. The first element has index 0. If index is
 *	negative or greater than or equal to the number of elements in the
 *	list, a NULL is returned. If listPtr is not a list object, an attempt
 *	will be made to convert it to a list.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case objPtrPtr is set to
 *	the Tcl_Obj pointer for the index'th list element or NULL if index is
 *	out of range. This object should be treated as readonly and its ref
 *	count is _not_ incremented; the caller must do that if it holds on to
 *	the reference. If listPtr does not refer to a list and can't be

 *	converted to one, TCL_ERROR is returned and an error message is left


 *	in the interpreter's result if interp is not NULL.
 *
 * Side effects:

 *	listPtr will be converted, if necessary, to a list object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjIndex(
    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
    Tcl_Obj *listObj,    /* List object to index into. */
    ListSizeT index,           /* Index of element to return. */
    Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
{
    Tcl_Obj **elemObjs;
    ListSizeT numElems;



    /*
     * TODO
     * Unlike the original list code, this does not optimize for lindex'ing
     * an empty string when the internal rep is not already a list. On the
     * other hand, this code will be faster for the case where the object
     * is currently a dict. Benchmark the two cases.
     */


    if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
	!= TCL_OK) {
	return TCL_ERROR;
    }



    if (index >= numElems) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = elemObjs[index];
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 *	This function returns the number of elements in a list object. If the
 *	object is not already a list object, an attempt will be made to
 *	convert it to one.
 *
 * Results:

 *	The return value is normally TCL_OK; in this case *intPtr will be set

 *	to the integer count of list elements. If listPtr does not refer to a
 *	list object and the object can not be converted to one, TCL_ERROR is
 *	returned and an error message will be left in the interpreter's result
 *	if interp is not NULL.

 *

 * Side effects:
 *	The possible conversion of the argument object to a list object.

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

#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
    Tcl_Obj *listObj,	/* List object whose #elements to return. */
    ListSizeT *lenPtr)	/* The resulting int is stored here. */
{
    ListRep listRep;



    /*
     * TODO
     * Unlike the original list code, this does not optimize for lindex'ing
     * an empty string when the internal rep is not already a list. On the
     * other hand, this code will be faster for the case where the object
     * is currently a dict. Benchmark the two cases.

     */
    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
	return TCL_ERROR;
    }






    *lenPtr = ListRepLength(&listRep);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	This function replaces zero or more elements of the list referenced by
 *	listObj with the objects from an (objc,objv) array. The objc elements
 *	of the array referenced by objv replace the count elements in listPtr
 *	starting at first.
 *
 *	If the argument first is zero or negative, it refers to the first
 *	element. If first is greater than or equal to the number of elements
 *	in the list, then no elements are deleted; the new elements are

 *	appended to the list. Count gives the number of elements to replace.
 *	If count is zero or negative then no elements are deleted; the new
 *	elements are simply inserted before first.
 *



 *	The argument objv refers to an array of objc pointers to the new
 *	elements to be added to listPtr in place of those that were deleted.
 *	If objv is NULL, no new elements are added. If listPtr is not a list
 *	object, an attempt will be made to convert it to one.
 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr does not refer to a
 *	list object and can not be converted to one, TCL_ERROR is returned and

 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Side effects:


 *	The ref counts of the objc elements in objv are incremented since the

 *	resulting list now refers to them. Similarly, the ref counts for

 *	replaced objects are decremented. listObj is converted, if necessary,
 *	to a list object. listObj's old string representation, if any, is
 *	freed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *listObj,		/* List object whose elements to replace. */
    ListSizeT first,		/* Index of first element to replace. */
    ListSizeT numToDelete,	/* Number of elements to replace. */
    ListSizeT numToInsert,	/* Number of objects to insert. */
    Tcl_Obj *const insertObjs[])/* Tcl objects to insert */

{
    ListRep listRep;
    ListSizeT origListLen;
    ptrdiff_t lenChange;
    ptrdiff_t leadSegmentLen;
    ptrdiff_t tailSegmentLen;
    ListSizeT numFreeSlots;
    ptrdiff_t leadShift;
    ptrdiff_t tailShift;
    Tcl_Obj **listObjs;

    int favor;

    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }




    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK)



	return TCL_ERROR; /* Cannot be converted to a list */




    /* TODO - will need modification if Tcl9 sticks to unsigned indices */






    /* Make limits sane */







    origListLen = ListRepLength(&listRep);



    if (first == TCL_INDEX_NONE) {
	first = 0;
    }
    if (first > origListLen) {
	first = origListLen;	/* So we'll insert after last element. */
    }
    if (numToDelete == TCL_INDEX_NONE) {
	numToDelete = 0;
    } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */
             || origListLen < first + numToDelete) {
	numToDelete = origListLen - first;
    }

    if (numToInsert > ListSizeT_MAX - (origListLen - numToDelete)) {
	return ListLimitExceededError(interp);
    }


    if ((first+numToDelete) >= origListLen) {
	/* Operating at back of list. Favor leaving space at back */
	favor = LISTREP_SPACE_FAVOR_BACK;
    } else if (first == 0) {
	/* Operating on front of list. Favor leaving space in front */
	favor = LISTREP_SPACE_FAVOR_FRONT;
    } else {
	/* Operating on middle of list. */
	favor = LISTREP_SPACE_FAVOR_NONE;
    }

    /*
     * There are a number of special cases to consider from an optimization
     * point of view.
     * (1) Pure deletes (numToInsert==0) from the front or back can be treated
     * as a range op irrespective of whether the ListStore is shared or not
     * (2) Pure inserts (numToDelete == 0)
     *   (2a) Pure inserts at the back can be treated as appends
     *   (2b) Pure inserts from the *front* can be optimized under certain
     *   conditions by inserting before first ListStore slot in use if there
     *   is room, again irrespective of sharing
     * (3) If the ListStore is shared OR there is insufficient free space
     * OR existing allocation is too large compared to new size, create
     * a new ListStore
     * (4) Unshared ListStore with sufficient free space. Delete, shift and
     * insert within the ListStore.
     */

    /* Note: do not do TclInvalidateStringRep as yet in case there are errors */

    /* Check Case (1) - Treat pure deletes from front or back as range ops */
    if (numToInsert == 0) {
	if (numToDelete == 0) {
	    /*
             * Should force canonical even for no-op. Remember Tcl_Obj unshared
             * so OK to invalidate string rep
             */
            /* T:listrep-1.10,2.8 */
	    TclInvalidateStringRep(listObj);
	    return TCL_OK;
	}
	if (first == 0) {
	    /* Delete from front, so return tail. */
            /* T:listrep-1.{4,5},2.{4,5},3.{15,16},4.7 */
	    ListRep tailRep;

	    ListRepRange(&listRep, numToDelete, origListLen-1, 0, &tailRep);
	    ListObjReplaceRepAndInvalidate(listObj, &tailRep);
	    return TCL_OK;
	} else if ((first+numToDelete) >= origListLen) {
	    /* Delete from tail, so return head */
            /* T:listrep-1.{8,9},2.{6,7},3.{17,18},4.8 */
	    ListRep headRep;
	    ListRepRange(&listRep, 0, first-1, 0, &headRep);
	    ListObjReplaceRepAndInvalidate(listObj, &headRep);
	    return TCL_OK;
	}




	/* Deletion from middle. Fall through to general case */
    }

    /* Garbage collect before checking the pure insert optimization */
    ListRepFreeUnreferenced(&listRep);

    /*
     * Check Case (2) - pure inserts under certain conditions:
     */




    if (numToDelete == 0) {
	/* Case (2a) - Append to list. */
	if (first == origListLen) {
            /* T:listrep-1.11,2.9,3.{5,6},2.2.1 */
	    return TclListObjAppendElements(
		interp, listObj, numToInsert, insertObjs);
	}

	/*
	 * Case (2b) - pure inserts at front under some circumstances
	 * (i) Insertion must be at head of list
	 * (ii) The list's span must be at head of the in-use slots in the store
	 * (iii) There must be unused room at front of the store
	 * NOTE THIS IS TRUE EVEN IF THE ListStore IS SHARED as it will not
	 * affect the other Tcl_Obj's referencing this ListStore.
	 */
	if (first == 0 &&                                            /* (i) */
	    ListRepStart(&listRep) == listRep.storePtr->firstUsed && /* (ii) */
	    numToInsert <= listRep.storePtr->firstUsed               /* (iii) */
	) {
	    ListSizeT newLen;
	    LIST_ASSERT(numToInsert); /* Else would have returned above */
	    listRep.storePtr->firstUsed -= numToInsert;
	    ObjArrayCopy(&listRep.storePtr->slots[listRep.storePtr->firstUsed],
			 numToInsert,
			 insertObjs);
	    listRep.storePtr->numUsed += numToInsert;
	    newLen = listRep.spanPtr->spanLength + numToInsert;
	    if (listRep.spanPtr && listRep.spanPtr->refCount <= 1) {
		/* An unshared span record, re-use it */
                /* T:listrep-3.1 */
		listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
		listRep.spanPtr->spanLength = newLen;
	    } else {
		/* Need a new span record */
		if (listRep.storePtr->firstUsed == 0) {
		    listRep.spanPtr = NULL;
		} else {
                    /* T:listrep-4.3 */
		    listRep.spanPtr =
			ListSpanNew(listRep.storePtr->firstUsed, newLen);
		}




	    }


	    ListObjReplaceRepAndInvalidate(listObj, &listRep);
	    return TCL_OK;
	}

    }

    /* Just for readability of the code */
    lenChange = numToInsert - numToDelete;
    leadSegmentLen = first;
    tailSegmentLen = origListLen - (first + numToDelete);
    numFreeSlots = listRep.storePtr->numAllocated - listRep.storePtr->numUsed;

    /*

     * Before further processing, if unshared, try and reallocate to avoid
     * new allocation below. This avoids expensive ref count manipulation
     * later by not having to go through the ListRepInit and
     * ListObjReplaceAndInvalidate below.
     * TODO - we could be smarter about the reallocate. Use of realloc
     * means all new free space is at the back. Instead, the realloc could
     * be an explicit alloc and memmove which would let us redistribute
     * free space.
     */
    if ((ptrdiff_t)numFreeSlots < lenChange && !ListRepIsShared(&listRep)) {
	/* T:listrep-1.{1,3,14,18,21},3.{3,10,11,14,27,32,41} */
	ListStore *newStorePtr =
	    ListStoreReallocate(listRep.storePtr, origListLen + lenChange);
	if (newStorePtr == NULL) {
	    return MemoryAllocationError(interp,
					 LIST_SIZE(origListLen + lenChange));
	}
	listRep.storePtr = newStorePtr;
	numFreeSlots =


	    listRep.storePtr->numAllocated - listRep.storePtr->numUsed;
	/*
	 * WARNING: at this point the Tcl_Obj internal rep potentially
	 * points to freed storage if the reallocation returned a
	 * different location. Overwrite it to bring it back in sync.
	 */
	ListObjStompRep(listObj, &listRep);
    }



    /*
     * Case (3) a new ListStore is required
     * (a) The passed-in ListStore is shared
     * (b) There is not enough free space in the unshared passed-in ListStore
     * (c) The new unshared size is much "smaller" (TODO) than the allocated space
     * TODO - for unshared case ONLY, consider a "move" based implementation
     */
    if (ListRepIsShared(&listRep) || /* 3a */
	(ptrdiff_t)numFreeSlots < lenChange ||  /* 3b */
	(origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */
    ) {
	ListRep newRep;
	Tcl_Obj **toObjs;
	listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)];
	ListRepInit(origListLen + lenChange,
		    NULL,
		    LISTREP_PANIC_ON_FAIL | favor,
		    &newRep);
	toObjs = ListRepSlotPtr(&newRep, 0);
	if (leadSegmentLen > 0) {
            /* T:listrep-2.{2,3,13:18},4.{6,9,13:18} */
	    ObjArrayCopy(toObjs, leadSegmentLen, listObjs);
	}
	if (numToInsert > 0) {
            /* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,10:18} */
	    ObjArrayCopy(&toObjs[leadSegmentLen],
			 numToInsert,
			 insertObjs);
	}
	if (tailSegmentLen > 0) {
            /* T:listrep-2.{1,2,3,10:15},4.{1,2,4,6,9:12,16:18} */
	    ObjArrayCopy(&toObjs[leadSegmentLen + numToInsert],

			 tailSegmentLen,
			 &listObjs[leadSegmentLen+numToDelete]);
	}
	newRep.storePtr->numUsed = origListLen + lenChange;
	if (newRep.spanPtr) {
            /* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,9:18} */
	    newRep.spanPtr->spanLength = newRep.storePtr->numUsed;
	}

	LISTREP_CHECK(&newRep);
	ListObjReplaceRepAndInvalidate(listObj, &newRep);


	return TCL_OK;
    }

    /*
     * Case (4) - unshared ListStore with sufficient room.
     * After deleting elements, there will be a corresponding gap. If this
     * gap does not match number of insertions, either the lead segment,
     * or the tail segment, or both will have to be moved.
     * The general strategy is to move the fewest number of elements. If
     *
     * TODO - what about appends to unshared ? Is below sufficiently optimal?
     */

    /* Following must hold for unshared listreps after ListRepFreeUnreferenced above */
    LIST_ASSERT(origListLen == listRep.storePtr->numUsed);
    LIST_ASSERT(origListLen == ListRepLength(&listRep));
    LIST_ASSERT(ListRepStart(&listRep) == listRep.storePtr->firstUsed);

    LIST_ASSERT((numToDelete + numToInsert) > 0);


    /* Base of slot array holding the list elements */
    listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)];


    /*
     * Free up elements to be deleted. Before that, increment the ref counts
     * for objects to be inserted in case there is overlap. T:listobj-11.1
     */
    if (numToInsert) {
	/* T:listrep-1.{1,3,12:21},3.{2,3,7:14,23:41} */
	ObjArrayIncrRefs(insertObjs, 0, numToInsert);
    }
    if (numToDelete) {
        /* T:listrep-1.{6,7,12:21},3.{19:41} */
	ObjArrayDecrRefs(listObjs, first, numToDelete);
    }

    /*
     * TODO - below the moves are optimized but this may result in needing a
     * span allocation. Perhaps for small lists, it may be more efficient to
     * just move everything up front and save on allocating a span.
     */

    /*
     * Calculate shifts if necessary to accomodate insertions.
     * NOTE: all indices are relative to listObjs which is not necessarily the
     * start of the ListStore storage area.

     *
     * leadShift - how much to shift the lead segment
     * tailShift - how much to shift the tail segment
     * insertTarget - index where to insert.
     */

    if (lenChange == 0) {
	/* T:listrep-1.{12,15,19},3.{23,28,33}. Exact fit */
	leadShift = 0;
	tailShift = 0;
    } else if (lenChange < 0) {
	/*


	 * More deletions than insertions. The gap after deletions is large
	 * enough for insertions. Move a segment depending on size.
	 */
	if (leadSegmentLen > tailSegmentLen) {
	    /* Tail segment smaller. Insert after lead, move tail down */
            /* T:listrep-1.{7,17,20},3.{21,2229,35} */
	    leadShift = 0;
	    tailShift = lenChange;
	} else {
	    /* Lead segment smaller. Insert before tail, move lead up */
            /* T:listrep-1.{6,13,16},3.{19,20,24,34} */
	    leadShift = -lenChange;
	    tailShift = 0;
	}


    } else {
	LIST_ASSERT(lenChange > 0); /* Reminder */

	/*
	 * We need to make room for the insertions. Again we have multiple
	 * possibilities. We may be able to get by just shifting one segment
	 * or need to shift both. In the former case, favor shifting the
	 * smaller segment.
	 */
	ptrdiff_t leadSpace = ListRepNumFreeHead(&listRep);
	ptrdiff_t tailSpace = ListRepNumFreeTail(&listRep);
	ptrdiff_t finalFreeSpace = leadSpace + tailSpace - lenChange;

	LIST_ASSERT((leadSpace + tailSpace) >= lenChange);
	if (leadSpace >= lenChange

	    && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) {
	    /* Move only lead to the front to make more room */
            /* T:listrep-3.25,36,38, */
	    leadShift = -lenChange;
	    tailShift = 0;
	    /*
	     * Redistribute the remaining free space between the front and
	     * back if either there is no tail space left or if the
	     * entire list is the head anyways. This is an important
	     * optimization for further operations like further asymmetric
	     * insertions.
	     */
	    if (finalFreeSpace > 1 && (tailSpace == 0 || tailSegmentLen == 0)) {
		ptrdiff_t postShiftLeadSpace = leadSpace - lenChange;
		if (postShiftLeadSpace > (finalFreeSpace/2)) {
		    ListSizeT extraShift = postShiftLeadSpace - (finalFreeSpace / 2);
		    leadShift -= extraShift;
		    tailShift = -extraShift; /* Move tail to the front as well */
		}
	    } /* else T:listrep-3.{7,12,25,38} */
	    LIST_ASSERT(leadShift >= 0 || leadSpace >= -leadShift);
	} else if (tailSpace >= lenChange) {
	    /* Move only tail segment to the back to make more room. */
            /* T:listrep-3.{8,10,11,14,26,27,30,32,37,39,41} */
	    leadShift = 0;
	    tailShift = lenChange;
	    /*
	     * See comments above. This is analogous.
	     */
	    if (finalFreeSpace > 1 && (leadSpace == 0 || leadSegmentLen == 0)) {
		ptrdiff_t postShiftTailSpace = tailSpace - lenChange;
		if (postShiftTailSpace > (finalFreeSpace/2)) {
		    /* T:listrep-1.{1,3,14,18,21},3.{2,3,26,27} */
		    ListSizeT extraShift = postShiftTailSpace - (finalFreeSpace / 2);
		    tailShift += extraShift;
		    leadShift = extraShift; /* Move head to the back as well */
		}


	    }

	    LIST_ASSERT(tailShift <= tailSpace);
	} else {
	    /*
	     * Both lead and tail need to be shifted to make room.
	     * Divide remaining free space equally between front and back.
	     */
            /* T:listrep-3.{9,13,31,40} */
	    LIST_ASSERT(leadSpace < lenChange);
	    LIST_ASSERT(tailSpace < lenChange);

	    /*
	     * leadShift = leadSpace - (finalFreeSpace/2)
	     * Thus leadShift <= leadSpace
	     * Also,
	     * = leadSpace - (leadSpace + tailSpace - lenChange)/2
	     * = leadSpace/2 - tailSpace/2 + lenChange/2
	     * >= 0 because lenChange > tailSpace
	     */
	    leadShift = leadSpace - (finalFreeSpace / 2);
	    tailShift = lenChange - leadShift;
	    if (tailShift > tailSpace) {
		/* Account for integer division errors */
		leadShift += 1;
		tailShift -= 1;
	    }
	    /*


	     * Following must be true because otherwise one of the previous
	     * if clauses would have been taken.
	     */
	    LIST_ASSERT(leadShift > 0 && leadShift < lenChange);
	    LIST_ASSERT(tailShift > 0 && tailShift < lenChange);
	    leadShift = -leadShift; /* Lead is actually shifted downward */
	}
    }


    /* Careful about order of moves! */
    if (leadShift > 0) {

	/* Will happen when we have to make room at bottom */
	if (tailShift != 0 && tailSegmentLen != 0) {
            /* T:listrep-1.{1,3,14,18},3.{2,3,26,27} */
	    ListSizeT tailStart = leadSegmentLen + numToDelete;
	    memmove(&listObjs[tailStart + tailShift],
		    &listObjs[tailStart],
		    tailSegmentLen * sizeof(Tcl_Obj *));
	}
	if (leadSegmentLen != 0) {
            /* T:listrep-1.{3,6,16,18,21},3.{19,20,34} */
	    memmove(&listObjs[leadShift],
		    &listObjs[0],
		    leadSegmentLen * sizeof(Tcl_Obj *));
	}
    } else {
	if (leadShift != 0 && leadSegmentLen != 0) {
            /* T:listrep-3.{7,9,12,13,31,36,38,40} */
	    memmove(&listObjs[leadShift],
		    &listObjs[0],
		    leadSegmentLen * sizeof(Tcl_Obj *));
	}
	if (tailShift != 0 && tailSegmentLen != 0) {



            /* T:listrep-1.{7,17},3.{8:11,13,14,21,22,35,37,39:41} */
	    ListSizeT tailStart = leadSegmentLen + numToDelete;
	    memmove(&listObjs[tailStart + tailShift],
		    &listObjs[tailStart],
		    tailSegmentLen * sizeof(Tcl_Obj *));
	}


    }
    if (numToInsert) {
	/* Do NOT use ObjArrayCopy here since we have already incr'ed ref counts */
        /* T:listrep-1.{1,3,12:21},3.{2,3,7:14,23:41} */
	memmove(&listObjs[leadSegmentLen + leadShift],
		insertObjs,
		numToInsert * sizeof(Tcl_Obj *));
    }




    listRep.storePtr->firstUsed += leadShift;
    listRep.storePtr->numUsed = origListLen + lenChange;
    listRep.storePtr->flags = 0;


    if (listRep.spanPtr && listRep.spanPtr->refCount <= 1) {
	/* An unshared span record, re-use it, even if not required */
        /* T:listrep-3.{2,3,7:14},3.{19:41} */
	listRep.spanPtr->spanStart = listRep.storePtr->firstUsed;
	listRep.spanPtr->spanLength = listRep.storePtr->numUsed;
    } else {
	/* Need a new span record */
	if (listRep.storePtr->firstUsed == 0) {
            /* T:listrep-1.{7,12,15,17,19,20} */
	    listRep.spanPtr = NULL;
	} else {
            /* T:listrep-1.{1,3,6.1,13,14,16,18,21} */
	    listRep.spanPtr = ListSpanNew(listRep.storePtr->firstUsed,
					  listRep.storePtr->numUsed);
	}
    }

    LISTREP_CHECK(&listRep);
    ListObjReplaceRepAndInvalidate(listObj, &listRep);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	This procedure handles the 'lindex' command when objc==3.
 *
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 * Side effects:
 *	None.


 *
 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLindexFlat. All it does is reconfigure the argument format into the
 *	form required by TclLindexFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful internalreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* List being unpacked. */
    Tcl_Obj *argObj)		/* Index or index list. */
{

    ListSizeT index;			/* Index into the list. */
    Tcl_Obj *indexListCopy;
    Tcl_Obj **indexObjs;
    ListSizeT numIndexObjs;

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; if internal rep is already a list do not shimmer it.
     * see TIP#22 and TIP#33 for the details.
     */

    if (!TclHasInternalRep(argObj, &tclListType)

	&& TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index)
	       == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listObj, 1, &argObj);
    }

    /*
     * Here we make a private copy of the index list argument to avoid any
     * shimmering issues that might invalidate the indices array below while
     * we are still using it. This is probably unnecessary. It does not appear
     * that any damaging shimmering is possible, and no test has been devised
     * to show any error when this private copy is not made. But it's cheap,
     * and it offers some future-proofing insurance in case the TclLindexFlat
     * implementation changes in some unexpected way, or some new form of
     * trace or callback permits things to happen that the current
     * implementation does not.
     */

    indexListCopy = TclListObjCopy(NULL, argObj);
    if (indexListCopy == NULL) {
	/*
	 * The argument is neither an index nor a well-formed list.
	 * Report the error via TclLindexFlat.
	 * TODO - This is as original. why not directly return an error?
	 */

	return TclLindexFlat(interp, listObj, 1, &argObj);
    }


    ListObjGetElements(indexListCopy, numIndexObjs, indexObjs);


    listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs);

    Tcl_DecrRefCount(indexListCopy);
    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexFlat --
 *
 *	This procedure is the core of the 'lindex' command, with all index
 *	arguments presented as a flat list.
 *
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *


 * Side effects:
 *	None.
 *
 * Notes:
 *	The reference count of the returned object includes one reference
 *	corresponding to the pointer returned. Thus, the calling code will
 *	usually do something like:
 *		Tcl_SetObjResult(interp, result);
 *		Tcl_DecrRefCount(result);
 *

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

Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Tcl object representing the list. */
    ListSizeT indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    ListSizeT i;

    Tcl_IncrRefCount(listObj);

    for (i=0 ; i<indexCount && listObj ; i++) {
	ListSizeT index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL, *sublistCopy;

	/*
	 * Here we make a private copy of the current sublist, so we avoid any
	 * shimmering issues that might invalidate the elemPtr array below
	 * while we are still using it. See test lindex-8.4.
	 */

	sublistCopy = TclListObjCopy(interp, listObj);
	Tcl_DecrRefCount(listObj);
	listObj = NULL;

	if (sublistCopy == NULL) {

	    /* The sublist is not a list at all => error.  */


	    break;
	}
	LIST_ASSERT_TYPE(sublistCopy);
	ListObjGetElements(sublistCopy, listLen, elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index >= listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(
			    interp, indexArray[i], ListSizeT_MAX - 1, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		TclNewObj(listObj);
	    } else {

		/* Extract the pointer to the appropriate element. */


		listObj = elemPtrs[index];
	    }
	    Tcl_IncrRefCount(listObj);
	}
	Tcl_DecrRefCount(sublistCopy);
    }

    return listObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
 *	scalar index or a list of indices.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if there was an
 *	error. The returned object includes one reference count for the
 *	pointer returned.
 *
 * Side effects:
 *	None.
 *

 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLsetFlat. All it does is reconfigure the argument format into the
 *	form required by TclLsetFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful internalreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLsetList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    Tcl_Obj *indexArgObj,	/* Index or index-list arg to 'lset'. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    ListSizeT indexCount = 0;   /* Number of indices in the index list. */
    Tcl_Obj **indices = NULL;	/* Vector of indices in the index list. */
    Tcl_Obj *retValueObj;	/* Pointer to the list to be returned. */
    ListSizeT index;            /* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;


    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    if (!TclHasInternalRep(indexArgObj, &tclListType)

	&& TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)

	       == TCL_OK) {
	/* indexArgPtr designates a single index. */

        /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */
	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
    }


    indexListCopy = TclListObjCopy(NULL, indexArgObj);
    if (indexListCopy == NULL) {
	/*
	 * indexArgPtr designates something that is neither an index nor a
	 * well formed list. Report the error via TclLsetFlat.
	 */

	return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj);
    }
    LIST_ASSERT_TYPE(indexListCopy);
    ListObjGetElements(indexListCopy, indexCount, indices);

    /*
     * Let TclLsetFlat handle the actual lset'ting.
     */

    retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj);

    Tcl_DecrRefCount(indexListCopy);
    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for the
 *	pointer returned.
 *

 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	is. The reference count of the duplicate is incremented. At this


 *	point, the reference count will be 1 for either case, so that the


 *	object will appear to be unshared.
 *
 *	If an error occurs, and the object has been duplicated, the reference
 *	count on the duplicate is decremented so that it is now 0: this
 *	dismisses any memory that was allocated by this function.
 *



 *	If no error occurs, the reference count of the original object is

 *	incremented if the object has not been duplicated, and nothing is done
 *	to a reference count of the duplicate. Now the reference count of an
 *	unduplicated object is 2 (the returned pointer, plus the one stored in
 *	the variable). The reference count of a duplicate object is 1,
 *	reflecting that the returned pointer is the only active reference. The
 *	caller is expected to store the returned value back in the variable
 *	and decrement its reference count. (INST_STORE_* does exactly this.)
 *







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

Tcl_Obj *
TclLsetFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
    ListSizeT indexCount,		/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
{
    ListSizeT index, len;
	int result;
    Tcl_Obj *subListObj, *retValueObj;
    Tcl_Obj *pendingInvalidates[10];
    Tcl_Obj **pendingInvalidatesPtr = pendingInvalidates;
    ListSizeT numPendingInvalidates = 0;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valueObj just in case.
     */

    if (indexCount == 0) {
	if (valueObj != NULL) {
	    Tcl_IncrRefCount(valueObj);
	}
	return valueObj;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listObj is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listObj and
     * all elements to be unchanged.
     */

    subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValueObj = subListObj;

    result = TCL_OK;

    /* Allocate if static array for pending invalidations is too small */
    if (indexCount
        > (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) {
	pendingInvalidatesPtr =
	    (Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr));
    }

    /*
     * Loop through all the index arguments, and for each one dive into the
     * appropriate sublist.
     */

    do {
	ListSizeT elemCount;
	Tcl_Obj *parentList, **elemPtrs;

	/*
	 * Check for the possible error conditions...
	 */

	if (TclListObjGetElementsM(interp, subListObj, &elemCount, &elemPtrs)
	    != TCL_OK) {
	    /* ...the sublist we're indexing into isn't a list at all. */
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * WARNING: the macro TclGetIntForIndexM is not safe for
	 * post-increments, avoid '*indexArray++' here.
	 */

	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
	    != TCL_OK) {
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++; /* Why bother with this increment? TBD */
	    break;
	}
	indexArray++;

	if (index > elemCount
	    || (valueObj == NULL && index >= elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		                 Tcl_ObjPrintf("index \"%s\" out of range",
		                               Tcl_GetString(indexArray[-1])));
		Tcl_SetErrorCode(interp,
		                 "TCL",
		                 "VALUE",
		                 "INDEX"
		                 "OUTOFRANGE",
		                 NULL);
	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop,
	 * and take steps to make sure it is an unshared copy, as we intend
	 * to modify it.
	 */

	if (--indexCount) {
	    parentList = subListObj;
	    if (index == elemCount) {
		TclNewObj(subListObj);
	    } else {
		subListObj = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = Tcl_DuplicateObj(subListObj);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its internalrep with other
	     * Tcl_Obj's.  Dealing with the shared internalrep case can
	     * cause subListObj to become shared again, so detect that case
	     * and make and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListObj);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }
	    if (Tcl_IsShared(subListObj)) {
		subListObj = Tcl_DuplicateObj(subListObj);
		TclListObjSetElement(NULL, parentList, index, subListObj);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep
	     * of parentList, and that's fine for now, since all we've done
	     * so far is replace a list element with an unshared copy.  The
	     * list value remains the same, so the string rep. is still
	     * valid, and unchanged, which is good because if this whole
	     * routine returns NULL, we'd like to leave no change to the
	     * value of the lset variable.  Later on, when we set valueObj
	     * in its proper place, then all containing lists will have
	     * their values changed, and will need their string reps
	     * spoiled.  We maintain a list of all those Tcl_Obj's (via a
	     * little internalrep surgery) so we can spoil them at that
	     * time.
	     */



	    pendingInvalidatesPtr[numPendingInvalidates] = parentList;
	    ++numPendingInvalidates;
	}
    } while (indexCount > 0);

    /*
     * Either we've detected and error condition, and exited the loop with
     * result == TCL_ERROR, or we've successfully reached the last index, and
     * we're ready to store valueObj. On success, we need to invalidate
     * the string representations of intermediate lists whose contained
     * list element would have changed.
     */
    if (result == TCL_OK) {
	while (numPendingInvalidates > 0) {
	    Tcl_Obj *objPtr;





	    --numPendingInvalidates;

	    objPtr = pendingInvalidatesPtr[numPendingInvalidates];


	    if (result == TCL_OK) {

		/*
		 * We're going to store valueObj, so spoil string reps of all
		 * containing lists.
		 * TODO - historically, the storing of the internal rep was done
		 * because the ptr2 field of the internal rep was used to chain
		 * objects whose string rep needed to be invalidated. Now this
		 * is no longer the case, so replacing of the internal rep
		 * should not be needed. The TclInvalidateStringRep should
		 * suffice. Formulate a test case before changing.
		 */
		ListRep objInternalRep;
		TclListObjGetRep(NULL, objPtr, &objInternalRep);
		ListObjReplaceRepAndInvalidate(objPtr, &objInternalRep);
	    }




	}



    }

    if (pendingInvalidatesPtr != pendingInvalidates)
	Tcl_Free(pendingInvalidatesPtr);

    if (result != TCL_OK) {
	/*
	 * Error return; message is already in interp. Clean up any excess
	 * memory.
	 */

	if (retValueObj != listObj) {
	    Tcl_DecrRefCount(retValueObj);
	}
	return NULL;
    }

    /*
     * Store valueObj in proper sublist and return. The -1 is to avoid a
     * compiler warning (not a problem because we checked that we have a
     * proper list - or something convertible to one - above).
     */

    len = -1;
    TclListObjLengthM(NULL, subListObj, &len);
    if (valueObj == NULL) {
        /* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */
	Tcl_ListObjReplace(NULL, subListObj, index, 1, 0, NULL);
    } else if (index == len) {
        /* T:listrep-1.2.1,2.{2.3,9.3},3.{4,5,6}.3 */
	Tcl_ListObjAppendElement(NULL, subListObj, valueObj);
    } else {
        /* T:listrep-1.{12.1,15.1,19.1},2.{10,13,16}.1 */
	TclListObjSetElement(NULL, subListObj, index, valueObj);
	TclInvalidateStringRep(subListObj);
    }
    Tcl_IncrRefCount(retValueObj);
    return retValueObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value
 *



 * Results:

 *	The return value is normally TCL_OK. If listObj does not refer to a





 *	list object and cannot be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter result if interp is




 *	not NULL. Similarly, if index designates an element outside the range
 *	[0..listLength-1], where listLength is the count of elements in the
 *	list object designated by listObj, TCL_ERROR is returned and an error
 *	message is left in the interpreter result.
 *
 * Side effects:

 *	Tcl_Panic if listObj designates a shared object. Otherwise, attempts
 *	to convert it to a list with a non-shared internal rep. Decrements the

 *	ref count of the object at the specified index within the list,
 *	replaces with the object designated by valueObj, and increments the
 *	ref count of the replacement object.
 *

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

int
TclListObjSetElement(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
				 * if not NULL. */
    Tcl_Obj *listObj,		/* List object in which element should be
				 * stored. */
    ListSizeT index,		/* Index of element to store. */
    Tcl_Obj *valueObj)		/* Tcl object to store in the designated list
				 * element. */
{
    ListRep listRep;

    Tcl_Obj **elemPtrs;         /* Pointers to elements of the list. */
    ListSizeT elemCount;		/* Number of elements in the list. */


    /* Ensure that the listObj parameter designates an unshared list. */


    if (Tcl_IsShared(listObj)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }





    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {








	return TCL_ERROR;
    }







    elemCount = ListRepLength(&listRep);


    /* Ensure that the index is in bounds. */


    if (index>=elemCount) {
	if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%" TCL_Z_MODIFIER "u\" out of range", index));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
		    "OUTOFRANGE", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Note - garbage collect this only AFTER checking indices above.
     * Do not want to modify listrep and then not store it back in listObj.
     */
    ListRepFreeUnreferenced(&listRep);

    /* Replace a shared internal rep with an unshared copy */
    if (listRep.storePtr->refCount > 1) {
	ListRep newInternalRep;

        /* T:listrep-2.{10,13,16}.1 */









	/* TODO - leave extra space? */





	ListRepClone(&listRep, &newInternalRep, LISTREP_PANIC_ON_FAIL);
	listRep = newInternalRep;
    } /* else T:listrep-1.{12.1,15.1,19.1} */








    /* Retrieve element array AFTER potential cloning above */
    ListRepElements(&listRep, elemCount, elemPtrs);

    /*
     * Add a reference to the new list element and remove from old before
     * replacing it. Order is important!
     */
    Tcl_IncrRefCount(valueObj);
    Tcl_DecrRefCount(elemPtrs[index]);





    elemPtrs[index] = valueObj;




    /* Internal rep may be cloned so replace */





    ListObjReplaceRepAndInvalidate(listObj, &listRep);


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with a list object's internal
 *	representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees listPtr's List* internal representation, if no longer shared.
 *	May decrement the ref counts of element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listObj)		/* List object with internal rep to free. */
{
    ListRep listRep;



    ListObjGetRep(listObj, &listRep);
    if (listRep.storePtr->refCount-- <= 1) {
	ObjArrayDecrRefs(
	    listRep.storePtr->slots,
	    listRep.storePtr->firstUsed, listRep.storePtr->numUsed);

	Tcl_Free(listRep.storePtr);
    }
    if (listRep.spanPtr) {
	ListSpanDecrRefs(listRep.spanPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list Tcl_Obj to share the
 *	internal representation of an existing list object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcObj,		/* Object with internal rep to copy. */
    Tcl_Obj *copyObj)		/* Object with internal rep to set. */
{
    ListRep listRep;
    ListObjGetRep(srcObj, &listRep);

    ListObjOverwriteRep(copyObj, &listRep);

}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Attempt to generate a list internal form for the Tcl object "objPtr".
 *
 * Results:

 *	The return value is TCL_OK or TCL_ERROR. If an error occurs during

 *	conversion, an error message is left in the interpreter's result

 *	unless "interp" is NULL.
 *
 * Side effects:

 *	If no error occurs, a list is stored as "objPtr"s internal

 *	representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{

    Tcl_Obj **elemPtrs;
    ListRep listRep;

    /*
     * 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) && TclHasInternalRep(objPtr, &tclDictType)) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;
	ListSizeT size;

	/*
	 * Create the new list representation. Note that we do not need to do
	 * anything with the string representation as the transformation (and
	 * the reverse back to a dictionary) are both order-preserving. Also
	 * note that since we know we've got a valid dictionary (by
	 * representation) we also know that fetching the size of the
	 * dictionary or iterating over it will not fail.
	 */

	Tcl_DictObjSize(NULL, objPtr, &size);
	/* TODO - leave space in front and/or back? */
	if (ListRepInitAttempt(
		interp, size > 0 ? 2 * size : 1, NULL, &listRep)
	    != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);
	LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0);

	listRep.storePtr->numUsed = 2 * size;

	/* Populate the list representation. */


	elemPtrs = listRep.storePtr->slots;
	Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done);
	while (!done) {
	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	ListSizeT estCount, length;
	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);
	estCount += (estCount == 0);	/* Smallest list struct holds 1
					 * element. */
	/* TODO - allocate additional space? */
	if (ListRepInitAttempt(interp, estCount, NULL, &listRep)
	    != TCL_OK) {
	    return TCL_ERROR;
	}

	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);

	elemPtrs = listRep.storePtr->slots;


	/* Each iteration, parse and store a list element. */


	while (nextElem < limit) {
	    const char *elemStart;
	    char *check;
	    ListSizeT elemSize;
	    int literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
		    &elemStart, &nextElem, &elemSize, &literal)) {
fail:
		while (--elemPtrs >= listRep.storePtr->slots) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		Tcl_Free(listRep.storePtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    TclNewObj(*elemPtrs);
	    TclInvalidateStringRep(*elemPtrs);
	    check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
		    elemSize);
	    if (elemSize && check == NULL) {
		MemoryAllocationError(interp, elemSize);




		goto fail;
	    }
	    if (!literal) {
		Tcl_InitStringRep(*elemPtrs, NULL,
			TclCopyAndCollapse(elemSize, elemStart, check));
	    }

	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

	listRep.storePtr->numUsed =
	    elemPtrs - listRep.storePtr->slots;
    }

    LISTREP_CHECK(&listRep);

    /*
     * Store the new internalRep. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use the old internalRep.
     */

    /*
     * Note old string representation NOT to be invalidated.
     * So do NOT use ListObjReplaceRepAndInvalidate. InternalRep to be freed AFTER
     * IncrRefs so do not use ListObjOverwriteRep
     */
    ListRepIncrRefs(&listRep);
    TclFreeInternalRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
    objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
    objPtr->typePtr = &tclListType;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object. Note: This

 *	function does not invalidate an existing old string rep so storage
 *	will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	list-to-string conversion. This string will be empty if the list has
 *	no elements. The list internal representation should not be NULL and
 *	we assume it is not NULL.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfList(
    Tcl_Obj *listObj)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    ListSizeT numElems, i, length, bytesNeeded = 0;
    const char *elem, *start;
    char *dst;
    Tcl_Obj **elemPtrs;
    ListRep listRep;


    ListObjGetRep(listObj, &listRep);
    LISTREP_CHECK(&listRep);

    ListRepElements(&listRep, numElems, elemPtrs);

    /*
     * Mark the list as being canonical; although it will now have a string
     * rep, it is one we derived through proper "canonical" quoting and so
     * it's known to be free from nasties relating to [concat] and [eval].
     * However, we only do this if this is not a spanned list. Marking the
     * storage canonical for a spanned list make ALL lists using the storage
     * canonical which is not right. (Consider a list generated from a
     * string and then this function called for a spanned list generated
     * from it). On the other hand, a spanned list is always canonical
     * (never generated from a string) so it does not have to be explicitly
     * marked as such. The ListObjIsCanonical macro takes this into account.
     * See the comments there.
     */
    if (listRep.spanPtr == NULL) {
	LIST_ASSERT(listRep.storePtr->firstUsed == 0);/* Invariant */
	listRep.storePtr->flags |= LISTSTORE_CANONICAL;
    }



    /* Handle empty list case first, so rest of the routine is simpler. */


    if (numElems == 0) {
	Tcl_InitStringRep(listObj, NULL, 0);
	return;
    }


    /* Pass 1: estimate space, gather flags. */


    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {

	/* We know numElems <= LIST_MAX, so this is safe. */


	flagPtr = (char *)Tcl_Alloc(numElems);
    }

    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded > SIZE_MAX - numElems) {
	    Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", SIZE_MAX);
	}
    }
    bytesNeeded += numElems - 1;

    /*
     * Pass 2: copy into string rep buffer.
     */

    start = dst = Tcl_InitStringRep(listObj, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = Tcl_GetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listObj, NULL, dst - 1 - start);

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * TclListTestObj --
 *
 *    Returns a list object with a specific internal rep and content.
 *    Used specifically for testing so span can be controlled explicitly.
 *
 * Results:
 *    Pointer to the Tcl_Obj containing the list.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
Tcl_Obj *
TclListTestObj (int length, int leadingSpace, int endSpace)
{
    if (length < 0)
	length = 0;
    if (leadingSpace < 0)
	leadingSpace = 0;
    if (endSpace < 0)
	endSpace = 0;

    ListRep listRep;
    ListSizeT capacity;
    Tcl_Obj *listObj;

    TclNewObj(listObj);

    /* Only a test object so ignoring overflow checks */
    capacity = length + leadingSpace + endSpace;
    if (capacity == 0) {
	return listObj;
    }

    ListRepInit(capacity, NULL, 0, &listRep);

    ListStore *storePtr = listRep.storePtr;
    int i;
    for (i = 0; i < length; ++i) {
	storePtr->slots[i + leadingSpace] = Tcl_NewIntObj(i);
	Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]);
    }
    storePtr->firstUsed = leadingSpace;
    storePtr->numUsed = length;
    if (leadingSpace != 0) {
	listRep.spanPtr = ListSpanNew(leadingSpace, length);
    }
    ListObjReplaceRepAndInvalidate(listObj, &listRep);
    return listObj;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclProc.c.
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
    Tcl_HashEntry *hePtr = NULL;
    CmdFrame *cfPtr = NULL;
    Interp *iPtr = procPtr->iPtr;

    if (bodyPtr != NULL) {
	/* procPtr is stored in body's ByteCode, so ensure to reset it. */
	ByteCode *codePtr;
	
	ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);
	if (codePtr != NULL && codePtr->procPtr == procPtr) {
	    codePtr->procPtr = NULL;
	}
	Tcl_DecrRefCount(bodyPtr);
    }
    for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) {







|







2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
    Tcl_HashEntry *hePtr = NULL;
    CmdFrame *cfPtr = NULL;
    Interp *iPtr = procPtr->iPtr;

    if (bodyPtr != NULL) {
	/* procPtr is stored in body's ByteCode, so ensure to reset it. */
	ByteCode *codePtr;

	ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);
	if (codePtr != NULL && codePtr->procPtr == procPtr) {
	    codePtr->procPtr = NULL;
	}
	Tcl_DecrRefCount(bodyPtr);
    }
    for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) {
Changes to generic/tclStubInit.c.
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticLibrary, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    0, /* 259 */
    0, /* 260 */
    TclMSB, /* 261 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
    0, /* 0 */
    TclpCloseFile, /* 1 */







|
|
|







646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    TclStaticLibrary, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclMSB, /* 259 */
    TclListTestObj, /* 260 */
    TclListObjValidate, /* 261 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
    0, /* 0 */
    TclpCloseFile, /* 1 */
1465
1466
1467
1468
1469
1470
1471






1472
1473
1474
    Tcl_ParseArgsObjv, /* 667 */
    Tcl_UniCharLen, /* 668 */
    Tcl_NumUtfChars, /* 669 */
    Tcl_GetCharLength, /* 670 */
    Tcl_UtfAtIndex, /* 671 */
    Tcl_GetRange, /* 672 */
    Tcl_GetUniChar, /* 673 */






};

/* !END!: Do not edit above this line. */







>
>
>
>
>
>



1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
    Tcl_ParseArgsObjv, /* 667 */
    Tcl_UniCharLen, /* 668 */
    Tcl_NumUtfChars, /* 669 */
    Tcl_GetCharLength, /* 670 */
    Tcl_UtfAtIndex, /* 671 */
    Tcl_GetRange, /* 672 */
    Tcl_GetUniChar, /* 673 */
    0, /* 674 */
    0, /* 675 */
    Tcl_CreateObjCommand2, /* 676 */
    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
};

/* !END!: Do not edit above this line. */
Changes to generic/tclTest.c.
50
51
52
53
54
55
56















57
58
59
60
61
62
63
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;
















/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
    int id;			/* Identifier for this handler. */







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







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;

/*
 * One of the following structures exists for each command created by the
 * "testcmdtoken" command.
 */

typedef struct TestCommandTokenRef {
    int id;			/* Identifier for this reference. */
    Tcl_Command token;		/* Tcl's token for the command. */
    struct TestCommandTokenRef *nextPtr;
				/* Next in list of references. */
} TestCommandTokenRef;

static TestCommandTokenRef *firstCommandTokenRef = NULL;
static int nextCommandTokenRefId = 1;

/*
 * One of the following structures exists for each asynchronous handler
 * created by the "testasync" command".
 */

typedef struct TestAsyncHandler {
    int id;			/* Identifier for this handler. */
247
248
249
250
251
252
253

254
255
256
257
258
259
260
static Tcl_CmdProc	TestgetintCmd;
static Tcl_CmdProc	TestlongsizeCmd;
static Tcl_CmdProc	TestgetplatformCmd;
static Tcl_ObjCmdProc	TestgetvarfullnameCmd;
static Tcl_CmdProc	TestinterpdeleteCmd;
static Tcl_CmdProc	TestlinkCmd;
static Tcl_ObjCmdProc	TestlinkarrayCmd;

static Tcl_ObjCmdProc	TestlocaleCmd;
static Tcl_CmdProc	TestmainthreadCmd;
static Tcl_ObjCmdProc	TestmsbObjCmd;
static Tcl_CmdProc	TestsetmainloopCmd;
static Tcl_CmdProc	TestexitmainloopCmd;
static Tcl_CmdProc	TestpanicCmd;
static Tcl_ObjCmdProc	TestparseargsCmd;







>







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
static Tcl_CmdProc	TestgetintCmd;
static Tcl_CmdProc	TestlongsizeCmd;
static Tcl_CmdProc	TestgetplatformCmd;
static Tcl_ObjCmdProc	TestgetvarfullnameCmd;
static Tcl_CmdProc	TestinterpdeleteCmd;
static Tcl_CmdProc	TestlinkCmd;
static Tcl_ObjCmdProc	TestlinkarrayCmd;
static Tcl_ObjCmdProc	TestlistrepCmd;
static Tcl_ObjCmdProc	TestlocaleCmd;
static Tcl_CmdProc	TestmainthreadCmd;
static Tcl_ObjCmdProc	TestmsbObjCmd;
static Tcl_CmdProc	TestsetmainloopCmd;
static Tcl_CmdProc	TestexitmainloopCmd;
static Tcl_CmdProc	TestpanicCmd;
static Tcl_ObjCmdProc	TestparseargsCmd;
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
static Tcl_CmdProc	Testset2Cmd;
static Tcl_CmdProc	TestseterrorcodeCmd;
static Tcl_ObjCmdProc	TestsetobjerrorcodeCmd;
static Tcl_CmdProc	TestsetplatformCmd;
static Tcl_CmdProc	TeststaticlibraryCmd;
static Tcl_CmdProc	TesttranslatefilenameCmd;
static Tcl_CmdProc	TestupvarCmd;
static Tcl_ObjCmdProc	TestWrongNumArgsObjCmd;
static Tcl_ObjCmdProc	TestGetIndexFromObjStructObjCmd;
static Tcl_CmdProc	TestChannelCmd;
static Tcl_CmdProc	TestChannelEventCmd;
static Tcl_CmdProc	TestSocketCmd;
static Tcl_ObjCmdProc	TestFilesystemObjCmd;
static Tcl_ObjCmdProc	TestSimpleFilesystemObjCmd;
static void		TestReport(const char *cmd, Tcl_Obj *arg1,







|







290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
static Tcl_CmdProc	Testset2Cmd;
static Tcl_CmdProc	TestseterrorcodeCmd;
static Tcl_ObjCmdProc	TestsetobjerrorcodeCmd;
static Tcl_CmdProc	TestsetplatformCmd;
static Tcl_CmdProc	TeststaticlibraryCmd;
static Tcl_CmdProc	TesttranslatefilenameCmd;
static Tcl_CmdProc	TestupvarCmd;
static Tcl_ObjCmdProc2	TestWrongNumArgsObjCmd;
static Tcl_ObjCmdProc	TestGetIndexFromObjStructObjCmd;
static Tcl_CmdProc	TestChannelCmd;
static Tcl_CmdProc	TestChannelEventCmd;
static Tcl_CmdProc	TestSocketCmd;
static Tcl_ObjCmdProc	TestFilesystemObjCmd;
static Tcl_ObjCmdProc	TestSimpleFilesystemObjCmd;
static void		TestReport(const char *cmd, Tcl_Obj *arg1,
536
537
538
539
540
541
542






543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {






	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
	    TestGetIndexFromObjStructObjCmd, NULL, NULL);







>
>
>
>
>
>


















|







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
	if (info.isNativeObjectProc == 2) {
	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
		    info.objProc2, (void *)version, NULL);
    } else
#endif
	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
	    TestGetIndexFromObjStructObjCmd, NULL, NULL);
632
633
634
635
636
637
638

639
640
641
642
643
644
645
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);

    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "testmsb", TestmsbObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);







>







654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlistrep", TestlistrepCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "testmsb", TestmsbObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
	    case 2: {
		int mode;
		Tcl_UnregisterChannel(interp,
			Tcl_GetChannel(interp, "stderr", &mode));
		return TCL_ERROR;
	    }
	    case 3:
		if (objc-1) {
		    Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1],
			    TCL_GLOBAL_ONLY);
		}
		return TCL_ERROR;
	    }
	}
    }







|







770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
	    case 2: {
		int mode;
		Tcl_UnregisterChannel(interp,
			Tcl_GetChannel(interp, "stderr", &mode));
		return TCL_ERROR;
	    }
	    case 3:
		if (objc > 1) {
		    Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1],
			    TCL_GLOBAL_ONLY);
		}
		return TCL_ERROR;
	    }
	}
    }
792
793
794
795
796
797
798






799
800
801
802
803
804
805
{
    Tcl_CmdInfo info;

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {






	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);







>
>
>
>
>
>







815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
{
    Tcl_CmdInfo info;

    if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
	if (info.isNativeObjectProc == 2) {
	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
		    info.objProc2, (void *)version, NULL);
    } else
#endif
	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
		info.objProc, (void *)version, NULL);
    }
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
	for (asyncPtr = firstHandler; asyncPtr != NULL;
		asyncPtr = asyncPtr->nextPtr) {
	    if (asyncPtr->id == id) {
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {







|







931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
	for (asyncPtr = firstHandler; asyncPtr != NULL;
		asyncPtr = asyncPtr->nextPtr) {
	    if (asyncPtr->id == id) {
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_INDEX_NONE));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
    TclFormatInt(string, code);
    listArgv[0] = asyncPtr->command;
    listArgv[1] = Tcl_GetStringResult(interp);
    listArgv[2] = string;
    listArgv[3] = NULL;
    cmd = Tcl_Merge(3, listArgv);
    if (interp != NULL) {
	code = Tcl_EvalEx(interp, cmd, -1, 0);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    Tcl_Free(cmd);







|







1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
    TclFormatInt(string, code);
    listArgv[0] = asyncPtr->command;
    listArgv[1] = Tcl_GetStringResult(interp);
    listArgv[2] = string;
    listArgv[3] = NULL;
    cmd = Tcl_Merge(3, listArgv);
    if (interp != NULL) {
	code = Tcl_EvalEx(interp, cmd, TCL_INDEX_NONE, 0);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    Tcl_Free(cmd);
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
}

static void
CmdDelProc1(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

static void
CmdDelProc2(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtokenCmd --
 *







|
|







|
|







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
}

static void
CmdDelProc1(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_INDEX_NONE);
    Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}

static void
CmdDelProc2(
    void *clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_INDEX_NONE);
    Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdtokenCmd --
 *
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
static int
TestcmdtokenCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Command token;
    int *l;
    char buf[30];


    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {

	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
		(void *) "original", NULL);




	sprintf(buf, "%p", (void *)token);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(argv[1], "name") == 0) {
	Tcl_Obj *objPtr;

	if (sscanf(argv[2], "%p", &l) != 1) {













	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	objPtr = Tcl_NewObj();
	Tcl_GetCommandFullName(interp, (Tcl_Command) l, objPtr);

	Tcl_AppendElement(interp,
		Tcl_GetCommandName(interp, (Tcl_Command) l));
	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
	Tcl_DecrRefCount(objPtr);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create or name", NULL);
	return TCL_ERROR;
    }







|
<

>







>
|

>
>
>
>
|




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






|


|







1218
1219
1220
1221
1222
1223
1224
1225

1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
static int
TestcmdtokenCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TestCommandTokenRef *refPtr;

    char buf[30];
    int id;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	refPtr = (TestCommandTokenRef *)Tcl_Alloc(sizeof(TestCommandTokenRef));
	refPtr->token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
		(void *) "original", NULL);
	refPtr->id = nextCommandTokenRefId;
	nextCommandTokenRefId++;
	refPtr->nextPtr = firstCommandTokenRef;
	firstCommandTokenRef = refPtr;
	sprintf(buf, "%d", refPtr->id);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(argv[1], "name") == 0) {
	Tcl_Obj *objPtr;

	if (sscanf(argv[2], "%d", &id) != 1) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	for (refPtr = firstCommandTokenRef; refPtr != NULL;
		refPtr = refPtr->nextPtr) {
	    if (refPtr->id == id) {
		break;
	    }
	}

	if (refPtr == NULL) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
	}

	objPtr = Tcl_NewObj();
	Tcl_GetCommandFullName(interp, refPtr->token, objPtr);

	Tcl_AppendElement(interp,
		Tcl_GetCommandName(interp, refPtr->token));
	Tcl_AppendElement(interp, Tcl_GetString(objPtr));
	Tcl_DecrRefCount(objPtr);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create or name", NULL);
	return TCL_ERROR;
    }
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
		" option script\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "tracetest") == 0) {
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "deletetest") == 0) {
	/*
	 * Create a command trace then eval a script to check whether it is
	 * called. Note that this trace procedure removes itself as a further
	 * check of the robustness of the trace proc calling code in
	 * TclNRExecuteByteCode.
	 */

	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
	Tcl_EvalEx(interp, argv[2], -1, 0);
    } else if (strcmp(argv[1], "leveltest") == 0) {
	Interp *iPtr = (Interp *) interp;
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
		&buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "resulttest") == 0) {
	/* Create an object-based trace, then eval a script. This is used
	 * to test return codes other than TCL_OK from the trace engine.
	 */

	static int deleteCalled;

	deleteCalled = 0;
	cmdTrace = Tcl_CreateObjTrace(interp, 50000,
		TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
		&deleteCalled, ObjTraceDeleteProc);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	Tcl_DeleteTrace(interp, cmdTrace);
	if (!deleteCalled) {
	    Tcl_AppendResult(interp, "Delete wasn't called", NULL);
	    return TCL_ERROR;
	} else {
	    return result;
	}
    } else if (strcmp(argv[1], "doubletest") == 0) {
	Tcl_Trace t1, t2;

	Tcl_DStringInit(&buffer);
	t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
	t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, t2);
	Tcl_DeleteTrace(interp, t1);
	Tcl_DStringFree(&buffer);







|















|





|

















|













|







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
		" option script\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "tracetest") == 0) {
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "deletetest") == 0) {
	/*
	 * Create a command trace then eval a script to check whether it is
	 * called. Note that this trace procedure removes itself as a further
	 * check of the robustness of the trace proc calling code in
	 * TclNRExecuteByteCode.
	 */

	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
	Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
    } else if (strcmp(argv[1], "leveltest") == 0) {
	Interp *iPtr = (Interp *) interp;
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
		&buffer);
	result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "resulttest") == 0) {
	/* Create an object-based trace, then eval a script. This is used
	 * to test return codes other than TCL_OK from the trace engine.
	 */

	static int deleteCalled;

	deleteCalled = 0;
	cmdTrace = Tcl_CreateObjTrace(interp, 50000,
		TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
		&deleteCalled, ObjTraceDeleteProc);
	result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
	Tcl_DeleteTrace(interp, cmdTrace);
	if (!deleteCalled) {
	    Tcl_AppendResult(interp, "Delete wasn't called", NULL);
	    return TCL_ERROR;
	} else {
	    return result;
	}
    } else if (strcmp(argv[1], "doubletest") == 0) {
	Tcl_Trace t1, t2;

	Tcl_DStringInit(&buffer);
	t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
	t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, t2);
	Tcl_DeleteTrace(interp, t1);
	Tcl_DStringFree(&buffer);
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
    TCL_UNUSED(Tcl_Command),
    TCL_UNUSED(int) /*objc*/,
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *word = Tcl_GetString(objv[0]);

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
	return TCL_BREAK;
    } else if (!strcmp(word, "Continue")) {
	return TCL_CONTINUE;
    } else if (!strcmp(word, "Return")) {
	return TCL_RETURN;







|







1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
    TCL_UNUSED(Tcl_Command),
    TCL_UNUSED(int) /*objc*/,
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *word = Tcl_GetString(objv[0]);

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_INDEX_NONE));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
	return TCL_BREAK;
    } else if (!strcmp(word, "Continue")) {
	return TCL_CONTINUE;
    } else if (!strcmp(word, "Return")) {
	return TCL_RETURN;
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = (DelCmd *)clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
}

/*
 *----------------------------------------------------------------------







|







1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = (DelCmd *)clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, TCL_INDEX_NONE, 0);
    Tcl_ResetResult(dPtr->interp);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
}

/*
 *----------------------------------------------------------------------
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);







|







1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    Tcl_ResetResult(encodingPtr->interp);







|







2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    Tcl_ResetResult(encodingPtr->interp);
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    Tcl_ResetResult(encodingPtr->interp);







|







2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    Tcl_ResetResult(encodingPtr->interp);
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {







|







3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	}
	if (argv[7][0]) {
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}







|







3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
	    if (Tcl_GetDouble(interp, argv[14], &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	}
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}







|







3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    Tcl_UpdateLinkedVar(interp, "wide");
	}
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");







|







3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
		return TCL_ERROR;
	    }
	    floatVar = (float) d;
	    Tcl_UpdateLinkedVar(interp, "float");
	}
	if (argv[15][0]) {
	    Tcl_WideInt w;
	    tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
		return TCL_ERROR;
	    }
	    Tcl_DecrRefCount(tmp);
	    uwideVar = (Tcl_WideUInt) w;
	    Tcl_UpdateLinkedVar(interp, "uwide");
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
























































































































































3388
3389
3390
3391
3392
3393
3394
	    i++;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
 		&typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
	    return TCL_ERROR;
	}
	name = Tcl_GetString(objv[i++]);

	/*
	 * If no address is given request one in the underlying function
	 */

	if (i < objc) {
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong address value", -1));
		return TCL_ERROR;
	    }
	} else {
	    addr = 0;
	}
	return Tcl_LinkArray(interp, name, INT2PTR(addr),
		LinkTypes[typeIndex] | readonly, size);
    }
    return TCL_OK;

  wrongArgs:
    Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? type size name ?address?");
    return TCL_ERROR;
}

























































































































































/*
 *----------------------------------------------------------------------
 *
 * TestlocaleCmd --
 *
 *	This procedure implements the "testlocale" command.  It is used







|











|














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







3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
	    i++;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
 		&typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", TCL_INDEX_NONE));
	    return TCL_ERROR;
	}
	name = Tcl_GetString(objv[i++]);

	/*
	 * If no address is given request one in the underlying function
	 */

	if (i < objc) {
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong address value", TCL_INDEX_NONE));
		return TCL_ERROR;
	    }
	} else {
	    addr = 0;
	}
	return Tcl_LinkArray(interp, name, INT2PTR(addr),
		LinkTypes[typeIndex] | readonly, size);
    }
    return TCL_OK;

  wrongArgs:
    Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? type size name ?address?");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestlistrepCmd --
 *
 *      This function is invoked to generate a list object with a specific
 *	internal representation.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestlistrepCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    /* Subcommands supported by this command */
    const char* subcommands[] = {
	"new",
	"describe",
	"config",
	"validate",
	NULL
    };
    enum {
	LISTREP_NEW,
	LISTREP_DESCRIBE,
	LISTREP_CONFIG,
	LISTREP_VALIDATE
    } cmdIndex;
    Tcl_Obj *resultObj = NULL;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(
	    interp, objv[1], subcommands, "command", 0, &cmdIndex)
	!= TCL_OK) {
	return TCL_ERROR;
    }
    switch (cmdIndex) {
    case LISTREP_NEW:
	if (objc < 3 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "length ?leadSpace endSpace?");
	    return TCL_ERROR;
	} else {
	    int length;
	    int leadSpace = 0;
	    int endSpace = 0;
	    if (Tcl_GetIntFromObj(interp, objv[2], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc > 3) {
		if (Tcl_GetIntFromObj(interp, objv[3], &leadSpace) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (objc > 4) {
		    if (Tcl_GetIntFromObj(interp, objv[4], &endSpace)
			!= TCL_OK) {
			return TCL_ERROR;
		    }
		}
	    }
	    resultObj = TclListTestObj(length, leadSpace, endSpace);
	}
	break;

    case LISTREP_DESCRIBE:
#define APPEND_FIELD(targetObj_, structPtr_, fld_)                        \
    do {                                                                  \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewStringObj(#fld_, TCL_INDEX_NONE));           \
	Tcl_ListObjAppendElement(                                         \
	    interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \
    } while (0)
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj **objs;
	    ListSizeT nobjs;
	    ListRep listRep;
	    Tcl_Obj *listRepObjs[4];

	    /* Force list representation */
	    if (Tcl_ListObjGetElements(interp, objv[2], &nobjs, &objs) != TCL_OK) {
		return TCL_ERROR;
	    }
	    ListObjGetRep(objv[2], &listRep);
	    listRepObjs[0] = Tcl_NewStringObj("store", TCL_INDEX_NONE);
	    listRepObjs[1] = Tcl_NewListObj(12, NULL);
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
	    Tcl_ListObjAppendElement(
		interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr));
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, refCount);
	    APPEND_FIELD(listRepObjs[1], listRep.storePtr, flags);
	    if (listRep.spanPtr) {
		listRepObjs[2] = Tcl_NewStringObj("span", TCL_INDEX_NONE);
		listRepObjs[3] = Tcl_NewListObj(8, NULL);
		Tcl_ListObjAppendElement(interp,
					 listRepObjs[3],
					 Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE));
		Tcl_ListObjAppendElement(
		    interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr));
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart);
		APPEND_FIELD(
		    listRepObjs[3], listRep.spanPtr, spanLength);
		APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount);
	    }
	    resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs);
	}
#undef APPEND_FIELD
	break;

    case LISTREP_CONFIG:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	}
	resultObj = Tcl_NewListObj(2, NULL);
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(
	    NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD));
	break;

    case LISTREP_VALIDATE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "object");
	    return TCL_ERROR;
	}
	TclListObjValidate(interp, objv[2]); /* Panics if invalid */
	resultObj = Tcl_NewObj();
	break;
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestlocaleCmd --
 *
 *	This procedure implements the "testlocale" command.  It is used
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
    if (objc == 3) {
	locale = Tcl_GetString(objv[2]);
    } else {
	locale = NULL;
    }
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
    if (objc == 3) {
	locale = Tcl_GetString(objv[2]);
    } else {
	locale = NULL;
    }
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_INDEX_NONE);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
	    typeString = "operator";
	    break;
	default:
	    typeString = "??";
	    break;
	}
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(typeString, -1));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewWideIntObj(tokenPtr->numComponents));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    parsePtr->commandStart ?
	    Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
	    -1) : Tcl_NewObj());
}

/*
 *----------------------------------------------------------------------
 *
 * TestparsevarObjCmd --
 *







|








|







3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
	    typeString = "operator";
	    break;
	default:
	    typeString = "??";
	    break;
	}
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(typeString, TCL_INDEX_NONE));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewWideIntObj(tokenPtr->numComponents));
    }
    Tcl_ListObjAppendElement(NULL, objPtr,
	    parsePtr->commandStart ?
	    Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
	    TCL_INDEX_NONE) : Tcl_NewObj());
}

/*
 *----------------------------------------------------------------------
 *
 * TestparsevarObjCmd --
 *
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    size_t start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, (end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }







|







4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    size_t start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end);
	    sprintf(resinfo, "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, (end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
    if (strcmp(argv[1], "cmd") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " cmd script", NULL);
	    return TCL_ERROR;
	}
	if (interp2 != NULL) {
	    code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
	    Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
	    return code;
	} else {
	    Tcl_AppendResult(interp,
		    "called \"testfevent code\" before \"testfevent create\"",
		    NULL);
	    return TCL_ERROR;







|







4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
    if (strcmp(argv[1], "cmd") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " cmd script", NULL);
	    return TCL_ERROR;
	}
	if (interp2 != NULL) {
	    code = Tcl_EvalEx(interp2, argv[2], TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
	    Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
	    return code;
	} else {
	    Tcl_AppendResult(interp,
		    "called \"testfevent code\" before \"testfevent create\"",
		    NULL);
	    return TCL_ERROR;
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", -1);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetStringFromObj of \"12345\"\n",







|







5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", TCL_INDEX_NONE);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetStringFromObj of \"12345\"\n",
5169
5170
5171
5172
5173
5174
5175

5176
5177
5178
5179
5180
5181



5182
5183
5184
5185
5186
5187
5188
5189
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "value length");
	return TCL_ERROR;
    }
    if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) {
	return TCL_ERROR;
    }

    if (Tcl_IsShared(objv[1])) {
	obj = Tcl_DuplicateObj(objv[1]);
    } else {
	obj = objv[1];
    }
    if (NULL == Tcl_SetByteArrayLength(obj, n)) {



	Tcl_SetResult(interp, "expected bytes", TCL_STATIC);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*







>
|
|
<
<

|
>
>
>
|







5368
5369
5370
5371
5372
5373
5374
5375
5376
5377


5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "value length");
	return TCL_ERROR;
    }
    if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) {
	return TCL_ERROR;
    }
    obj = objv[1];
    if (Tcl_IsShared(obj)) {
	obj = Tcl_DuplicateObj(obj);


    }
    if (Tcl_SetByteArrayLength(obj, n) == NULL) {
	if (obj != objv[1]) {
	    Tcl_DecrRefCount(obj);
	}
	Tcl_AppendResult(interp, "expected bytes", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
	break;
    case RESULT_OBJECT:
	objPtr = Tcl_NewStringObj("object result", -1);
	Tcl_SetObjResult(interp, objPtr);
	break;
    }

    Tcl_SaveResult(interp, &state);

    if (index == RESULT_OBJECT) {
	result = Tcl_EvalObjEx(interp, objv[2], 0);
    } else {
	result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
    }

    if (discard) {
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;







|









|







5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
	break;
    case RESULT_OBJECT:
	objPtr = Tcl_NewStringObj("object result", TCL_INDEX_NONE);
	Tcl_SetObjResult(interp, objPtr);
	break;
    }

    Tcl_SaveResult(interp, &state);

    if (index == RESULT_OBJECT) {
	result = Tcl_EvalObjEx(interp, objv[2], 0);
    } else {
	result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), TCL_INDEX_NONE, 0);
    }

    if (discard) {
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
    } else {
	statePtr	= NULL;
	chan		= NULL;
    }

    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelError(chan, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelError(chan, &msg);
	Tcl_SetObjResult(interp, msg);
	Tcl_DecrRefCount(msg);
	return TCL_OK;
    }
    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelErrorInterp(interp, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelErrorInterp(interp, &msg);
	Tcl_SetObjResult(interp, msg);







|












|







5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
    } else {
	statePtr	= NULL;
	chan		= NULL;
    }

    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelError(chan, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelError(chan, &msg);
	Tcl_SetObjResult(interp, msg);
	Tcl_DecrRefCount(msg);
	return TCL_OK;
    }
    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {

	Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE);

	Tcl_IncrRefCount(msg);
	Tcl_SetChannelErrorInterp(interp, msg);
	Tcl_DecrRefCount(msg);

	Tcl_GetChannelErrorInterp(interp, &msg);
	Tcl_SetObjResult(interp, msg);
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
	if (strcmp(argv[3], "-command") != 0) {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": should be \"-command\"", NULL);
	    return TCL_ERROR;
	}

	return TclChannelTransform(interp, chan,
		Tcl_NewStringObj(argv[4], -1));
    }

    if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
	/*
	 * Syntax: unstack channel
	 */








|







6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
	if (strcmp(argv[3], "-command") != 0) {
	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
		    "\": should be \"-command\"", NULL);
	    return TCL_ERROR;
	}

	return TclChannelTransform(interp, chan,
		Tcl_NewStringObj(argv[4], TCL_INDEX_NONE));
    }

    if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) {
	/*
	 * Syntax: unstack channel
	 */

6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
	Tcl_IncrRefCount(esPtr->scriptPtr);

	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);

	return TCL_OK;
    }







|







6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_INDEX_NONE);
	Tcl_IncrRefCount(esPtr->scriptPtr);

	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);

	return TCL_OK;
    }
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
	}
	resultListPtr = Tcl_GetObjResult(interp);
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = esPtr->nextPtr) {
	    if (esPtr->mask) {
		Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
	    } else {
		Tcl_ListObjAppendElement(interp, resultListPtr,
			Tcl_NewStringObj("none", -1));
	    }
	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	return TCL_OK;
    }








|


|







6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
	}
	resultListPtr = Tcl_GetObjResult(interp);
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = esPtr->nextPtr) {
	    if (esPtr->mask) {
		Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (esPtr->mask == TCL_READABLE) ? "readable" : "writable", TCL_INDEX_NONE));
	    } else {
		Tcl_ListObjAppendElement(interp, resultListPtr,
			Tcl_NewStringObj("none", TCL_INDEX_NONE));
	    }
	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	return TCL_OK;
    }

6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
6398

6399
6400
6401
6402
6403
6404
6405
 *----------------------------------------------------------------------
 */

static int
TestWrongNumArgsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, length;
    const char *msg;

    if (objc < 3) {
	/*
	 * Don't use Tcl_WrongNumArgs here, as that is the function
	 * we want to test!
	 */
	Tcl_AppendResult(interp, "insufficient arguments", NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
	return TCL_ERROR;
    }

    msg = Tcl_GetStringFromObj(objv[2], &length);
    if (length == 0) {
	msg = NULL;
    }

    if (i > objc - 3) {
	/*
	 * Asked for more arguments than were given.
	 */

	Tcl_AppendResult(interp, "insufficient arguments", NULL);
	return TCL_ERROR;
    }

    Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
    return TCL_OK;
}







|


|


|
<
<
|
<
<
<


|












>







6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578


6579



6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
 *----------------------------------------------------------------------
 */

static int
TestWrongNumArgsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    size_t objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t i, length;
    const char *msg;

    if (objc + 1 < 4) {


	goto insufArgs;



    }

    if (Tcl_GetIntForIndex(interp, objv[1], TCL_INDEX_NONE, &i) != TCL_OK) {
	return TCL_ERROR;
    }

    msg = Tcl_GetStringFromObj(objv[2], &length);
    if (length == 0) {
	msg = NULL;
    }

    if (i > objc - 3) {
	/*
	 * Asked for more arguments than were given.
	 */
    insufArgs:
	Tcl_AppendResult(interp, "insufficient arguments", NULL);
	return TCL_ERROR;
    }

    Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
    return TCL_OK;
}
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
    if (boolVal) {
	res = Tcl_FSRegister(interp, &testReportingFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&testReportingFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
}

static int
TestReportInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)







|







6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
    if (boolVal) {
	res = Tcl_FSRegister(interp, &testReportingFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&testReportingFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
    return res;
}

static int
TestReportInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
    if (interp == NULL) {
	/* This is bad, but not much we can do about it */
    } else {
	Tcl_Obj *savedResult;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
	Tcl_DStringStartSublist(&ds);
	Tcl_DStringAppendElement(&ds, cmd);
	if (path != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
	}
	if (arg2 != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
	}
	Tcl_DStringEndSublist(&ds);
	savedResult = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(savedResult);
	Tcl_SetObjResult(interp, Tcl_NewObj());
	Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
	Tcl_DStringFree(&ds);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, savedResult);
	Tcl_DecrRefCount(savedResult);
    }
}








|












|







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
    if (interp == NULL) {
	/* This is bad, but not much we can do about it */
    } else {
	Tcl_Obj *savedResult;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_INDEX_NONE);
	Tcl_DStringStartSublist(&ds);
	Tcl_DStringAppendElement(&ds, cmd);
	if (path != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
	}
	if (arg2 != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
	}
	Tcl_DStringEndSublist(&ds);
	savedResult = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(savedResult);
	Tcl_SetObjResult(interp, Tcl_NewObj());
	Tcl_EvalEx(interp, Tcl_DStringValue(&ds), TCL_INDEX_NONE, 0);
	Tcl_DStringFree(&ds);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, savedResult);
	Tcl_DecrRefCount(savedResult);
    }
}

6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
    if (boolVal) {
	res = Tcl_FSRegister(interp, &simpleFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&simpleFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
}

/*
 * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
 * (native) directory.
 */







|







7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
    if (boolVal) {
	res = Tcl_FSRegister(interp, &simpleFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&simpleFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE));
    return res;
}

/*
 * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
 * (native) directory.
 */
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914

    str = Tcl_GetStringFromObj(pathPtr, &len);
    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
	/* Probably shouldn't ever reach here */
	Tcl_IncrRefCount(pathPtr);
	return pathPtr;
    }
    origPtr = Tcl_NewStringObj(str+10,-1);
    Tcl_IncrRefCount(origPtr);
    return origPtr;
}

static int
SimpleMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter for error







|







7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111

    str = Tcl_GetStringFromObj(pathPtr, &len);
    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
	/* Probably shouldn't ever reach here */
	Tcl_IncrRefCount(pathPtr);
	return pathPtr;
    }
    origPtr = Tcl_NewStringObj(str+10, TCL_INDEX_NONE);
    Tcl_IncrRefCount(origPtr);
    return origPtr;
}

static int
SimpleMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter for error
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014

static Tcl_Obj *
SimpleListVolumes(void)
{
    /* Add one new volume */
    Tcl_Obj *retVal;

    retVal = Tcl_NewStringObj("simplefs:/", -1);
    Tcl_IncrRefCount(retVal);
    return retVal;
}

/*
 * Used to check operations of Tcl_UtfNext.
 *







|







7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211

static Tcl_Obj *
SimpleListVolumes(void)
{
    /* Add one new volume */
    Tcl_Obj *retVal;

    retVal = Tcl_NewStringObj("simplefs:/", TCL_INDEX_NONE);
    Tcl_IncrRefCount(retVal);
    return retVal;
}

/*
 * Used to check operations of Tcl_UtfNext.
 *
7029
7030
7031
7032
7033
7034
7035
7036
7037
7038
7039
7040
7041
7042
7043
7044
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
	return TCL_ERROR;
    }
	bytes = Tcl_GetString(objv[1]);
	numBytes = objv[1]->length;

    if (numBytes + 4U > sizeof(buffer)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
		sizeof(buffer) - 4));
	return TCL_ERROR;
    }







|
<







7226
7227
7228
7229
7230
7231
7232
7233

7234
7235
7236
7237
7238
7239
7240
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
	return TCL_ERROR;
    }
	bytes = Tcl_GetStringFromObj(objv[1], &numBytes);


    if (numBytes + 4U > sizeof(buffer)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes",
		sizeof(buffer) - 4));
	return TCL_ERROR;
    }
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
    const char *result;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }

    bytes = Tcl_GetString(objv[1]);
    numBytes = objv[1]->length;

    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset == TCL_INDEX_NONE) {
	    offset = 0;







|
<







7285
7286
7287
7288
7289
7290
7291
7292

7293
7294
7295
7296
7297
7298
7299
    const char *result;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }

    bytes = Tcl_GetStringFromObj(objv[1], &numBytes);


    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset == TCL_INDEX_NONE) {
	    offset = 0;
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	size_t len, limit = TCL_INDEX_NONE;
	const char *bytes = Tcl_GetString(objv[1]);
	size_t numBytes = objv[1]->length;

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {
		limit = numBytes + 1;







|
|
<







7317
7318
7319
7320
7321
7322
7323
7324
7325

7326
7327
7328
7329
7330
7331
7332
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	size_t numBytes, len, limit = TCL_INDEX_NONE;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);


	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {
		limit = numBytes + 1;
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */







|







7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

static int
TestGetIntForIndexCmd(
    TCL_UNUSED(void *),







|







7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
{
    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE));
    }
    return TCL_OK;
}

static int
TestGetIntForIndexCmd(
    TCL_UNUSED(void *),
7257
7258
7259
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;







|







7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
7465
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", TCL_INDEX_NONE));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewWideIntObj(regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
    }

    if (hash.numEntries != 0) {







|
















|





|







7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew);
	if (!isNew) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i));
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", TCL_INDEX_NONE);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
    }

    if (hash.numEntries != 0) {
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    Tcl_InvalidateStringRep(list1Ptr);

    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    Tcl_InvalidateStringRep(list2Ptr);

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */







|



|



|







7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_INDEX_NONE));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_INDEX_NONE);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    Tcl_InvalidateStringRep(list1Ptr);

    list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_INDEX_NONE);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    Tcl_InvalidateStringRep(list2Ptr);

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}








|







8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}

8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
8178
8179
8180
8181
8182
    Tcl_Obj *lambdaObjs[2];
    Tcl_Obj *evalObjs[2];
    Tcl_Obj *lambdaObj;
    int result;

    /* Create a lambda {{} {set a 42}} */
    lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
    lambdaObjs[1] = Tcl_NewStringObj("set a 42", -1); /* Body */
    lambdaObj = Tcl_NewListObj(2, lambdaObjs);
    Tcl_IncrRefCount(lambdaObj);

    /* Create the command "apply {{} {set a 42}" */
    evalObjs[0] = Tcl_NewStringObj("apply", -1);
    Tcl_IncrRefCount(evalObjs[0]);
    /*
     * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
     * it will get shimmered to a Lambda internal representation but we
     * want to hold on to our list representation.
     */
    evalObjs[1] = Tcl_DuplicateObj(lambdaObj);







|




|







8357
8358
8359
8360
8361
8362
8363
8364
8365
8366
8367
8368
8369
8370
8371
8372
8373
8374
8375
8376
    Tcl_Obj *lambdaObjs[2];
    Tcl_Obj *evalObjs[2];
    Tcl_Obj *lambdaObj;
    int result;

    /* Create a lambda {{} {set a 42}} */
    lambdaObjs[0] = Tcl_NewObj(); /* No parameters */
    lambdaObjs[1] = Tcl_NewStringObj("set a 42", TCL_INDEX_NONE); /* Body */
    lambdaObj = Tcl_NewListObj(2, lambdaObjs);
    Tcl_IncrRefCount(lambdaObj);

    /* Create the command "apply {{} {set a 42}" */
    evalObjs[0] = Tcl_NewStringObj("apply", TCL_INDEX_NONE);
    Tcl_IncrRefCount(evalObjs[0]);
    /*
     * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because
     * it will get shimmered to a Lambda internal representation but we
     * want to hold on to our list representation.
     */
    evalObjs[1] = Tcl_DuplicateObj(lambdaObj);
Changes to generic/tclTrace.c.
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t numChars,
			    int objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(ClientData clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(ClientData clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
    ClientData clientData;	/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */







|

|



|



|










|







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t numChars,
			    int objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(void *clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(void *clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(void *clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(void *clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
    void *clientData;	/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
	} else {
	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
	}
	Tcl_DecrRefCount(opsList);
	return code;
    }
    case TRACE_OLD_VINFO: {
	ClientData clientData;
	char ops[5];
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

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







|







309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
	} else {
	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
	}
	Tcl_DecrRefCount(opsList);
	return code;
    }
    case TRACE_OLD_VINFO: {
	void *clientData;
	char ops[5];
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {







|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}








|







547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	void *clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {







|







723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    void *clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}








|







753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	void *clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    ClientData clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    } index;








|







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
    Tcl_Interp *interp,		/* Current interpreter. */
	enum traceOptions optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *command;
    size_t commandLength, length;
    void *clientData;
    static const char *const opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    } index;

1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055

ClientData
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;








|







1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055

ClientData
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
				 * traced. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon cmdName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {







|







1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
				 * traced. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon cmdName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
Tcl_UntraceCommand(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;







|







1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
Tcl_UntraceCommand(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static void
TraceCommandProc(
    ClientData clientData,	/* Information about the command trace. */
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */







|







1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static void
TraceCommandProc(
    void *clientData,	/* Information about the command trace. */
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
 *	May release memory.
 *
 *----------------------------------------------------------------------
 */

static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}







|







1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
 *	May release memory.
 *
 *----------------------------------------------------------------------
 */

static void
CommandObjTraceDeleted(
    void *clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    }
}
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
 *	interpreter-wide trace.
 *
 *----------------------------------------------------------------------
 */

static int
TraceExecutionProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    int objc,
    struct Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;







|





|







1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
 *	interpreter-wide trace.
 *
 *----------------------------------------------------------------------
 */

static int
TraceExecutionProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    int objc,
    Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static char *
TraceVarProc(
    ClientData clientData,	/* Information about the variable trace. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{







|







1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

static char *
TraceVarProc(
    void *clientData,	/* Information about the variable trace. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
2121
2122
2123
2124
2125
2126
2127
















































2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
 *	applications such as profiling of run time.
 *
 *	When the trace is deleted, the 'delProc' function will be invoked,
 *	passing it the original client data.
 *
 *----------------------------------------------------------------------
 */

















































Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    ClientData clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

    /*







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







|







2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
 *	applications such as profiling of run time.
 *
 *	When the trace is deleted, the 'delProc' function will be invoked,
 *	passing it the original client data.
 *
 *----------------------------------------------------------------------
 */

typedef struct {
    Tcl_CmdObjTraceProc2 *proc;
    Tcl_CmdObjTraceDeleteProc *delProc;
    void *clientData;
} TraceWrapperInfo;

static int traceWrapperProc(
    void *clientData,
    Tcl_Interp *interp,
	int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const objv[])
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv);
}

static void traceWrapperDelProc(void *clientData)
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)clientData;
    clientData = info->clientData;
    if (info->delProc) {
	info->delProc(clientData);
    }
    Tcl_Free(info);
}

Tcl_Trace
Tcl_CreateObjTrace2(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc2 *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    TraceWrapperInfo *info = (TraceWrapperInfo *)Tcl_Alloc(sizeof(TraceWrapperInfo));
    info->proc = proc;
    info->delProc = delProc;
    info->clientData = clientData;
    return Tcl_CreateObjTrace(interp, level, flags,
	    (proc ? traceWrapperProc : NULL),
	    info, traceWrapperDelProc);
}

Tcl_Trace
Tcl_CreateObjTrace(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    void *clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;

    /*
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
 *	From now on, proc will be called just before a command procedure is
 *	called to execute a Tcl command. Calls to proc will have the following
 *	form:
 *
 *	void
 *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
 *		argc, argv)
 *	    ClientData clientData;
 *	    Tcl_Interp *interp;
 *	    int level;
 *	    char *command;
 *	    int (*cmdProc)();
 *	    ClientData cmdClientData;
 *	    int argc;
 *	    char **argv;
 *	{
 *	}
 *
 *	The clientData and interp arguments to proc will be the same as the
 *	corresponding arguments to this function. Level gives the nesting







|




|







2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
 *	From now on, proc will be called just before a command procedure is
 *	called to execute a Tcl command. Calls to proc will have the following
 *	form:
 *
 *	void
 *	proc(clientData, interp, level, command, cmdProc, cmdClientData,
 *		argc, argv)
 *	    void *clientData;
 *	    Tcl_Interp *interp;
 *	    int level;
 *	    char *command;
 *	    int (*cmdProc)();
 *	    void *cmdClientData;
 *	    int argc;
 *	    char **argv;
 *	{
 *	}
 *
 *	The clientData and interp arguments to proc will be the same as the
 *	corresponding arguments to this function. Level gives the nesting
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    ClientData clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);







|







2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
Tcl_Trace
Tcl_CreateTrace(
    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    void *clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
 *	Whatever the string-based trace function does.
 *
 *----------------------------------------------------------------------
 */

static int
StringTraceProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{







|







2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
 *	Whatever the string-based trace function does.
 *
 *----------------------------------------------------------------------
 */

static int
StringTraceProc(
    void *clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
 *	Allocated memory is returned to the system.
 *
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *







|







2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
 *	Allocated memory is returned to the system.
 *
 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    void *clientData)
{
    Tcl_Free(clientData);
}

/*
 *----------------------------------------------------------------------
 *
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
    int flagMask, allFlags = 0;







|







2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
    int flagMask, allFlags = 0;
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;







|







3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
    const char *part1,		/* Name of variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    int flags,			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    void *prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;







|







3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
				 * as-a-whole. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    void *clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
Changes to library/tzdata/America/Punta_Arenas.
17
18
19
20
21
22
23

24
25
26
27
28
29
30
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}

    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}







>







17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-736632000 -14400 1 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}
Changes to library/tzdata/America/Santiago.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-740520000 -10800 1 -03}
    {-736376400 -14400 0 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-740520000 -10800 1 -03}
    {-736635600 -14400 1 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    {1554606000 -14400 0 -04}
    {1567915200 -10800 1 -04}
    {1586055600 -14400 0 -04}
    {1599364800 -10800 1 -04}
    {1617505200 -14400 0 -04}
    {1630814400 -10800 1 -04}
    {1648954800 -14400 0 -04}
    {1662264000 -10800 1 -04}
    {1680404400 -14400 0 -04}
    {1693713600 -10800 1 -04}
    {1712458800 -14400 0 -04}
    {1725768000 -10800 1 -04}
    {1743908400 -14400 0 -04}
    {1757217600 -10800 1 -04}
    {1775358000 -14400 0 -04}







|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    {1554606000 -14400 0 -04}
    {1567915200 -10800 1 -04}
    {1586055600 -14400 0 -04}
    {1599364800 -10800 1 -04}
    {1617505200 -14400 0 -04}
    {1630814400 -10800 1 -04}
    {1648954800 -14400 0 -04}
    {1662868800 -10800 1 -04}
    {1680404400 -14400 0 -04}
    {1693713600 -10800 1 -04}
    {1712458800 -14400 0 -04}
    {1725768000 -10800 1 -04}
    {1743908400 -14400 0 -04}
    {1757217600 -10800 1 -04}
    {1775358000 -14400 0 -04}
Changes to library/tzdata/Antarctica/Vostok.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Antarctica/Vostok) {
    {-9223372036854775808 0 0 -00}
    {-380073600 21600 0 +06}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Urumqi)]} {
    LoadTimeZoneFile Asia/Urumqi
}
set TZData(:Antarctica/Vostok) $TZData(:Asia/Urumqi)



Changes to library/tzdata/Arctic/Longyearbyen.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
    LoadTimeZoneFile Europe/Oslo
}
set TZData(:Arctic/Longyearbyen) $TZData(:Europe/Oslo)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Arctic/Longyearbyen) $TZData(:Europe/Berlin)
Changes to library/tzdata/Asia/Brunei.
1


2
3
4
5
6
7
# created by tools/tclZIC.tcl - do not edit



set TZData(:Asia/Brunei) {
    {-9223372036854775808 27580 0 LMT}
    {-1383464380 27000 0 +0730}
    {-1167636600 28800 0 +08}
}

>
>
|
|
<
<
<
<
1
2
3
4
5




# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Kuching)]} {
    LoadTimeZoneFile Asia/Kuching
}
set TZData(:Asia/Brunei) $TZData(:Asia/Kuching)




Changes to library/tzdata/Asia/Ho_Chi_Minh.
1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Ho_Chi_Minh) {
    {-9223372036854775808 25600 0 LMT}
    {-2004073600 25590 0 PLMT}
    {-1851577590 25200 0 +07}
    {-852105600 28800 0 +08}
    {-782643600 32400 0 +09}
    {-767869200 25200 0 +07}
    {-718095600 28800 0 +08}
    {-457776000 25200 0 +07}
    {-315648000 28800 0 +08}



|
|







1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Ho_Chi_Minh) {
    {-9223372036854775808 25590 0 LMT}
    {-2004073590 25590 0 PLMT}
    {-1851577590 25200 0 +07}
    {-852105600 28800 0 +08}
    {-782643600 32400 0 +09}
    {-767869200 25200 0 +07}
    {-718095600 28800 0 +08}
    {-457776000 25200 0 +07}
    {-315648000 28800 0 +08}
Changes to library/tzdata/Asia/Kuala_Lumpur.
1


2
3
4
5
6
7
8
9
10
11
12
13
# created by tools/tclZIC.tcl - do not edit



set TZData(:Asia/Kuala_Lumpur) {
    {-9223372036854775808 24406 0 LMT}
    {-2177477206 24925 0 SMT}
    {-2038200925 25200 0 +07}
    {-1167634800 26400 1 +0720}
    {-1073028000 26400 0 +0720}
    {-894180000 27000 0 +0730}
    {-879665400 32400 0 +09}
    {-767005200 27000 0 +0730}
    {378664200 28800 0 +08}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5










# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Singapore)]} {
    LoadTimeZoneFile Asia/Singapore
}
set TZData(:Asia/Kuala_Lumpur) $TZData(:Asia/Singapore)










Changes to library/tzdata/Asia/Tehran.
1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tehran) {
    {-9223372036854775808 12344 0 LMT}
    {-1704165944 12344 0 TMT}
    {-757394744 12600 0 +0330}

    {247177800 14400 0 +04}
    {259272000 18000 1 +04}
    {277758000 14400 0 +04}
    {283982400 12600 0 +0330}
    {290809800 16200 1 +0330}
    {306531000 12600 0 +0330}
    {322432200 16200 1 +0330}
    {338499000 12600 0 +0330}
    {673216200 16200 1 +0330}
    {685481400 12600 0 +0330}
    {701209800 16200 1 +0330}
    {717103800 12600 0 +0330}





|
>
|
|
|

|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tehran) {
    {-9223372036854775808 12344 0 LMT}
    {-1704165944 12344 0 TMT}
    {-1090466744 12600 0 +0330}
    {227820600 16200 1 +0330}
    {246227400 14400 0 +04}
    {259617600 18000 1 +04}
    {271108800 14400 0 +04}
    {283982400 12600 0 +0330}
    {296598600 16200 1 +0330}
    {306531000 12600 0 +0330}
    {322432200 16200 1 +0330}
    {338499000 12600 0 +0330}
    {673216200 16200 1 +0330}
    {685481400 12600 0 +0330}
    {701209800 16200 1 +0330}
    {717103800 12600 0 +0330}
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
    {1569094200 12600 0 +0330}
    {1584736200 16200 1 +0330}
    {1600630200 12600 0 +0330}
    {1616358600 16200 1 +0330}
    {1632252600 12600 0 +0330}
    {1647894600 16200 1 +0330}
    {1663788600 12600 0 +0330}
    {1679430600 16200 1 +0330}
    {1695324600 12600 0 +0330}
    {1710966600 16200 1 +0330}
    {1726860600 12600 0 +0330}
    {1742589000 16200 1 +0330}
    {1758483000 12600 0 +0330}
    {1774125000 16200 1 +0330}
    {1790019000 12600 0 +0330}
    {1805661000 16200 1 +0330}
    {1821555000 12600 0 +0330}
    {1837197000 16200 1 +0330}
    {1853091000 12600 0 +0330}
    {1868733000 16200 1 +0330}
    {1884627000 12600 0 +0330}
    {1900355400 16200 1 +0330}
    {1916249400 12600 0 +0330}
    {1931891400 16200 1 +0330}
    {1947785400 12600 0 +0330}
    {1963427400 16200 1 +0330}
    {1979321400 12600 0 +0330}
    {1994963400 16200 1 +0330}
    {2010857400 12600 0 +0330}
    {2026585800 16200 1 +0330}
    {2042479800 12600 0 +0330}
    {2058121800 16200 1 +0330}
    {2074015800 12600 0 +0330}
    {2089657800 16200 1 +0330}
    {2105551800 12600 0 +0330}
    {2121193800 16200 1 +0330}
    {2137087800 12600 0 +0330}
    {2152816200 16200 1 +0330}
    {2168710200 12600 0 +0330}
    {2184352200 16200 1 +0330}
    {2200246200 12600 0 +0330}
    {2215888200 16200 1 +0330}
    {2231782200 12600 0 +0330}
    {2247424200 16200 1 +0330}
    {2263318200 12600 0 +0330}
    {2279046600 16200 1 +0330}
    {2294940600 12600 0 +0330}
    {2310582600 16200 1 +0330}
    {2326476600 12600 0 +0330}
    {2342118600 16200 1 +0330}
    {2358012600 12600 0 +0330}
    {2373654600 16200 1 +0330}
    {2389548600 12600 0 +0330}
    {2405277000 16200 1 +0330}
    {2421171000 12600 0 +0330}
    {2436813000 16200 1 +0330}
    {2452707000 12600 0 +0330}
    {2468349000 16200 1 +0330}
    {2484243000 12600 0 +0330}
    {2499885000 16200 1 +0330}
    {2515779000 12600 0 +0330}
    {2531507400 16200 1 +0330}
    {2547401400 12600 0 +0330}
    {2563043400 16200 1 +0330}
    {2578937400 12600 0 +0330}
    {2594579400 16200 1 +0330}
    {2610473400 12600 0 +0330}
    {2626115400 16200 1 +0330}
    {2642009400 12600 0 +0330}
    {2657737800 16200 1 +0330}
    {2673631800 12600 0 +0330}
    {2689273800 16200 1 +0330}
    {2705167800 12600 0 +0330}
    {2720809800 16200 1 +0330}
    {2736703800 12600 0 +0330}
    {2752345800 16200 1 +0330}
    {2768239800 12600 0 +0330}
    {2783968200 16200 1 +0330}
    {2799862200 12600 0 +0330}
    {2815504200 16200 1 +0330}
    {2831398200 12600 0 +0330}
    {2847040200 16200 1 +0330}
    {2862934200 12600 0 +0330}
    {2878576200 16200 1 +0330}
    {2894470200 12600 0 +0330}
    {2910112200 16200 1 +0330}
    {2926006200 12600 0 +0330}
    {2941734600 16200 1 +0330}
    {2957628600 12600 0 +0330}
    {2973270600 16200 1 +0330}
    {2989164600 12600 0 +0330}
    {3004806600 16200 1 +0330}
    {3020700600 12600 0 +0330}
    {3036342600 16200 1 +0330}
    {3052236600 12600 0 +0330}
    {3067965000 16200 1 +0330}
    {3083859000 12600 0 +0330}
    {3099501000 16200 1 +0330}
    {3115395000 12600 0 +0330}
    {3131037000 16200 1 +0330}
    {3146931000 12600 0 +0330}
    {3162573000 16200 1 +0330}
    {3178467000 12600 0 +0330}
    {3194195400 16200 1 +0330}
    {3210089400 12600 0 +0330}
    {3225731400 16200 1 +0330}
    {3241625400 12600 0 +0330}
    {3257267400 16200 1 +0330}
    {3273161400 12600 0 +0330}
    {3288803400 16200 1 +0330}
    {3304697400 12600 0 +0330}
    {3320425800 16200 1 +0330}
    {3336319800 12600 0 +0330}
    {3351961800 16200 1 +0330}
    {3367855800 12600 0 +0330}
    {3383497800 16200 1 +0330}
    {3399391800 12600 0 +0330}
    {3415033800 16200 1 +0330}
    {3430927800 12600 0 +0330}
    {3446656200 16200 1 +0330}
    {3462550200 12600 0 +0330}
    {3478192200 16200 1 +0330}
    {3494086200 12600 0 +0330}
    {3509728200 16200 1 +0330}
    {3525622200 12600 0 +0330}
    {3541264200 16200 1 +0330}
    {3557158200 12600 0 +0330}
    {3572886600 16200 1 +0330}
    {3588780600 12600 0 +0330}
    {3604422600 16200 1 +0330}
    {3620316600 12600 0 +0330}
    {3635958600 16200 1 +0330}
    {3651852600 12600 0 +0330}
    {3667494600 16200 1 +0330}
    {3683388600 12600 0 +0330}
    {3699117000 16200 1 +0330}
    {3715011000 12600 0 +0330}
    {3730653000 16200 1 +0330}
    {3746547000 12600 0 +0330}
    {3762189000 16200 1 +0330}
    {3778083000 12600 0 +0330}
    {3793725000 16200 1 +0330}
    {3809619000 12600 0 +0330}
    {3825261000 16200 1 +0330}
    {3841155000 12600 0 +0330}
    {3856883400 16200 1 +0330}
    {3872777400 12600 0 +0330}
    {3888419400 16200 1 +0330}
    {3904313400 12600 0 +0330}
    {3919955400 16200 1 +0330}
    {3935849400 12600 0 +0330}
    {3951491400 16200 1 +0330}
    {3967385400 12600 0 +0330}
    {3983113800 16200 1 +0330}
    {3999007800 12600 0 +0330}
    {4014649800 16200 1 +0330}
    {4030543800 12600 0 +0330}
    {4046185800 16200 1 +0330}
    {4062079800 12600 0 +0330}
    {4077721800 16200 1 +0330}
    {4093615800 12600 0 +0330}
}







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

69
70
71
72
73
74
75


























































































































































76
    {1569094200 12600 0 +0330}
    {1584736200 16200 1 +0330}
    {1600630200 12600 0 +0330}
    {1616358600 16200 1 +0330}
    {1632252600 12600 0 +0330}
    {1647894600 16200 1 +0330}
    {1663788600 12600 0 +0330}


























































































































































}
Changes to library/tzdata/Atlantic/Jan_Mayen.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
    LoadTimeZoneFile Europe/Oslo
}
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Oslo)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Berlin)
Changes to library/tzdata/Atlantic/Reykjavik.
1


2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
# created by tools/tclZIC.tcl - do not edit



set TZData(:Atlantic/Reykjavik) {
    {-9223372036854775808 -5280 0 LMT}
    {-1956609120 -3600 0 -01}
    {-1668211200 0 1 -01}
    {-1647212400 -3600 0 -01}
    {-1636675200 0 1 -01}
    {-1613430000 -3600 0 -01}
    {-1605139200 0 1 -01}
    {-1581894000 -3600 0 -01}
    {-1539561600 0 1 -01}
    {-1531350000 -3600 0 -01}
    {-968025600 0 1 -01}
    {-952293600 -3600 0 -01}
    {-942008400 0 1 -01}
    {-920239200 -3600 0 -01}
    {-909957600 0 1 -01}
    {-888789600 -3600 0 -01}
    {-877903200 0 1 -01}
    {-857944800 -3600 0 -01}
    {-846453600 0 1 -01}
    {-826495200 -3600 0 -01}
    {-815004000 0 1 -01}
    {-795045600 -3600 0 -01}
    {-783554400 0 1 -01}
    {-762991200 -3600 0 -01}
    {-752104800 0 1 -01}
    {-731541600 -3600 0 -01}
    {-717631200 0 1 -01}
    {-700092000 -3600 0 -01}
    {-686181600 0 1 -01}
    {-668642400 -3600 0 -01}
    {-654732000 0 1 -01}
    {-636588000 -3600 0 -01}
    {-623282400 0 1 -01}
    {-605743200 -3600 0 -01}
    {-591832800 0 1 -01}
    {-573688800 -3600 0 -01}
    {-559778400 0 1 -01}
    {-542239200 -3600 0 -01}
    {-528328800 0 1 -01}
    {-510789600 -3600 0 -01}
    {-496879200 0 1 -01}
    {-479340000 -3600 0 -01}
    {-465429600 0 1 -01}
    {-447890400 -3600 0 -01}
    {-433980000 0 1 -01}
    {-415836000 -3600 0 -01}
    {-401925600 0 1 -01}
    {-384386400 -3600 0 -01}
    {-370476000 0 1 -01}
    {-352936800 -3600 0 -01}
    {-339026400 0 1 -01}
    {-321487200 -3600 0 -01}
    {-307576800 0 1 -01}
    {-290037600 -3600 0 -01}
    {-276127200 0 1 -01}
    {-258588000 -3600 0 -01}
    {-244677600 0 1 -01}
    {-226533600 -3600 0 -01}
    {-212623200 0 1 -01}
    {-195084000 -3600 0 -01}
    {-181173600 0 1 -01}
    {-163634400 -3600 0 -01}
    {-149724000 0 1 -01}
    {-132184800 -3600 0 -01}
    {-118274400 0 1 -01}
    {-100735200 -3600 0 -01}
    {-86824800 0 1 -01}
    {-68680800 -3600 0 -01}
    {-54770400 0 0 GMT}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5






































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan
}
set TZData(:Atlantic/Reykjavik) $TZData(:Africa/Abidjan)






































































Deleted library/tzdata/Canada/East-Saskatchewan.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Regina)]} {
    LoadTimeZoneFile America/Regina
}
set TZData(:Canada/East-Saskatchewan) $TZData(:America/Regina)
<
<
<
<
<










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

# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Amsterdam) {
    {-9223372036854775808 1172 0 LMT}
    {-4260212372 1172 0 AMT}
    {-1693700372 4772 1 NST}
    {-1680484772 1172 0 AMT}
    {-1663453172 4772 1 NST}
    {-1650147572 1172 0 AMT}
    {-1633213172 4772 1 NST}
    {-1617488372 1172 0 AMT}
    {-1601158772 4772 1 NST}
    {-1586038772 1172 0 AMT}
    {-1569709172 4772 1 NST}
    {-1554589172 1172 0 AMT}
    {-1538259572 4772 1 NST}
    {-1523139572 1172 0 AMT}
    {-1507501172 4772 1 NST}
    {-1490566772 1172 0 AMT}
    {-1470176372 4772 1 NST}
    {-1459117172 1172 0 AMT}
    {-1443997172 4772 1 NST}
    {-1427667572 1172 0 AMT}
    {-1406672372 4772 1 NST}
    {-1396217972 1172 0 AMT}
    {-1376950772 4772 1 NST}
    {-1364768372 1172 0 AMT}
    {-1345414772 4772 1 NST}
    {-1333318772 1172 0 AMT}
    {-1313792372 4772 1 NST}
    {-1301264372 1172 0 AMT}
    {-1282256372 4772 1 NST}
    {-1269814772 1172 0 AMT}
    {-1250720372 4772 1 NST}
    {-1238365172 1172 0 AMT}
    {-1219184372 4772 1 NST}
    {-1206915572 1172 0 AMT}
    {-1186957172 4772 1 NST}
    {-1175465972 1172 0 AMT}
    {-1156025972 4772 1 NST}
    {-1143411572 1172 0 AMT}
    {-1124489972 4772 1 NST}
    {-1111961972 1172 0 AMT}
    {-1092953972 4772 1 NST}
    {-1080512372 1172 0 AMT}
    {-1061331572 4772 1 NST}
    {-1049062772 1172 0 AMT}
    {-1029190772 4772 1 NST}
    {-1025741972 4800 0 +0120}
    {-1017613200 1200 0 +0020}
    {-998259600 4800 1 +0120}
    {-986163600 1200 0 +0020}
    {-966723600 4800 1 +0120}
    {-954109200 1200 0 +0020}
    {-935022000 7200 0 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-766623600 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}


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

>
1
2

























































































































































3

























































































































































4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Brussels)]} {

























































































































































    LoadTimeZoneFile Europe/Brussels

























































































































































}
set TZData(:Europe/Amsterdam) $TZData(:Europe/Brussels)
Changes to library/tzdata/Europe/Copenhagen.
1


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



set TZData(:Europe/Copenhagen) {
    {-9223372036854775808 3020 0 LMT}
    {-2524524620 3020 0 CMT}
    {-2398294220 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680490800 3600 0 CET}
    {-935110800 7200 1 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-769388400 3600 0 CET}
    {-747010800 7200 1 CEST}
    {-736383600 3600 0 CET}
    {-715215600 7200 1 CEST}
    {-706748400 3600 0 CET}
    {-683161200 7200 1 CEST}
    {-675298800 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5





































































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Europe/Copenhagen) $TZData(:Europe/Berlin)





































































































































































































































































Changes to library/tzdata/Europe/Dublin.
1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Dublin) {
    {-9223372036854775808 -1500 0 LMT}
    {-2821649700 -1521 0 DMT}
    {-1691962479 2079 1 IST}
    {-1680471279 0 0 GMT}
    {-1664143200 3600 1 BST}
    {-1650146400 0 0 GMT}
    {-1633903200 3600 1 BST}
    {-1617487200 0 0 GMT}
    {-1601848800 3600 1 BST}



|
|







1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Dublin) {
    {-9223372036854775808 -1521 0 LMT}
    {-2821649679 -1521 0 DMT}
    {-1691962479 2079 1 IST}
    {-1680471279 0 0 GMT}
    {-1664143200 3600 1 BST}
    {-1650146400 0 0 GMT}
    {-1633903200 3600 1 BST}
    {-1617487200 0 0 GMT}
    {-1601848800 3600 1 BST}
Changes to library/tzdata/Europe/Kiev.
1


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



set TZData(:Europe/Kiev) {
    {-9223372036854775808 7324 0 LMT}
    {-2840148124 7324 0 KMT}
    {-1441159324 7200 0 EET}
    {-1247536800 10800 0 MSK}
    {-892522800 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-825382800 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {646786800 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}
    {831938400 10800 0 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5
























































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Kyiv)]} {
    LoadTimeZoneFile Europe/Kyiv
}
set TZData(:Europe/Kiev) $TZData(:Europe/Kyiv)
























































































































































































































































Added library/tzdata/Europe/Kyiv.






















































































































































































































































































































































































































































































































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

set TZData(:Europe/Kyiv) {
    {-9223372036854775808 7324 0 LMT}
    {-2840148124 7324 0 KMT}
    {-1441159324 7200 0 EET}
    {-1247536800 10800 0 MSK}
    {-892522800 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-825382800 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {646786800 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}
    {831938400 10800 0 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}
Changes to library/tzdata/Europe/Luxembourg.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Luxembourg) {
    {-9223372036854775808 1476 0 LMT}
    {-2069713476 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {-1662343200 7200 1 CEST}
    {-1650157200 3600 0 CET}
    {-1632006000 7200 1 CEST}
    {-1618700400 3600 0 CET}
    {-1612659600 0 0 WET}
    {-1604278800 3600 1 WEST}
    {-1585519200 0 0 WET}
    {-1574038800 3600 1 WEST}
    {-1552258800 0 0 WET}
    {-1539997200 3600 1 WEST}
    {-1520550000 0 0 WET}
    {-1507510800 3600 1 WEST}
    {-1490572800 0 0 WET}
    {-1473642000 3600 1 WEST}
    {-1459119600 0 0 WET}
    {-1444006800 3600 1 WEST}
    {-1427673600 0 0 WET}
    {-1411866000 3600 1 WEST}
    {-1396224000 0 0 WET}
    {-1379293200 3600 1 WEST}
    {-1364774400 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333324800 0 0 WET}
    {-1316394000 3600 1 WEST}
    {-1301270400 0 0 WET}
    {-1284339600 3600 1 WEST}
    {-1269813600 0 0 WET}
    {-1253484000 3600 1 WEST}
    {-1238364000 0 0 WET}
    {-1221429600 3600 1 WEST}
    {-1206914400 0 0 WET}
    {-1191189600 3600 1 WEST}
    {-1175464800 0 0 WET}
    {-1160344800 3600 1 WEST}
    {-1143410400 0 0 WET}
    {-1127685600 3600 1 WEST}
    {-1111960800 0 0 WET}
    {-1096840800 3600 1 WEST}
    {-1080511200 0 0 WET}
    {-1063576800 3600 1 WEST}
    {-1049061600 0 0 WET}
    {-1033336800 3600 1 WEST}
    {-1017612000 0 0 WET}
    {-1002492000 3600 1 WEST}
    {-986162400 0 0 WET}
    {-969228000 3600 1 WEST}
    {-950479200 0 0 WET}
    {-942012000 3600 1 WEST}
    {-935186400 7200 0 WEST}
    {-857257200 3600 0 WET}
    {-844556400 7200 1 WEST}
    {-828226800 3600 0 WET}
    {-812502000 7200 1 WEST}
    {-797983200 3600 0 CET}
    {-781052400 7200 1 CEST}
    {-766623600 3600 0 CET}
    {-745455600 7200 1 CEST}
    {-733273200 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}


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

>
1
2



























































































































































3


























































































































































4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Brussels)]} {



























































































































































    LoadTimeZoneFile Europe/Brussels


























































































































































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

# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Monaco) {
    {-9223372036854775808 1772 0 LMT}
    {-2448318572 561 0 PMT}
    {-1854403761 0 0 WET}
    {-1689814800 3600 1 WEST}
    {-1680397200 0 0 WET}
    {-1665363600 3600 1 WEST}
    {-1648342800 0 0 WET}
    {-1635123600 3600 1 WEST}
    {-1616893200 0 0 WET}
    {-1604278800 3600 1 WEST}
    {-1585443600 0 0 WET}
    {-1574038800 3600 1 WEST}
    {-1552266000 0 0 WET}
    {-1539997200 3600 1 WEST}
    {-1520557200 0 0 WET}
    {-1507510800 3600 1 WEST}
    {-1490576400 0 0 WET}
    {-1470618000 3600 1 WEST}
    {-1459126800 0 0 WET}
    {-1444006800 3600 1 WEST}
    {-1427677200 0 0 WET}
    {-1411952400 3600 1 WEST}
    {-1396227600 0 0 WET}
    {-1379293200 3600 1 WEST}
    {-1364778000 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333328400 0 0 WET}
    {-1316394000 3600 1 WEST}
    {-1301274000 0 0 WET}
    {-1284339600 3600 1 WEST}
    {-1269824400 0 0 WET}
    {-1253494800 3600 1 WEST}
    {-1238374800 0 0 WET}
    {-1221440400 3600 1 WEST}
    {-1206925200 0 0 WET}
    {-1191200400 3600 1 WEST}
    {-1175475600 0 0 WET}
    {-1160355600 3600 1 WEST}
    {-1143421200 0 0 WET}
    {-1127696400 3600 1 WEST}
    {-1111971600 0 0 WET}
    {-1096851600 3600 1 WEST}
    {-1080522000 0 0 WET}
    {-1063587600 3600 1 WEST}
    {-1049072400 0 0 WET}
    {-1033347600 3600 1 WEST}
    {-1017622800 0 0 WET}
    {-1002502800 3600 1 WEST}
    {-986173200 0 0 WET}
    {-969238800 3600 1 WEST}
    {-950490000 0 0 WET}
    {-942012000 3600 1 WEST}
    {-904438800 7200 1 WEMT}
    {-891136800 3600 1 WEST}
    {-877827600 7200 1 WEMT}
    {-857257200 3600 1 WEST}
    {-844556400 7200 1 WEMT}
    {-828226800 3600 1 WEST}
    {-812502000 7200 1 WEMT}
    {-796266000 3600 1 WEST}
    {-781052400 7200 1 WEMT}
    {-766616400 3600 0 CET}
    {196819200 7200 1 CEST}
    {212540400 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}


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

>
1
2




























































































































































3



























































































































































4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Paris)]} {




























































































































































    LoadTimeZoneFile Europe/Paris



























































































































































}
set TZData(:Europe/Monaco) $TZData(:Europe/Paris)
Changes to library/tzdata/Europe/Oslo.
1


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



set TZData(:Europe/Oslo) {
    {-9223372036854775808 2580 0 LMT}
    {-2366757780 3600 0 CET}
    {-1691884800 7200 1 CEST}
    {-1680573600 3600 0 CET}
    {-927511200 7200 0 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-765327600 3600 0 CET}
    {-340844400 7200 1 CEST}
    {-324514800 3600 0 CET}
    {-308790000 7200 1 CEST}
    {-293065200 3600 0 CET}
    {-277340400 7200 1 CEST}
    {-261615600 3600 0 CET}
    {-245890800 7200 1 CEST}
    {-230166000 3600 0 CET}
    {-214441200 7200 1 CEST}
    {-198716400 3600 0 CET}
    {-182991600 7200 1 CEST}
    {-166662000 3600 0 CET}
    {-147913200 7200 1 CEST}
    {-135212400 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5












































































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Europe/Oslo) $TZData(:Europe/Berlin)












































































































































































































































































Changes to library/tzdata/Europe/Simferopol.
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    {701042400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {767743200 14400 0 MSD}
    {780436800 10800 0 MSK}
    {796165200 14400 1 MSD}
    {811886400 10800 0 MSK}
    {828219600 14400 1 MSD}
    {852066000 10800 0 MSK}
    {859683600 10800 0 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}







|
|
|

|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    {701042400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {767743200 14400 0 MSD}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828219600 14400 1 MSD}
    {846374400 10800 0 MSK}
    {859683600 10800 0 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
Changes to library/tzdata/Europe/Stockholm.
1


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



set TZData(:Europe/Stockholm) {
    {-9223372036854775808 4332 0 LMT}
    {-2871681132 3614 0 SET}
    {-2208992414 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
1
2
3
4
5























































































































































































































































# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Europe/Stockholm) $TZData(:Europe/Berlin)























































































































































































































































Changes to library/tzdata/Iceland.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Atlantic/Reykjavik)]} {
    LoadTimeZoneFile Atlantic/Reykjavik
}
set TZData(:Iceland) $TZData(:Atlantic/Reykjavik)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan
}
set TZData(:Iceland) $TZData(:Africa/Abidjan)
Changes to library/tzdata/Indian/Christmas.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Indian/Christmas) {
    {-9223372036854775808 25372 0 LMT}
    {-2364102172 25200 0 +07}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Bangkok)]} {
    LoadTimeZoneFile Asia/Bangkok
}
set TZData(:Indian/Christmas) $TZData(:Asia/Bangkok)



Changes to library/tzdata/Indian/Cocos.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Indian/Cocos) {
    {-9223372036854775808 23260 0 LMT}
    {-2209012060 23400 0 +0630}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Yangon)]} {
    LoadTimeZoneFile Asia/Yangon
}
set TZData(:Indian/Cocos) $TZData(:Asia/Yangon)



Changes to library/tzdata/Indian/Kerguelen.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Indian/Kerguelen) {
    {-9223372036854775808 0 0 -00}
    {-631152000 18000 0 +05}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Indian/Maldives)]} {
    LoadTimeZoneFile Indian/Maldives
}
set TZData(:Indian/Kerguelen) $TZData(:Indian/Maldives)



Changes to library/tzdata/Indian/Mahe.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Indian/Mahe) {
    {-9223372036854775808 13308 0 LMT}
    {-1988163708 14400 0 +04}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Dubai)]} {
    LoadTimeZoneFile Asia/Dubai
}
set TZData(:Indian/Mahe) $TZData(:Asia/Dubai)



Changes to library/tzdata/Indian/Reunion.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Indian/Reunion) {
    {-9223372036854775808 13312 0 LMT}
    {-1848886912 14400 0 +04}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Dubai)]} {
    LoadTimeZoneFile Asia/Dubai
}
set TZData(:Indian/Reunion) $TZData(:Asia/Dubai)



Changes to library/tzdata/Pacific/Chuuk.
1


2
3
4
5
6
7
8
9
10
11
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Chuuk) {
    {-9223372036854775808 -49972 0 LMT}
    {-3944628428 36428 0 LMT}
    {-2177489228 36000 0 +10}
    {-1743674400 32400 0 +09}
    {-1606813200 36000 0 +10}
    {-907408800 32400 0 +09}
    {-770634000 36000 0 +10}
}

>
>
|
|
<
<
<
<
<
<
<
<
1
2
3
4
5








# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Pacific/Chuuk) $TZData(:Pacific/Port_Moresby)








Changes to library/tzdata/Pacific/Easter.
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    {1554606000 -21600 0 -06}
    {1567915200 -18000 1 -06}
    {1586055600 -21600 0 -06}
    {1599364800 -18000 1 -06}
    {1617505200 -21600 0 -06}
    {1630814400 -18000 1 -06}
    {1648954800 -21600 0 -06}
    {1662264000 -18000 1 -06}
    {1680404400 -21600 0 -06}
    {1693713600 -18000 1 -06}
    {1712458800 -21600 0 -06}
    {1725768000 -18000 1 -06}
    {1743908400 -21600 0 -06}
    {1757217600 -18000 1 -06}
    {1775358000 -21600 0 -06}







|







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    {1554606000 -21600 0 -06}
    {1567915200 -18000 1 -06}
    {1586055600 -21600 0 -06}
    {1599364800 -18000 1 -06}
    {1617505200 -21600 0 -06}
    {1630814400 -18000 1 -06}
    {1648954800 -21600 0 -06}
    {1662868800 -18000 1 -06}
    {1680404400 -21600 0 -06}
    {1693713600 -18000 1 -06}
    {1712458800 -21600 0 -06}
    {1725768000 -18000 1 -06}
    {1743908400 -21600 0 -06}
    {1757217600 -18000 1 -06}
    {1775358000 -21600 0 -06}
Changes to library/tzdata/Pacific/Funafuti.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Funafuti) {
    {-9223372036854775808 43012 0 LMT}
    {-2177495812 43200 0 +12}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa
}
set TZData(:Pacific/Funafuti) $TZData(:Pacific/Tarawa)



Changes to library/tzdata/Pacific/Majuro.
1


2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Majuro) {
    {-9223372036854775808 41088 0 LMT}
    {-2177493888 39600 0 +11}
    {-1743678000 32400 0 +09}
    {-1606813200 39600 0 +11}
    {-1041418800 36000 0 +10}
    {-907408800 32400 0 +09}
    {-818067600 39600 0 +11}
    {-7988400 43200 0 +12}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
1
2
3
4
5









# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa
}
set TZData(:Pacific/Majuro) $TZData(:Pacific/Tarawa)









Changes to library/tzdata/Pacific/Pohnpei.
1


2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Pohnpei) {
    {-9223372036854775808 -48428 0 LMT}
    {-3944629972 37972 0 LMT}
    {-2177490772 39600 0 +11}
    {-1743678000 32400 0 +09}
    {-1606813200 39600 0 +11}
    {-1041418800 36000 0 +10}
    {-907408800 32400 0 +09}
    {-770634000 39600 0 +11}
}

>
>
|
|
<
<
<
<
<
<
<
<
<
1
2
3
4
5









# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Guadalcanal)]} {
    LoadTimeZoneFile Pacific/Guadalcanal
}
set TZData(:Pacific/Pohnpei) $TZData(:Pacific/Guadalcanal)









Changes to library/tzdata/Pacific/Ponape.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Pohnpei)]} {
    LoadTimeZoneFile Pacific/Pohnpei
}
set TZData(:Pacific/Ponape) $TZData(:Pacific/Pohnpei)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Guadalcanal)]} {
    LoadTimeZoneFile Pacific/Guadalcanal
}
set TZData(:Pacific/Ponape) $TZData(:Pacific/Guadalcanal)
Changes to library/tzdata/Pacific/Truk.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Chuuk)]} {
    LoadTimeZoneFile Pacific/Chuuk
}
set TZData(:Pacific/Truk) $TZData(:Pacific/Chuuk)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Pacific/Truk) $TZData(:Pacific/Port_Moresby)
Changes to library/tzdata/Pacific/Wake.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Wake) {
    {-9223372036854775808 39988 0 LMT}
    {-2177492788 43200 0 +12}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa
}
set TZData(:Pacific/Wake) $TZData(:Pacific/Tarawa)



Changes to library/tzdata/Pacific/Wallis.
1


2
3
4
5
6
# created by tools/tclZIC.tcl - do not edit



set TZData(:Pacific/Wallis) {
    {-9223372036854775808 44120 0 LMT}
    {-2177496920 43200 0 +12}
}

>
>
|
|
<
<
<
1
2
3
4
5



# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa
}
set TZData(:Pacific/Wallis) $TZData(:Pacific/Tarawa)



Changes to library/tzdata/Pacific/Yap.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Chuuk)]} {
    LoadTimeZoneFile Pacific/Chuuk
}
set TZData(:Pacific/Yap) $TZData(:Pacific/Chuuk)

|
|

|
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Pacific/Yap) $TZData(:Pacific/Port_Moresby)
Deleted library/tzdata/US/Pacific-New.
1
2
3
4
5
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Los_Angeles)]} {
    LoadTimeZoneFile America/Los_Angeles
}
set TZData(:US/Pacific-New) $TZData(:America/Los_Angeles)
<
<
<
<
<










Changes to macosx/tclMacOSXNotify.c.
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */







|







307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
#define CF_TIMEINTERVAL_FOREVER 5.05e8

/*
 * Static routines defined in this file.
 */

static void		StartNotifierThread(void);
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		TimerWakeUp(CFRunLoopTimerRef timer, void *info);
static void		QueueFileEvents(void *info);
static void		UpdateWaitingListAndServiceEvents(
			    CFRunLoopObserverRef observer,
			    CFRunLoopActivity activity, void *info);
static int		OnOffWaitingList(ThreadSpecificData *tsdPtr,







|







501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
#define CF_TIMEINTERVAL_FOREVER 5.05e8

/*
 * Static routines defined in this file.
 */

static void		StartNotifierThread(void);
static TCL_NORETURN void NotifierThreadProc(void *clientData);
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		TimerWakeUp(CFRunLoopTimerRef timer, void *info);
static void		QueueFileEvents(void *info);
static void		UpdateWaitingListAndServiceEvents(
			    CFRunLoopObserverRef observer,
			    CFRunLoopActivity activity, void *info);
static int		OnOffWaitingList(ThreadSpecificData *tsdPtr,
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#ifdef WEAK_IMPORT_SPINLOCKLOCK
    /*
     * Initialize support for weakly imported spinlock API.







|







608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#ifdef WEAK_IMPORT_SPINLOCKLOCK
    /*
     * Initialize support for weakly imported spinlock API.
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
 *	notifier instance.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    LOCK_NOTIFIER_INIT;
    notifierCount--;
    DISABLE_ASL;








|







864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
 *	notifier instance.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    LOCK_NOTIFIER_INIT;
    notifierCount--;
    DISABLE_ASL;

966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
 *	Signals the notifier condition variable for the specified notifier.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    LOCK_NOTIFIER_TSD;
    if (tsdPtr->runLoop) {
	CFRunLoopSourceSignal(tsdPtr->runLoopSource);
	CFRunLoopWakeUp(tsdPtr->runLoop);







|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
 *	Signals the notifier condition variable for the specified notifier.
 *
 *----------------------------------------------------------------------
 */

void
TclpAlertNotifier(
    void *clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

    LOCK_NOTIFIER_TSD;
    if (tsdPtr->runLoop) {
	CFRunLoopSourceSignal(tsdPtr->runLoopSource);
	CFRunLoopWakeUp(tsdPtr->runLoop);
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
 *
 *----------------------------------------------------------------------
 */

static void
TimerWakeUp(
    TCL_UNUSED(CFRunLoopTimerRef),
    TCL_UNUSED(ClientData))
{
}

/*
 *----------------------------------------------------------------------
 *
 * TclpServiceModeHook --







|







1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
 *
 *----------------------------------------------------------------------
 */

static void
TimerWakeUp(
    TCL_UNUSED(CFRunLoopTimerRef),
    TCL_UNUSED(void *))
{
}

/*
 *----------------------------------------------------------------------
 *
 * TclpServiceModeHook --
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;







|







1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);

    if (filePtr == NULL) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
	filePtr->fd = fd;
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpNotifierData(void)
{
    return NULL;
}

/*
 *----------------------------------------------------------------------







|







1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpNotifierData(void)
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(ClientData),	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,







|







1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(void *),	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

static TCL_NORETURN void
NotifierThreadProc(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask, writableMask, exceptionalMask;
    int i, ret, numFdBits = 0, polling;
    struct timeval poll = {0., 0.}, *timePtr;
    char buf[2];








|







1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

static TCL_NORETURN void
NotifierThreadProc(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask, writableMask, exceptionalMask;
    int i, ret, numFdBits = 0, polling;
    struct timeval poll = {0., 0.}, *timePtr;
    char buf[2];

Added tests-perf/comparePerf.tcl.






































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# comparePerf.tcl --
#
#  Script to compare performance data from multiple runs.
#
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Usage:
#   tclsh comparePerf.tcl [--regexp RE] [--ratio time|rate] [--combine] [--base BASELABEL] PERFFILE ...
#
# The test data from each input file is tabulated so as to compare the results
# of test runs. If a PERFFILE does not exist, it is retried by adding the
# .perf extension. If the --regexp is specified, only test results whose
# id matches RE are examined.
#
# If the --combine option is specified, results of test sets with the same
# label are combined and averaged in the output.
#
# If the --base option is specified, the BASELABEL is used as the label to use
# the base timing. Otherwise, the label of the first data file is used.
#
# If --ratio option is "time" the ratio of test timing vs base test timing
# is shown. If "rate" (default) the inverse is shown.
#
# If --no-header is specified, the header describing test configuration is
# not output.
#
# The format of input files is as follows:
#
# Each line must begin with one of the characters below followed by a space
# followed by a string whose semantics depend on the initial character.
# E - Full path to the Tcl executable that was used to generate the file
# V - The Tcl patchlevel of the implementation
# D - A description for the test run for human consumption
# L - A label used to identify run environment. The --combine option will
#     average all measuremets that have the same label. An input file without
#     a label is treated as having a unique label and not combined with any other.
# P - A test measurement (see below)
# R - The number of runs made for the each test
# # - A comment, may be an arbitrary string. Usually included in performance
#     data to describe the test. This is silently ignored
#
# Any lines not matching one of the above are ignored with a warning to stderr.
#
# A line beginning with the "P" marker is a test measurement. The first word
# following is a floating point number representing the test runtime.
# The remaining line (after trimming of whitespace) is the id of the test.
# Test generators are encouraged to make the id a well-defined machine-parseable
# as well human readable description of the test. The id must not appear more
# than once. An example test measurement line:
# P    2.32280 linsert in unshared L[10000] 1 elems 10000 times at 0 (var)
# Note here the iteration count is not present.
#

namespace eval perf::compare {
    # List of dictionaries, one per input file
    variable PerfData
}

proc perf::compare::warn {message} {
    puts stderr "Warning: $message"
}
proc perf::compare::print {text} {
    puts stdout $text
}
proc perf::compare::slurp {testrun_path} {
    variable PerfData

    set runtimes [dict create]

    set path [file normalize $testrun_path]
    set fd [open $path]
    array set header {}
    while {[gets $fd line] >= 0} {
        set line [regsub -all {\s+} [string trim $line] " "]
        switch -glob -- $line {
            "#*" {
                # Skip comments
            }
            "R *" -
            "L *" -
            "D *" -
            "V *" -
            "T *" -
            "E *" {
                set marker [lindex $line 0]
                if {[info exists header($marker)]} {
                    warn "Ignoring $marker record (duplicate): \"$line\""
                }
                set header($marker) [string range $line 2 end]
            }
            "P *" {
                if {[scan $line "P %f %n" runtime id_start] == 2} {
                    set id [string range $line $id_start end]
                    if {[dict exists $runtimes $id]} {
                        warn "Ignoring duplicate test id \"$id\""
                    } else {
                        dict set runtimes $id $runtime
                    }
                } else {
                    warn "Invalid test result line format: \"$line\""
                }
            }
            default {
                puts stderr "Warning: ignoring unrecognized line \"$line\""
            }
        }
    }
    close $fd

    set result [dict create Input $path Runtimes $runtimes]
    foreach {c k} {
        L Label
        V Version
        E Executable
        D Description
    } {
        if {[info exists header($c)]} {
            dict set result $k $header($c)
        }
    }

    return $result
}

proc perf::compare::burp {test_sets} {
    variable Options

    # Print the key for each test run
    set header "           "
    set separator "           "
    foreach test_set $test_sets {
        set test_set_key "\[[incr test_set_num]\]"
        if {! $Options(--no-header)} {
            print "$test_set_key"
            foreach k {Label Executable Version Input Description} {
                if {[dict exists $test_set $k]} {
                    print "$k: [dict get $test_set $k]"
                }
            }
        }
        append header $test_set_key $separator
        set separator "                 "; # Expand because later columns have ratio
    }
    set header [string trimright $header]

    if {! $Options(--no-header)} {
        print ""
        if {$Options(--ratio) eq "rate"} {
            set ratio_description "ratio of baseline to the measurement (higher is faster)."
        } else {
            set ratio_description "ratio of measurement to the baseline (lower is faster)."
        }
        print "The first column \[1\] is the baseline measurement."
        print "Subsequent columns are pairs of the additional measurement and "
        print $ratio_description
        print ""
    }

    # Print the actual test run data

    print $header
    set test_sets [lassign $test_sets base_set]
    set fmt {%#10.5f}
    set fmt_ratio {%-6.2f}
    foreach {id base_runtime} [dict get $base_set Runtimes] {
        if {[info exists Options(--regexp)]} {
            if {![regexp $Options(--regexp) $id]} {
                continue
            }
        }
        if {$Options(--print-test-number)} {
            set line "[format %-4s [incr counter].]"
        } else {
            set line ""
        }
        append line [format $fmt $base_runtime]
        foreach test_set $test_sets {
            if {[dict exists $test_set Runtimes $id]} {
                set runtime [dict get $test_set Runtimes $id]
                if {$Options(--ratio) eq "time"} {
                    if {$base_runtime != 0} {
                        set ratio [format $fmt_ratio [expr {$runtime/$base_runtime}]]
                    } else {
                        if {$runtime == 0} {
                            set ratio "NaN   "
                        } else {
                            set ratio "Inf   "
                        }
                    }
                } else {
                    if {$runtime != 0} {
                        set ratio [format $fmt_ratio [expr {$base_runtime/$runtime}]]
                    } else {
                        if {$base_runtime == 0} {
                            set ratio "NaN   "
                        } else {
                            set ratio "Inf   "
                        }
                    }
                }
                append line "|" [format $fmt $runtime] "|" $ratio
            } else {
                append line [string repeat { } 11]
            }
        }
        append line "|" $id
        print $line
    }
}

proc perf::compare::chew {test_sets} {
    variable Options

    # Combine test sets that have the same label, averaging the values
    set unlabeled_sets {}
    array set labeled_sets {}

    foreach test_set $test_sets {
        # If there is no label, treat as independent set
        if {![dict exists $test_set Label]} {
            lappend unlabeled_sets $test_set
        } else {
            lappend labeled_sets([dict get $test_set Label]) $test_set
        }
    }

    foreach label [array names labeled_sets] {
        set combined_set [lindex $labeled_sets($label) 0]
        set runtimes [dict get $combined_set Runtimes]
        foreach test_set [lrange $labeled_sets($label) 1 end] {
            dict for {id timing} [dict get $test_set Runtimes] {
                dict lappend runtimes $id $timing
            }
        }
        dict for {id timings} $runtimes {
            set total [tcl::mathop::+ {*}$timings]
            dict set runtimes $id [expr {$total/[llength $timings]}]
        }
        dict set combined_set Runtimes $runtimes
        set labeled_sets($label) $combined_set
    }

    # Choose the "base" test set
    if {![info exists Options(--base)]} {
        set first_set [lindex $test_sets 0]
        if {[dict exists $first_set Label]} {
            # Use label of first as the base
            set Options(--base) [dict get $first_set Label]
        }
    }

    if {[info exists Options(--base)] && $Options(--base) ne ""} {
        lappend combined_sets $labeled_sets($Options(--base));# Will error if no such
        unset labeled_sets($Options(--base))
    } else {
        lappend combined_sets [lindex $unlabeled_sets 0]
        set unlabeled_sets [lrange $unlabeled_sets 1 end]
    }
    foreach label [array names labeled_sets] {
        lappend combined_sets $labeled_sets($label)
    }
    lappend combined_sets {*}$unlabeled_sets

    return $combined_sets
}

proc perf::compare::setup {argv} {
    variable Options

    array set Options {
        --ratio rate
        --combine 0
        --print-test-number 0
        --no-header 0
    }
    while {[llength $argv]} {
        set argv [lassign $argv arg]
        switch -glob -- $arg {
            -r -
            --regexp {
                if {[llength $argv] == 0} {
                    error "Missing value for option $arg"
                }
                set argv [lassign $argv val]
                set Options(--regexp) $val
            }
            --ratio {
                if {[llength $argv] == 0} {
                    error "Missing value for option $arg"
                }
                set argv [lassign $argv val]
                if {$val ni {time rate}} {
                    error "Value for option $arg must be either \"time\" or \"rate\""
                }
                set Options(--ratio) $val
            }
            --print-test-number -
            --combine -
            --no-header {
                set Options($arg) 1
            }
            --base {
                if {[llength $argv] == 0} {
                    error "Missing value for option $arg"
                }
                set argv [lassign $argv val]
                set Options($arg) $val
            }
            -- {
                # Remaining will be passed back to the caller
                break
            }
            --* {
                error "Unknown option $arg"
            }
            -* {
                error "Unknown option -[lindex $arg 0]"
            }
            default {
                # Remaining will be passed back to the caller
                set argv [linsert $argv 0 $arg]
                break;
            }
        }
    }

    set paths {}
    foreach path $argv {
        set path [file join $path]; # Convert from native else glob fails
        if {[file isfile $path]} {
            lappend paths $path
            continue
        }
        if {[file isfile $path.perf]} {
            lappend paths $path.perf
            continue
        }
        lappend paths {*}[glob -nocomplain $path]
    }
    return $paths
}
proc perf::compare::main {} {
    variable Options

    set paths [setup $::argv]
    if {[llength $paths] == 0} {
        error "No test data files specified."
    }
    set test_data [list ]
    set seen [dict create]
    foreach path $paths {
        if {![dict exists $seen $path]} {
            lappend test_data [slurp $path]
            dict set seen $path ""
        }
    }

    if {$Options(--combine)} {
        set test_data [chew $test_data]
    }

    burp $test_data
}

perf::compare::main
Added tests-perf/listPerf.tcl.




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
#!/usr/bin/tclsh
# ------------------------------------------------------------------------
#
# listPerf.tcl --
#
#  This file provides performance tests for list operations.
#
# ------------------------------------------------------------------------
#
# See the file "license.terms" for information on usage and redistribution
# of this file.
#
# Note: this file does not use the test-performance.tcl framework as we want
# more direct control over timerate options.

catch {package require twapi}

namespace eval perf::list {
    variable perfScript [file normalize [info script]]

    # Test for each of these lengths
    variable Lengths {10 100 1000 10000}

    variable RunTimes
    set RunTimes(command) 0.0
    set RunTimes(total) 0.0

    variable Options
    array set Options {
        --print-comments   0
        --print-iterations 0
    }

    # Procs used for calibrating overhead
    proc proc2args {a b} {}
    proc proc3args {a b c} {}

    proc print {s} {
        puts $s
    }
    proc print_usage {} {
        puts stderr "Usage: [file tail [info nameofexecutable]] $::argv0 \[options\] \[command ...\]"
        puts stderr "\t--description DESC\tHuman readable description of test run"
        puts stderr "\t--label LABEL\tA label used to identify test environment"
        puts stderr "\t--print-comments\tPrint comment for each test"
        puts stderr "\t--print-iterations\tPrint number of iterations run for each test"
    }

    proc setup {argv} {
        variable Options
        variable Lengths

        while {[llength $argv]} {
            set argv [lassign $argv arg]
            switch -glob -- $arg {
                --print-comments -
                --print-iterations {
                    set Options($arg) 1
                }
                --label -
                --description {
                    if {[llength $argv] == 0} {
                        error "Missing value for option $arg"
                    }
                    set argv [lassign $argv val]
                    set Options($arg) $val
                }
                --lengths {
                    if {[llength $argv] == 0} {
                        error "Missing value for option $arg"
                    }
                    set argv [lassign $argv val]
                    set Lengths $val
                }
                -- {
                    # Remaining will be passed back to the caller
                    break
                }
                --* {
                    error "Unknown option $arg"
                }
                default {
                    # Remaining will be passed back to the caller
                    set argv [linsert $argv 0 $arg]
                    break;
                }
            }
        }

        return $argv
    }
    proc format_timings {us iters} {
        variable Options
        if {!$Options(--print-iterations)} {
            return "[format {%#10.4f} $us]"
        }
        return "[format {%#10.4f} $us] [format {%8d} $iters]"
    }
    proc measure {id script args} {
        variable NullOverhead
        variable RunTimes
        variable Options

        set opts(-overhead) ""
        set opts(-runs) 5
        while {[llength $args]} {
            set args [lassign $args opt]
            if {[llength $args] == 0} {
                error "No argument supplied for $opt option. Test: $id"
            }
            set args [lassign $args val]
            switch $opt {
                -setup -
                -cleanup -
                -overhead -
                -time -
                -runs -
                -reps {
                    set opts($opt) $val
                }
                default {
                    error "Unknown option $opt. Test: $id"
                }
            }
        }

        set timerate_args {}
        if {[info exists opts(-time)]} {
            lappend timerate_args $opts(-time)
        }
        if {[info exists opts(-reps)]} {
            if {[info exists opts(-time)]} {
                set timerate_args [list $opts(-time) $opts(-reps)]
            } else {
                # Force the default for first time option
                set timerate_args [list 1000 $opts(-reps)]
            }
        } elseif {[info exists opts(-time)]} {
            set timerate_args [list $opts(-time)]
        }
        if {[info exists opts(-setup)]} {
            uplevel 1 $opts(-setup)
        }
        # Cache the empty overhead to prevent unnecessary delays. Note if you modify
        # to cache other scripts, the cache key must be AFTER substituting the
        # overhead script in the caller's context.
        if {$opts(-overhead) eq ""} {
            if {![info exists NullOverhead]} {
                set NullOverhead [lindex [timerate {}] 0]
            }
            set overhead_us $NullOverhead
        } else {
            # The overhead measurements might use setup so we need to setup
            # first and then cleanup in preparation for setting up again for
            # the script to be measured
            if {[info exists opts(-setup)]} {
                uplevel 1 $opts(-setup)
            }
            set overhead_us [lindex [uplevel 1 [list timerate $opts(-overhead)]] 0]
            if {[info exists opts(-cleanup)]} {
                uplevel 1 $opts(-cleanup)
            }
        }
        set timings {}
        for {set i 0} {$i < $opts(-runs)} {incr i} {
            if {[info exists opts(-setup)]} {
                uplevel 1 $opts(-setup)
            }
            lappend timings [uplevel 1 [list timerate -overhead $overhead_us $script {*}$timerate_args]]
            if {[info exists opts(-cleanup)]} {
                uplevel 1 $opts(-cleanup)
            }
        }
        set timings [lsort -real -index 0 $timings]
        if {$opts(-runs) > 15} {
            set ignore [expr {$opts(-runs)/8}]
        } elseif {$opts(-runs) >= 5} {
            set ignore 2
        } else {
            set ignore 0
        }
        # Ignore highest and lowest
        set timings [lrange $timings 0 end-$ignore]
        # Average it out
        set us 0
        set iters 0
        foreach timing $timings {
            set us [expr {$us + [lindex $timing 0]}]
            set iters [expr {$iters + [lindex $timing 2]}]
        }
        set us [expr {$us/[llength $timings]}]
        set iters [expr {$iters/[llength $timings]}]

        set RunTimes(command) [expr {$RunTimes(command) + $us}]
        print "P [format_timings $us $iters] $id"
    }
    proc comment {args} {
        variable Options
        if {$Options(--print-comments)} {
            print "# [join $args { }]"
        }
    }
    proc spanned_list {len} {
        # Note - for small len, this will not create a spanned list
        set delta [expr {$len/8}]
        return [lrange [lrepeat [expr {$len+(2*$delta)}] a] $delta [expr {$delta+$len-1}]]
    }
    proc print_separator {command} {
        comment [string repeat = 80]
        comment Command: $command
    }

    oo::class create ListPerf {
        constructor {args} {
            my variable Opts
            # Note default Opts can be overridden in construct as well as in measure
            set Opts [dict merge {
                -setup {
                    set L [lrepeat $len a]
                    set Lspan [perf::list::spanned_list $len]
                } -cleanup {
                    unset -nocomplain L
                    unset -nocomplain Lspan
                    unset -nocomplain L2
                }
            } $args]
        }
        method measure {comment script locals args} {
            my variable Opts
            dict with locals {}
            ::perf::list::measure $comment $script {*}[dict merge $Opts $args]
        }
        method option {opt val} {
            my variable Opts
            dict set Opts $opt $val
        }
        method option_unset {opt} {
            my variable Opts
            unset -nocomplain Opts($opt)
        }
    }

    proc linsert_describe {share_mode len at num iters} {
        return "linsert L\[$len\] $share_mode $num elems $iters times at $at"
    }
    proc linsert_perf {} {
        variable Lengths

        print_separator linsert

        ListPerf create perf -overhead {set L {}} -time 1000

        # Note: Const indices take different path through bytecode than variable
        # indices hence separate cases below


        # Var case
        foreach share_mode {shared unshared} {
            set idx 0
            if {$share_mode eq "shared"} {
                comment == Insert into empty lists
                comment Insert one element into empty list
                measure [linsert_describe shared 0 "0 (var)" 1 1] {linsert $L $idx ""} -setup {set idx 0; set L {}}
            } else {
                comment == Insert into empty lists
                comment Insert one element into empty list
                measure [linsert_describe unshared 0 "0 (var)" 1 1] {linsert {} $idx ""} -setup {set idx 0}
            }
            foreach idx_str [list 0 1 mid end-1 end] {
                foreach len $Lengths {
                    if {$idx_str eq "mid"} {
                        set idx [expr {$len/2}]
                    } else {
                        set idx $idx_str
                    }
                    # perf option -reps $reps
                    set reps 1000
                    if {$share_mode eq "shared"} {
                        comment Insert once to shared list with variable index
                        perf measure [linsert_describe shared $len "$idx (var)" 1 1] \
                            {linsert $L $idx x} [list len $len idx $idx] -overhead {} -reps 100000

                        comment Insert multiple times to shared list with variable index
                        perf measure [linsert_describe shared $len "$idx (var)" 1 $reps] {
                            set L [linsert $L $idx X]
                        } [list len $len idx $idx] -reps $reps

                        comment Insert multiple items multiple times to shared list with variable index
                        perf measure [linsert_describe shared $len "$idx (var)" 5 $reps] {
                            set L [linsert $L $idx X X X X X]
                        } [list len $len idx $idx] -reps $reps
                    } else {
                        # NOTE : the Insert once case is left out for unshared lists
                        # because it requires re-init on every iteration resulting
                        # in a lot of measurement noise
                        comment Insert multiple times to unshared list with variable index
                        perf measure [linsert_describe unshared $len "$idx (var)" 1 $reps] {
                            set L [linsert $L[set L {}] $idx X]
                        } [list len $len idx $idx] -reps $reps
                        comment Insert multiple items multiple times to unshared list with variable index
                        perf measure [linsert_describe unshared $len "$idx (var)" 5 $reps] {
                            set L [linsert $L[set L {}] $idx X X X X X]
                        } [list len $len idx $idx] -reps $reps
                    }
                }
            }
        }

        # Const index
        foreach share_mode {shared unshared} {
            if {$share_mode eq "shared"} {
                comment == Insert into empty lists
                comment Insert one element into empty list
                measure [linsert_describe shared 0 "0 (const)" 1 1] {linsert $L 0 ""} -setup {set L {}}
            } else {
                comment == Insert into empty lists
                comment Insert one element into empty list
                measure [linsert_describe unshared 0 "0 (const)" 1 1] {linsert {} 0 ""}
            }
            foreach idx_str [list 0 1 mid end end-1] {
                foreach len $Lengths {
                    # Note end, end-1 explicitly calculated as otherwise they
                    # are not treated as const
                    if {$idx_str eq "mid"} {
                        set idx [expr {$len/2}]
                    } elseif {$idx_str eq "end"} {
                        set idx [expr {$len-1}]
                    } elseif {$idx_str eq "end-1"} {
                        set idx [expr {$len-2}]
                    } else {
                        set idx $idx_str
                    }
                    #perf option -reps $reps
                    set reps 100
                    if {$share_mode eq "shared"} {
                        comment Insert once to shared list with const index
                        perf measure [linsert_describe shared $len "$idx (const)" 1 1] \
                            "linsert \$L $idx x" [list len $len] -overhead {} -reps 10000

                        comment Insert multiple times to shared list with const index
                        perf measure [linsert_describe shared $len "$idx (const)" 1 $reps] \
                            "set L \[linsert \$L $idx X\]" [list len $len] -reps $reps

                        comment Insert multiple items multiple times to shared list with const index
                        perf measure [linsert_describe shared $len "$idx (const)" 5 $reps] \
                            "set L \[linsert \$L $idx X X X X X\]" [list len $len] -reps $reps
                    } else {
                        comment Insert multiple times to unshared list with const index
                        perf measure [linsert_describe unshared $len "$idx (const)" 1 $reps] \
                            "set L \[linsert \$L\[set L {}\] $idx X]" [list len $len] -reps $reps

                        comment Insert multiple items multiple times to unshared list with const index
                        perf measure [linsert_describe unshared $len "$idx (const)" 5 $reps] \
                            "set L \[linsert \$L\[set L {}\] $idx X X X X X]" [list len $len] -reps $reps
                    }
                }
            }
        }

        # Note: no span tests because the inserts above will themselves create
        # spanned lists

        perf destroy
    }

    proc list_describe {len text} {
        return "list L\[$len\] $text"
    }
    proc list_perf {} {
        variable Lengths

        print_separator list

        ListPerf create perf
        foreach len $Lengths {
            set s [join [lrepeat $len x]]
            comment Create a list from a string
            perf measure [list_describe $len "from a string"] {list $s} [list s $s len $len]
        }
        foreach len $Lengths {
            comment Create a list from expansion - single list (special optimal case)
            perf measure [list_describe $len "from a {*}list"] {list {*}$L} [list len $len]
            comment Create a list from two lists - real test of expansion speed
            perf measure [list_describe $len "from a {*}list {*}list"] {list {*}$L {*}$L} [list len [expr {$len/2}]]
        }
    }

    proc lappend_describe {share_mode len num iters} {
        return "lappend L\[$len\] $share_mode $num elems $iters times"
    }
    proc lappend_perf {} {
        variable Lengths

        print_separator lappend

        ListPerf create perf -setup {set L [lrepeat [expr {$len/4}] x]}

        # Shared
        foreach len $Lengths {
            comment Append to a shared list variable multiple times
            perf measure [lappend_describe shared [expr {$len/2}] 1 $len] {
                set L2 $L; # Make shared
                lappend L x
            } [list len $len] -reps $len -overhead {set L2 $L}
        }

        # Unshared
        foreach len $Lengths {
            comment Append to a unshared list variable multiple times
            perf measure [lappend_describe unshared [expr {$len/2}] 1 $len] {
                lappend L x
            } [list len $len] -reps $len
        }

        # Span
        foreach len $Lengths {
            comment Append to a unshared-span list variable multiple times
            perf measure [lappend_describe unshared-span [expr {$len/2}] 1 $len] {
                lappend Lspan x
            } [list len $len] -reps $len
        }

        perf destroy
    }

    proc lpop_describe {share_mode len at reps} {
        return "lpop L\[$len\] $share_mode at $at $reps times"
    }
    proc lpop_perf {} {
        variable Lengths

        print_separator lpop

        ListPerf create perf

        # Shared
        perf option -overhead {set L2 $L}
        foreach len $Lengths {
            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
            foreach idx {0 1 end-1 end}  {
                comment Pop element at position $idx from a shared list variable
                perf measure [lpop_describe shared $len $idx $reps] {
                    set L2 $L
                    lpop L $idx
                } [list len $len idx $idx] -reps $reps
            }
        }

        # Unshared
        perf option -overhead {}
        foreach len $Lengths {
            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
            foreach idx {0 1 end-1 end}  {
                comment Pop element at position $idx from an unshared list variable
                perf measure [lpop_describe unshared $len $idx $reps] {
                    lpop L $idx
                } [list len $len idx $idx] -reps $reps
            }
        }

        perf destroy

        # Nested
        ListPerf create perf -setup {
            set L [lrepeat $len [list a b]]
        }

        # Shared, nested index
        perf option -overhead {set L2 $L; set L L2}
        foreach len $Lengths {
            set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
            foreach idx {0 1 end-1 end}  {
                perf measure [lpop_describe shared $len "{$idx 0}" $reps] {
                    set L2 $L
                    lpop L $idx 0
                    set L $L2
                } [list len $len idx $idx] -reps $reps
            }
        }

        # TODO - Nested Unshared
        # Not sure how to measure performance. When unshared there is no copy
        # so deleting a nested index repeatedly is not feasible

        perf destroy
    }

    proc lassign_describe {share_mode len num reps} {
        return "lassign L\[$len\] $share_mode $num elems $reps times"
    }
    proc lassign_perf {} {
        variable Lengths

        print_separator lassign

        ListPerf create perf

        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                if {$share_mode eq "shared"} {
                    set reps 1000
                    comment Reflexive lassign - shared
                    perf measure [lassign_describe shared $len 1 $reps] {
                        set L2 $L
                        set L2 [lassign $L2 v]
                    } [list len $len] -overhead {set L2 $L} -reps $reps

                    comment Reflexive lassign - shared, multiple
                    perf measure [lassign_describe shared $len 5 $reps] {
                        set L2 $L
                        set L2 [lassign $L2 a b c d e]
                    } [list len $len] -overhead {set L2 $L} -reps $reps
                } else {
                    set reps [expr {($len >= 1000 ? ($len/2) : $len) - 2}]
                    comment Reflexive lassign - unshared
                    perf measure [lassign_describe unshared $len 1 $reps] {
                        set L [lassign $L v]
                    } [list len $len] -reps $reps
                }
            }
        }
        perf destroy
    }

    proc lrepeat_describe {len num} {
        return "lrepeat L\[$len\] $num elems at a time"
    }
    proc lrepeat_perf {} {
        variable Lengths

        print_separator lrepeat

        ListPerf create perf -reps 100000
        foreach len $Lengths {
            comment Generate a list from a single repeated element
            perf measure [lrepeat_describe $len 1] {
                lrepeat $len a
            } [list len $len]

            comment Generate a list from multiple repeated elements
            perf measure [lrepeat_describe $len 5] {
                lrepeat $len a b c d e
            } [list len $len]
        }

        perf destroy
    }

    proc lreverse_describe {share_mode len} {
        return "lreverse L\[$len\] $share_mode"
    }
    proc lreverse_perf {} {
        variable Lengths

        print_separator lreverse

        ListPerf create perf -reps 10000

        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                if {$share_mode eq "shared"} {
                    comment Reverse a shared list
                    perf measure [lreverse_describe shared $len] {
                        lreverse $L
                    } [list len $len]

                    if {$len > 100} {
                        comment Reverse a shared-span list
                        perf measure [lreverse_describe shared-span $len] {
                            lreverse $Lspan
                        } [list len $len]
                    }
                } else {
                    comment Reverse a unshared list
                    perf measure [lreverse_describe unshared $len] {
                        set L [lreverse $L[set L {}]]
                    } [list len $len] -overhead {set L $L; set L {}}

                    if {$len >= 100} {
                        comment Reverse a unshared-span list
                        perf measure [lreverse_describe unshared-span $len] {
                            set Lspan [lreverse $Lspan[set Lspan {}]]
                        } [list len $len] -overhead {set Lspan $Lspan; set Lspan {}}
                    }
                }
            }
        }

        perf destroy
    }

    proc llength_describe {share_mode len} {
        return "llength L\[$len\] $share_mode"
    }
    proc llength_perf {} {
        variable Lengths

        print_separator llength

        ListPerf create perf -reps 100000

        foreach len $Lengths {
            comment Length of a list
            perf measure [llength_describe shared $len] {
                llength $L
            } [list len $len]

            if {$len >= 100} {
                comment Length of a span list
                perf measure [llength_describe shared-span $len] {
                    llength $Lspan
                } [list len $len]
            }
        }

        perf destroy
    }

    proc lindex_describe {share_mode len at} {
        return "lindex L\[$len\] $share_mode at $at"
    }
    proc lindex_perf {} {
        variable Lengths

        print_separator lindex

        ListPerf create perf -reps 100000

        foreach len $Lengths {
            comment Index into a list
            set idx [expr {$len/2}]
            perf measure [lindex_describe shared $len $idx] {
                lindex $L $idx
            } [list len $len idx $idx]

            if {$len >= 100} {
                comment Index into a span list
                perf measure [lindex_describe shared-span $len $idx] {
                    lindex $Lspan $idx
                } [list len $len idx $idx]
            }
        }

        perf destroy
    }

    proc lrange_describe {share_mode len range} {
        return "lrange L\[$len\] $share_mode range $range"
    }

    proc lrange_perf {} {
        variable Lengths

        print_separator lrange

        ListPerf create perf -time 1000 -reps 100000

        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                set eighth [expr {$len/8}]
                set ranges [list \
                                [list 0 0]  [list 0 end-1] \
                                [list $eighth [expr {3*$eighth}]] \
                                [list $eighth [expr {7*$eighth}]] \
                                [list 1 end] [list end-1 end] \
                               ]
                foreach range $ranges {
                    comment Range $range in $share_mode list of length $len
                    if {$share_mode eq "shared"} {
                        perf measure [lrange_describe shared $len $range] \
                            "lrange \$L $range" [list len $len range $range]
                    } else {
                        perf measure [lrange_describe unshared $len $range] \
                            "lrange \[lrepeat \$len\ a] $range" \
                            [list len $len range $range] -overhead {lrepeat $len a}
                    }
                }

                if {$len >= 100} {
                    foreach range $ranges {
                        comment Range $range in ${share_mode}-span list of length $len
                        if {$share_mode eq "shared"} {
                            perf measure [lrange_describe shared-span $len $range] \
                                "lrange \$Lspan {*}$range" [list len $len range $range]
                        } else {
                            perf measure [lrange_describe unshared-span $len $range] \
                                "lrange \[perf::list::spanned_list \$len\] $range" \
                                [list len $len range $range] -overhead {perf::list::spanned_list $len}
                        }
                    }
                }
            }
        }

        perf destroy
    }

    proc lset_describe {share_mode len at} {
        return "lset L\[$len\] $share_mode at $at"
    }
    proc lset_perf {} {
        variable Lengths

        print_separator lset

        ListPerf create perf -reps 10000

        # Shared
        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                foreach idx {0 1 end-1 end end+1}  {
                    comment lset at position $idx in a $share_mode list variable
                    if {$share_mode eq "shared"} {
                        perf measure [lset_describe shared $len $idx] {
                            set L2 $L
                            lset L $idx X
                        } [list len $len idx $idx] -overhead {set L2 $L}
                    } else {
                        perf measure [lset_describe unshared $len $idx] {
                            lset L $idx X
                        } [list len $len idx $idx]
                    }
                }
            }
        }

        perf destroy

        # Nested
        ListPerf create perf -setup {
            set L [lrepeat $len [list a b]]
        }

        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                foreach idx {0 1 end-1 end}  {
                    comment lset at position $idx in a $share_mode list variable
                    if {$share_mode eq "shared"} {
                        perf measure [lset_describe shared $len "{$idx 0}"] {
                            set L2 $L
                            lset L $idx 0 X
                        } [list len $len idx $idx] -overhead {set L2 $L}
                    } else {
                        perf measure [lset_describe unshared $len "{$idx 0}"] {
                            lset L $idx 0 {X Y}
                        } [list len $len idx $idx]
                    }
                }
            }
        }

        perf destroy
    }

    proc lremove_describe {share_mode len at nremoved} {
        return "lremove L\[$len\] $share_mode $nremoved elements at $at"
    }
    proc lremove_perf {} {
        variable Lengths

        print_separator lremove

        ListPerf create perf -reps 10000

        foreach share_mode {shared unshared} {
            foreach len $Lengths {
                foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
                    if {$share_mode eq "shared"} {
                        comment Remove one element from shared list
                        perf measure [lremove_describe shared $len $idx 1] \
                            {lremove $L $idx} [list len $len idx $idx]

                    } else {
                        comment Remove one element from unshared list
                        set reps [expr {$len >= 1000 ? ($len/8) : ($len-2)}]
                        perf measure [lremove_describe unshared $len $idx 1] \
                            {set L [lremove $L[set L {}] $idx]} [list len $len idx $idx] \
                            -overhead {set L $L; set L {}} -reps $reps
                    }
                }
                if {$share_mode eq "shared"} {
                    comment Remove multiple elements from shared list
                    perf measure [lremove_describe shared $len [list 0 1 [expr {$len/2}] end-1 end] 5] {
                        lremove $L 0 1 [expr {$len/2}] end-1 end
                    } [list len $len]
                }
            }
            # Span
            foreach len $Lengths {
                foreach idx [list 0 1 [expr {$len/2}] end-1 end] {
                    if {$share_mode eq "shared"} {
                        comment Remove one element from shared-span list
                        perf measure [lremove_describe shared-span $len $idx 1] \
                            {lremove $Lspan $idx} [list len $len idx $idx]
                    } else {
                        comment Remove one element from unshared-span list
                        set reps [expr {$len >= 1000 ? ($len/8) : ($len-2)}]
                        perf measure [lremove_describe unshared-span $len $idx 1] \
                            {set Lspan [lremove $Lspan[set Lspan {}] $idx]} [list len $len idx $idx] \
                            -overhead {set Lspan $Lspan; set Lspan {}} -reps $reps
                    }
                }
                if {$share_mode eq "shared"} {
                    comment Remove multiple elements from shared-span list
                    perf measure [lremove_describe shared-span $len [list 0 1 [expr {$len/2}] end-1 end] 5] {
                        lremove $Lspan 0 1 [expr {$len/2}] end-1 end
                    } [list len $len]
                }
            }
        }

        perf destroy
    }

    proc lreplace_describe {share_mode len first last ninsert {times 1}} {
        if {$last < $first} {
            return "lreplace L\[$len\] $share_mode 0 ($first:$last) elems at $first with $ninsert elems $times times."
        }
        return "lreplace L\[$len\] $share_mode $first:$last with $ninsert elems $times times."
    }
    proc lreplace_perf {} {
        variable Lengths

        print_separator lreplace

        set default_reps 10000
        ListPerf create perf -reps $default_reps

        foreach share_mode {shared unshared} {
            # Insert only
            foreach len $Lengths {
                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
                foreach first [list 0 1 [expr {$len/2}] end-1 end] {
                    if {$share_mode eq "shared"} {
                        comment Insert one to shared list
                        perf measure [lreplace_describe shared $len $first -1 1] {
                            lreplace $L $first -1 x
                        } [list len $len first $first]

                        comment Insert multiple to shared list
                        perf measure [lreplace_describe shared $len $first -1 10] {
                            lreplace $L $first -1 X X X X X X X X X X
                        } [list len $len first $first]

                        comment Insert one to shared list repeatedly
                        perf measure [lreplace_describe shared $len $first -1 1 $reps] {
                            set L [lreplace $L $first -1 x]
                        } [list len $len first $first] -reps $reps

                        comment Insert multiple to shared list repeatedly
                        perf measure [lreplace_describe shared $len $first -1 10 $reps] {
                            set L [lreplace $L $first -1 X X X X X X X X X X]
                        } [list len $len first $first] -reps $reps

                    } else {
                        comment Insert one to unshared list
                        perf measure [lreplace_describe unshared $len $first -1 1] {
                            set L [lreplace $L[set L {}] $first -1 x]
                        } [list len $len first $first] -overhead {
                            set L $L; set L {}
                        } -reps $reps

                        comment Insert multiple to unshared list
                        perf measure [lreplace_describe unshared $len $first -1 10] {
                            set L [lreplace $L[set L {}] $first -1 X X X X X X X X X X]
                        } [list len $len first $first] -overhead {
                            set L $L; set L {}
                        } -reps $reps
                    }
                }
            }

            # Delete only
            foreach len $Lengths {
                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
                foreach first [list 0 1 [expr {$len/2}] end-1 end] {
                    if {$share_mode eq "shared"} {
                        comment Delete one from shared list
                        perf measure [lreplace_describe shared $len $first $first 0] {
                            lreplace $L $first $first
                        } [list len $len first $first]
                    } else {
                        comment Delete one from unshared list
                        perf measure [lreplace_describe unshared $len $first $first 0] {
                            set L [lreplace $L[set L {}] $first $first x]
                        } [list len $len first $first] -overhead {
                            set L $L; set L {}
                        } -reps $reps
                    }
                }
            }

            # Insert + delete
            foreach len $Lengths {
                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
                foreach range [list {0 1} {1 2} {end-2 end-1} {end-1 end}] {
                    lassign $range first last
                    if {$share_mode eq "shared"} {
                        comment Insertions more than deletions from shared list
                        perf measure [lreplace_describe shared $len $first $last 3] {
                            lreplace $L $first $last X Y Z
                        } [list len $len first $first last $last]

                        comment Insertions same as deletions from shared list
                        perf measure [lreplace_describe shared $len $first $last 2] {
                            lreplace $L $first $last X Y
                        } [list len $len first $first last $last]

                        comment Insertions fewer than deletions from shared list
                        perf measure [lreplace_describe shared $len $first $last 1] {
                            lreplace $L $first $last X
                        } [list len $len first $first last $last]
                    } else {
                        comment Insertions more than deletions from unshared list
                        perf measure [lreplace_describe unshared $len $first $last 3] {
                            set L [lreplace $L[set L {}] $first $last X Y Z]
                        } [list len $len first $first last $last] -overhead {
                            set L $L; set L {}
                        } -reps $reps

                        comment Insertions same as deletions from unshared list
                        perf measure [lreplace_describe unshared $len $first $last 2] {
                            set L [lreplace $L[set L {}] $first $last X Y ]
                        } [list len $len first $first last $last] -overhead {
                            set L $L; set L {}
                        } -reps $reps

                        comment Insertions fewer than deletions from unshared list
                        perf measure [lreplace_describe unshared $len $first $last 1] {
                            set L [lreplace $L[set L {}] $first $last X]
                        } [list len $len first $first last $last] -overhead {
                            set L $L; set L {}
                        } -reps $reps
                    }
                }
            }
            # Spanned Insert + delete
            foreach len $Lengths {
                set reps [expr {$len <= 100 ? ($len-2) : ($len/8)}]
                foreach range [list {0 1} {1 2} {end-2 end-1} {end-1 end}] {
                    lassign $range first last
                    if {$share_mode eq "shared"} {
                        comment Insertions more than deletions from shared-span list
                        perf measure [lreplace_describe shared-span $len $first $last 3] {
                            lreplace $Lspan $first $last X Y Z
                        } [list len $len first $first last $last]

                        comment Insertions same as deletions from shared-span list
                        perf measure [lreplace_describe shared-span $len $first $last 2] {
                            lreplace $Lspan $first $last X Y
                        } [list len $len first $first last $last]

                        comment Insertions fewer than deletions from shared-span list
                        perf measure [lreplace_describe shared-span $len $first $last 1] {
                            lreplace $Lspan $first $last X
                        } [list len $len first $first last $last]
                    } else {
                        comment Insertions more than deletions from unshared-span list
                        perf measure [lreplace_describe unshared-span $len $first $last 3] {
                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X Y Z]
                        } [list len $len first $first last $last] -overhead {
                            set Lspan $Lspan; set Lspan {}
                        } -reps $reps

                        comment Insertions same as deletions from unshared-span list
                        perf measure [lreplace_describe unshared-span $len $first $last 2] {
                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X Y ]
                        } [list len $len first $first last $last] -overhead {
                            set Lspan $Lspan; set Lspan {}
                        } -reps $reps

                        comment Insertions fewer than deletions from unshared-span list
                        perf measure [lreplace_describe unshared-span $len $first $last 1] {
                            set Lspan [lreplace $Lspan[set Lspan {}] $first $last X]
                        } [list len $len first $first last $last] -overhead {
                            set Lspan $Lspan; set Lspan {}
                        } -reps $reps
                    }
                }
            }
        }

        perf destroy
    }

    proc split_describe {len} {
        return "split L\[$len\]"
    }
    proc split_perf {} {
        variable Lengths
        print_separator split

        ListPerf create perf -setup {set S [string repeat "x " $len]}
        foreach len $Lengths {
            comment Split a string
            perf measure [split_describe $len] {
                split $S " "
            } [list len $len]
        }
    }

    proc join_describe {share_mode len} {
        return "join L\[$len\] $share_mode"
    }
    proc join_perf {} {
        variable Lengths

        print_separator join

        ListPerf create perf -reps 10000
        foreach len $Lengths {
            comment Join a list
            perf measure [join_describe shared $len] {
                join $L
            } [list len $len]
        }
        foreach len $Lengths {
            comment Join a spanned list
            perf measure [join_describe shared-span $len] {
                join $Lspan
            } [list len $len]
        }
        perf destroy
    }

    proc lsearch_describe {share_mode len} {
        return "lsearch L\[$len\] $share_mode"
    }
    proc lsearch_perf {} {
        variable Lengths

        print_separator lsearch

        ListPerf create perf -reps 100000
        foreach len $Lengths {
            comment Search a list
            perf measure [lsearch_describe shared $len] {
                lsearch $L needle
            } [list len $len]
        }
        foreach len $Lengths {
            comment Search a spanned list
            perf measure [lsearch_describe shared-span $len] {
                lsearch $Lspan needle
            } [list len $len]
        }
        perf destroy
    }

    proc foreach_describe {share_mode len} {
        return "foreach L\[$len\] $share_mode"
    }
    proc foreach_perf {} {
        variable Lengths

        print_separator foreach

        ListPerf create perf -reps 10000
        foreach len $Lengths {
            comment Iterate through a list
            perf measure [foreach_describe shared $len] {
                foreach e $L {}
            } [list len $len]
        }
        foreach len $Lengths {
            comment Iterate a spanned list
            perf measure [foreach_describe shared-span $len] {
                foreach e $Lspan {}
            } [list len $len]
        }
        perf destroy
    }

    proc lmap_describe {share_mode len} {
        return "lmap L\[$len\] $share_mode"
    }
    proc lmap_perf {} {
        variable Lengths

        print_separator lmap

        ListPerf create perf -reps 10000
        foreach len $Lengths {
            comment Iterate through a list
            perf measure [lmap_describe shared $len] {
                lmap e $L {}
            } [list len $len]
        }
        foreach len $Lengths {
            comment Iterate a spanned list
            perf measure [lmap_describe shared-span $len] {
                lmap e $Lspan {}
            } [list len $len]
        }
        perf destroy
    }

    proc get_sort_sample {{spanned 0}} {
        variable perfScript
        variable sortSampleText

        if {![info exists sortSampleText]} {
            set fd [open $perfScript]
            set sortSampleText [split [read $fd] ""]
            close $fd
        }
        set sortSampleText [string range $sortSampleText 0 9999]

        # NOTE: do NOT cache list result in a variable as we need it unshared
        if {$spanned} {
            return [lrange [split $sortSampleText ""] 1 end-1]
        } else {
            return [split $sortSampleText ""]
        }
    }
    proc lsort_describe {share_mode len} {
        return "lsort L\[$len] $share_mode"
    }
    proc lsort_perf {} {
        print_separator lsort

        ListPerf create perf -setup {}

        comment Sort a shared list
        perf measure [lsort_describe shared [llength [perf::list::get_sort_sample]]] {
            lsort $L
        } {} -setup {set L [perf::list::get_sort_sample]}

        comment Sort a shared-span list
        perf measure [lsort_describe shared-span [llength [perf::list::get_sort_sample 1]]] {
            lsort $L
        } {} -setup {set L [perf::list::get_sort_sample 1]}

        comment Sort an unshared list
        perf measure [lsort_describe unshared [llength [perf::list::get_sort_sample]]] {
            lsort [perf::list::get_sort_sample]
        } {} -overhead {perf::list::get_sort_sample}

        comment Sort an unshared-span list
        perf measure [lsort_describe unshared-span [llength [perf::list::get_sort_sample 1]]] {
            lsort [perf::list::get_sort_sample 1]
        } {} -overhead {perf::list::get_sort_sample 1}

        perf destroy
    }

    proc concat_describe {canonicality len elemlen} {
        return "concat L\[$len\] $canonicality with elements of length $elemlen"
    }
    proc concat_perf {} {
        variable Lengths

        print_separator concat

        ListPerf create perf -reps 100000

        foreach len $Lengths {
            foreach elemlen {1 100} {
                comment Pure lists (no string representation)
                perf measure [concat_describe "pure lists" $len $elemlen] {
                    concat $L $L
                } [list len $len elemlen $elemlen] -setup {
                    set L [lrepeat $len [string repeat a $elemlen]]
                }

                comment Canonical lists (with string representation)
                perf measure [concat_describe "canonical lists" $len $elemlen] {
                    concat $L $L
                } [list len $len elemlen $elemlen] -setup {
                    set L [lrepeat $len [string repeat a $elemlen]]
                    append x x $L; # Generate string while keeping internal rep list
                    unset x
                }

                comment Non-canonical lists
                perf measure [concat_describe "non-canonical lists" $len $elemlen] {
                    concat $L $L
                } [list len $len elemlen $elemlen] -setup {
                    set L [string repeat "[string repeat a $elemlen] " $len]
                    llength $L
                }
            }
        }

        # Span version
        foreach len $Lengths {
            foreach elemlen {1 100} {
                comment Pure span lists (no string representation)
                perf measure [concat_describe "pure spanned lists" $len $elemlen] {
                    concat $L $L
                } [list len $len elemlen $elemlen] -setup {
                    set L [lrange [lrepeat [expr {$len+2}] [string repeat a $elemlen]] 1 end-1]
                }

                comment Canonical span lists (with string representation)
                perf measure [concat_describe "canonical spanned lists" $len $elemlen] {
                    concat $L $L
                } [list len $len elemlen $elemlen] -setup {
                    set L [lrange [lrepeat [expr {$len+2}] [string repeat a $elemlen]] 1 end-1]
                    append x x $L; # Generate string while keeping internal rep list
                    unset x
                }
            }
        }

        perf destroy
    }

    proc test {} {
        variable RunTimes
        variable Options

        set selections [perf::list::setup $::argv]
        if {[llength $selections] == 0} {
            set commands [info commands ::perf::list::*_perf]
        } else {
            set commands [lmap sel $selections {
                if {$sel eq "help"} {
                    print_usage
                    continue
                }
                set cmd ::perf::list::${sel}_perf
                if {$cmd ni [info commands ::perf::list::*_perf]} {
                    puts stderr "Error: command $sel is not known or supported. Skipping."
                    continue
                }
                set cmd
            }]
        }
        comment Setting up
        timerate -calibrate {}
        if {[info exists Options(--label)]} {
            print "L $Options(--label)"
        }
        print "V [info patchlevel]"
        print "E [info nameofexecutable]"
        if {[info exists Options(--description)]} {
            print "D $Options(--description)"
        }
        set twapi_keys {-privatebytes -workingset -workingsetpeak}
        if {[info commands ::twapi::get_process_memory_info] ne ""} {
            set twapi_vm_pre [::twapi::get_process_memory_info]
        }
        foreach cmd [lsort -dictionary $commands] {
            set RunTimes(command) 0.0
            $cmd
            set RunTimes(total) [expr {$RunTimes(total)+$RunTimes(command)}]
            print "P [format_timings $RunTimes(command) 1] [string range $cmd 14 end-5] total run time"
        }
        # Print total runtime in same format as timerate output
        print "P [format_timings $RunTimes(total) 1] Total run time"

        if {[info exists twapi_vm_pre]} {
            set twapi_vm_post [::twapi::get_process_memory_info]
            set MB 1048576.0
            foreach key $twapi_keys {
                set pre [expr {[dict get $twapi_vm_pre $key]/$MB}]
                set post [expr {[dict get $twapi_vm_post $key]/$MB}]
                print "P [format_timings $pre 1] Memory (MB) $key pre-test"
                print "P [format_timings $post 1] Memory (MB) $key post-test"
                print "P [format_timings [expr {$post-$pre}] 1] Memory (MB) delta $key"
            }
        }
        if {[info commands memory] ne ""} {
            foreach line [split [memory info] \n] {
                if {$line eq ""} continue
                set line [split $line]
                set val [expr {[lindex $line end]/1000.0}]
                set line [string trim [join [lrange $line 0 end-1]]]
                print "P [format_timings $val 1] memdbg $line (in thousands)"
            }
            print "# Allocations not freed on exit written to the lost-memory.tmp file."
            print "# These will have to be manually compared."
            # env TCL_FINALIZE_ON_EXIT must be set to 1 for this.
            # DO NOT SET HERE - set ::env(TCL_FINALIZE_ON_EXIT) 1
            # Must be set in environment before starting tclsh else bogus results
            if {[info exists Options(--label)]} {
                set dump_file list-memory-$Options(--label).memdmp
            } else {
                set dump_file list-memory-[pid].memdmp
            }
            memory onexit $dump_file
        }
    }
}


if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} {
    ::perf::list::test
}
Changes to tests/env.test.
103
104
105
106
107
108
109

110
111
112
113
114
115
116
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE

}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]







>







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR PROCESSOR_ARCHITECTURE
    USERPROFILE
}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423







































424
425
426
427
428
429
430
      }
      trace add variable ::env(not_yet_existent) write foo
      info exists ::env(not_yet_existent)
      set ::env(not_yet_existent) "Now I'm here";
      return [info exists ::env(test7_3)]
    }}
} -cleanup cleanup1 -result 1

test env-8.0 {
    memory usage - valgrind does not report reachable memory
} -body {
    set res [set env(__DUMMY__) {i'm with dummy}]
    unset env(__DUMMY__)
    return $res
} -result {i'm with dummy}










































# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}







|









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







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
      }
      trace add variable ::env(not_yet_existent) write foo
      info exists ::env(not_yet_existent)
      set ::env(not_yet_existent) "Now I'm here";
      return [info exists ::env(test7_3)]
    }}
} -cleanup cleanup1 -result 1

test env-8.0 {
    memory usage - valgrind does not report reachable memory
} -body {
    set res [set env(__DUMMY__) {i'm with dummy}]
    unset env(__DUMMY__)
    return $res
} -result {i'm with dummy}


test env-9.0 {
    Initialization of HOME from HOMEDRIVE and HOMEPATH
} -constraints win -setup {
    setup1
    unset -nocomplain ::env(HOME)
    set ::env(HOMEDRIVE) X:
    set ::env(HOMEPATH) \\home\\path
} -cleanup {
    cleanup1
} -body {
    set pipe [open |[list [interpreter]] r+]
    puts $pipe {puts $::env(HOME); flush stdout; exit}
    flush $pipe
    set result [gets $pipe]
    close $pipe
    set result
} -result {X:\home\path}

test env-9.1 {
    Initialization of HOME from USERPROFILE
} -constraints win -setup {
    setup1
    unset -nocomplain ::env(HOME)
    unset -nocomplain ::env(HOMEDRIVE)
    unset -nocomplain ::env(HOMEPATH)
} -cleanup {
    cleanup1
} -body {
    set pipe [open |[list [interpreter]] r+]
    puts $pipe {puts $::env(HOME); flush stdout; exit}
    flush $pipe
    set result [gets $pipe]
    close $pipe
    if {$result ne $::env(USERPROFILE)} {
	list ERROR $result ne $::env(USERPROFILE)
    }
} -result {}



# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}
Changes to tests/httpd.
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71




72
73
74
75
76
77
78
proc httpdAccept {newsock ipaddr port} {
    global httpd
    upvar #0 httpd$newsock data

    fconfigure $newsock -blocking 0 -translation {auto crlf}
    httpd_log $newsock Connect $ipaddr $port
    set data(ipaddr) $ipaddr
    after 50 [list fileevent $newsock readable [list httpdRead $newsock]]
}

# read data from a client request

proc httpdRead { sock } {
    upvar #0 httpd$sock data

    if {[eof $sock]} {
	set readCount -1
    } elseif {![info exists data(state)]} {

	# Read the protocol line and parse out the URL and query

	set readCount [gets $sock line]
	if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \
		-> data(proto) data(url) data(query) data(httpversion)]} {
	    set data(state) mime
	    httpd_log $sock Query $line




	} else {
	    httpdError $sock 400
	    httpd_log $sock Error "bad first line:$line"
	    httpdSockDone $sock
	}
	return
    } elseif {$data(state) == "mime"} {







|


















>
>
>
>







46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
proc httpdAccept {newsock ipaddr port} {
    global httpd
    upvar #0 httpd$newsock data

    fconfigure $newsock -blocking 0 -translation {auto crlf}
    httpd_log $newsock Connect $ipaddr $port
    set data(ipaddr) $ipaddr
    fileevent $newsock readable [list httpdRead $newsock]
}

# read data from a client request

proc httpdRead { sock } {
    upvar #0 httpd$sock data

    if {[eof $sock]} {
	set readCount -1
    } elseif {![info exists data(state)]} {

	# Read the protocol line and parse out the URL and query

	set readCount [gets $sock line]
	if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \
		-> data(proto) data(url) data(query) data(httpversion)]} {
	    set data(state) mime
	    httpd_log $sock Query $line
	    if {[regexp {(?:^|[\?&])delay=([^&]+)} $data(query) {} val]} {
		fileevent $sock readable {}
		after $val [list fileevent $sock readable [list httpdRead $sock]]
	    }
	} else {
	    httpdError $sock 400
	    httpd_log $sock Error "bad first line:$line"
	    httpdSockDone $sock
	}
	return
    } elseif {$data(state) == "mime"} {
Added tests/listRep.test.




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
# This file contains tests that specifically exercise the internal representation
# of a list.
#
# Copyright © 2022 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Unlike the other files related to list commands which for the most part do
# black box testing focusing on functionality, this file does more of white box
# testing to exercise code paths that implement different list representations
# (with spans, leading free space etc., shared/unshared etc.) In addition to
# functional correctness, the tests also check for the expected internal
# representation as that pertains to performance heuristics. Generally speaking,
# combinations of the following need to be tested,
# - free space in front, back, neither, both of list representation
# - shared Tcl_Objs
# - shared internal reps (independent of shared Tcl_Objs)
# - byte-compiled vs non-compiled
#
# Being white box tests, they are sensitive to changes to further optimizations
# and changes in heuristics. That cannot be helped.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testlistrep [llength [info commands testlistrep]]

proc describe {l args} {dict get [testlistrep describe $l] {*}$args}

proc irange {first last} {
    set l {}
    while {$first <= $last} {
        lappend l $first
        incr first
    }
    return $l
}
proc leadSpace {l} {
    # Returns the leading space in a list store
    return [dict get [describe $l] store firstUsed]
}
proc tailSpace {l} {
    # Returns the trailing space in a list store
    array set rep [describe $l]
    dict with rep(store) {
        return [expr {$numAllocated - ($firstUsed + $numUsed)}]
    }
}
proc allocated {l} {
    # Returns the allocated space in a list store
    return [dict get [describe $l] store numAllocated]
}
proc repStoreRefCount {l} {
    # Returns the ref count for the list store
    return [dict get [describe $l] store refCount]
}
proc validate {l} {
    # Panics if internal listrep structures are not valid
    testlistrep validate $l
}
proc leadSpaceMore {l} {
    set leadSpace [leadSpace $l]
    expr {$leadSpace > 0 && $leadSpace >= 2*[tailSpace $l]}
}
proc tailSpaceMore {l} {
    set tailSpace [tailSpace $l]
    expr {$tailSpace > 0 && $tailSpace >= 2*[leadSpace $l]}
}
proc spaceEqual {l} {
    # 1 if lead and tail space shared (diff of 1 at most) and more than 0
    set leadSpace [leadSpace $l]
    set tailSpace [tailSpace $l]
    if {$leadSpace == 0 && $tailSpace == 0} {
        # At least one must be positive
        return 0
    }
    set diff [expr {$leadSpace - $tailSpace}]
    return [expr {$diff >= -1 && $diff <= 1}]
}
proc storeAddress {l} {
    return [describe $l store memoryAddress]
}
proc sameStore {l1 l2} {
    expr {[storeAddress $l1] == [storeAddress $l2]}
}
proc hasSpan {l args} {
    # Returns 1 if list has a span. If args are specified, they are checked with
    # span values (start and length)
    array set rep [describe $l]
    if {![info exists rep(span)]} {
        return 0
    }
    if {[llength $args] == 0} {
        return 1; # No need to check values
    }
    lassign $args start len
    if {[dict get $rep(span) spanStart] == $start &&
        [dict get $rep(span) spanLength] == $len} {
        return 1
    }
    return 0
}
proc checkListrep {l listLen numAllocated leadSpace tailSpace {refCount 0}} {
    # Checks if the internal representation of $l match
    # passed arguments. Return "" if yes, else error messages.
    array set rep [testlistrep describe $l]

    set rep(leadSpace) [dict get $rep(store) firstUsed]
    set rep(numAllocated) [dict get $rep(store) numAllocated]
    set rep(tailSpace) [expr {
                              $rep(numAllocated) - ($rep(leadSpace) + [dict get $rep(store) numUsed])
                          }]
    set rep(refCount) [dict get $rep(store) refCount]

    if {[info exists rep(span)]} {
        set rep(listLen) [dict get $rep(span) spanLength]
    } else {
        set rep(listLen) [dict get $rep(store) numUsed]
    }

    set errors [list]
    foreach arg {listLen numAllocated leadSpace tailSpace} {
        if {$rep($arg) != [set $arg]} {
            lappend errors "$arg in list representation ($rep($arg)) is not expected value ([set $arg])."
        }
    }
    # Check refCount only if caller has specified it as non-0
    if {$refCount && $refCount != $rep(refCount)} {
        lappend errors "refCount in list representation ($rep(refCount)) is not expected value ($refCount)."
    }
    return $errors
}

proc assertListrep {l listLen numAllocated leadSpace tailSpace {refCount 0}} {
    # Like check_listrep but raises error
    set errors [checkListrep $l $listLen $numAllocated $leadSpace $tailSpace $refCount]
    if {[llength $errors]} {
        error [join $errors \n]
    }
    return
}

# The default length should be large enough that doubling the allocation will
# clearly distinguish free space allocation difference between front and back.
# (difference in the two should at least be 2 else we cannot tell if front
# or back was favored appropriately)
proc freeSpaceNone {{len 8}} {return [testlistrep new $len 0 0]}
proc freeSpaceLead {{len 8} {lead 3}} {return [testlistrep new $len $lead 0]}
proc freeSpaceTail {{len 8} {tail 3}} {return [testlistrep new $len 0 $tail]}
proc freeSpaceBoth {{len 8} {lead 3} {tail 3}} {
    return [testlistrep new $len $lead $tail]
}
proc zombieSample {{len 1000} {leadzombies 100} {tailzombies 100}} {
    # returns an unshared listrep with zombies in front and back

    # don't combine freespacenone and lrange else zombies are freed
    set l [freeSpaceNone [expr {$len+$leadzombies+$tailzombies}]]
    return [lrange $l $leadzombies [expr {$leadzombies+$len-1}]]
}

# Just ensure above stubs return what's expected
if {[testConstraint testlistrep]} {
    assertListrep [freeSpaceNone] 8 8 0 0 1
    assertListrep [freeSpaceLead] 8 11 3 0 1
    assertListrep [freeSpaceTail] 8 11 0 3 1
    assertListrep [freeSpaceBoth] 8 14 3 3 1
    assertListrep [zombieSample] 1000 1200 0 0 1
    if {![hasSpan [zombieSample]] || [dict get [testlistrep describe [zombieSample]] span spanStart] == 0} {
        error "zombieSample span missing or span start is at 0."
    }
}

# Define some variables for some indices because the Tcl compiler will do some
# operations completely in byte code if indices are literals
set zero 0
set one 1
set two 2
set four 4
set end end

#
# Test sets:
# 1.* - unshared internal rep, no spans, with no free space
# 2.* - shared internal rep, no spans, with no free space
# 3.* - unshared internal rep, spanned
# 4.* - shared internal rep, spanned
# 5.* - shared Tcl_Obj
# 6.* - lists with zombie Tcl_Obj's

#
# listrep-1.* tests all operate on unshared listreps with no free space

test listrep-1.1 {
    Inserts in front of unshared list with no free space should reallocate with
    equal free space at front and back -- linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $zero 99]
    validate $l
    list $l [spaceEqual $l]
} -result [list {99 0 1 2 3 4 5 6 7} 1]

test listrep-1.1.1 {
    Inserts in front of unshared list with no free space should reallocate with
    equal free space at front and back -- lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero -1 99]
    validate $l
    list $l [spaceEqual $l]
} -result [list {99 0 1 2 3 4 5 6 7} 1]

test listrep-1.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $end 99]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.2.1 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.2.2 {
    Inserts at back of unshared list with no free space should allocate all
    space at back -- lappend version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lappend l 99
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 7 99} 0 9]

test listrep-1.3 {
    Inserts in middle of unshared list with no free space should reallocate with
    equal free space at front and back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceNone] $four 99]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 99 4 5 6 7} 1]

test listrep-1.3.1 {
    Inserts in middle of unshared list with no free space should reallocate with
    equal free space at front and back - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $four $four-1 99]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 99 4 5 6 7} 1]

test listrep-1.4 {
    Deletes from front of small unshared list with no free space should
    just shift up leaving room at back - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] $zero $zero]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {1 2 3 4 5 6 7} 0 1]

test listrep-1.4.1 {
    Deletes from front of small unshared list with no free space should
    just shift up leaving room at back - lassign version
} -constraints testlistrep -body {
    set l [lassign [freeSpaceNone] e]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l]
} -result [list 0 {1 2 3 4 5 6 7} 0 1]

test listrep-1.4.2 {
    Deletes from front of small unshared list with no free space should
    just shift up leaving room at back - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    set e [lpop l $zero]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l]
} -result [list 0 {1 2 3 4 5 6 7} 0 1]

test listrep-1.4.3 {
    Deletes from front of small unshared list with no free space should
    just shift up leaving room at back - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceNone] $one $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {1 2 3 4 5 6 7} 0 1]

test listrep-1.4.4 {
    Deletes from front of small unshared list with no free space should
    just shift up leaving room at back - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceNone] $zero]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {1 2 3 4 5 6 7} 0 1]

test listrep-1.5 {
    Deletes from front of large unshared list with no free space should
    create a span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone 1000] $zero $one]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 2 998]
} -result [list [irange 2 999] 2 0 1]

test listrep-1.5.1 {
    Deletes from front of large unshared list with no free space should
    create a span - lassign version
} -constraints testlistrep -body {
    set l [lassign [freeSpaceNone 1000] e]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 1 999]
} -result [list 0 [irange 1 999] 1 0 1]

test listrep-1.5.2 {
    Deletes from front of large unshared list with no free space should
    create a span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceNone 1000] $two end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 2 998]
} -result [list [irange 2 999] 2 0 1]

test listrep-1.5.3 {
    Deletes from front of large unshared list with no free space should
    create a span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceNone 1000] $zero]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 1 999]
} -result [list [irange 1 999] 1 0 1]

test listrep-1.5.4 {
    Deletes from front of large unshared list with no free space should
    create a span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone 1000]
    set e [lpop l 0]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 1 999]
} -result [list 0 [irange 1 999] 1 0 1]

test listrep-1.6 {
    Deletes closer to front of large list should move (smaller) front segment
    -- lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone 1000] $four $four]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 1 999]
} -result [list [concat [irange 0 3] [irange 5 999]] 1 0 1]

test listrep-1.6.1 {
    Deletes closer to front of large list should move (smaller) front segment
    -- lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone 1000]
    set e [lpop l $four]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 1 999]
} -result [list 4 [concat [irange 0 3] [irange 5 999]] 1 0 1]

test listrep-1.7 {
    Deletes closer to back of large list should move (smaller) back segment
    and will not need a span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone 1000] end-$four end-$four]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list [concat [irange 0 994] [irange 996 999]] 0 1 0]

test listrep-1.7.1 {
    Deletes closer to back of large list should move (smaller) back segment
    and will not need a span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone 1000]
    set e [lpop l $end-4]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list 995 [concat [irange 0 994] [irange 996 999]] 0 1 0]

test listrep-1.8 {
    Deletes at back of small unshared list should not need a span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone] end-$one end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5} 0 2 0]

test listrep-1.8.1 {
    Deletes at back of small unshared list should not need a span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceNone] $zero end-$two]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5} 0 2 0]

test listrep-1.8.2 {
    Deletes at back of small unshared list should not need a span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceNone] $end-1 $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5} 0 2 0]

test listrep-1.8.3 {
    Deletes at back of small unshared list should not need a span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    set e [lpop l $end]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list 7 {0 1 2 3 4 5 6} 0 1 0]

test listrep-1.9 {
    Deletes at back of large unshared list should not need a span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceNone 1000] end-$four end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list [irange 0 994] 0 5 0]

test listrep-1.9.1 {
    Deletes at back of large unshared list should not need a span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceNone 1000] 0 $end-5]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list [irange 0 994] 0 5 0]

test listrep-1.9.2 {
    Deletes at back of large unshared list should not need a span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceNone 1000] end-$four $end-3 end-$two $end-1 $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list [irange 0 994] 0 5 0]

test listrep-1.9.3 {
    Deletes at back of large unshared list should not need a span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone 1000]
    set e [lpop l $end]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list 999 [irange 0 998] 0 1 0]

test listrep-1.10 {
    no-op on unshared list should force a canonical list string - lreplace version
} -body {
    lreplace {    1 2   3 4   } $zero -1
} -result {1 2 3 4}

test listrep-1.10.1 {
    no-op on unshared list should force a canonical list string - lrange version
} -body {
    lrange {    1 2   3 4   } $zero $end
} -result {1 2 3 4}

test listrep-1.11 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - lreplace version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [lreplace [freeSpaceNone 1000] $end+1 $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.1 {
    Append elements to large unshared list is optimized as lappend
    so no free space in front - linsert version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [linsert [freeSpaceNone 1000] $end+1 1000]
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1000] 0 1 0]

test listrep-1.11.2 {
    Append elements to large unshared list leaves no free space in front
    - lappend version
} -body {
    # Note $end, not end else byte code compiler short-cuts
    set l [freeSpaceNone 1000]
    lappend l 1000 1001
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l] > 0}] [hasSpan $l]
} -result [list [irange 0 1001] 0 1 0]


test listrep-1.12 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 0 0]

test listrep-1.12.1 {
    Replacement of elements at front with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l 0 -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {-1 1 2 3 4 5 6 7} 0 0]

test listrep-1.13 {
    Replacement of elements at front with fewer elements in unshared list
    results in a spanned list with space only in front
} -body {
    set l [lreplace [freeSpaceNone] $zero $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 4 0]

test listrep-1.14 {
    Replacement of elements at front with more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $zero $one 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {10 11 12 2 3 4 5 6 7} 1]

test listrep-1.15 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 11 3 4 5 6 7} 0 0]

test listrep-1.15.1 {
    Replacement of elements in middle with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l $two -1
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 -1 3 4 5 6 7} 0 0]

test listrep-1.16 {
    Replacement of elements in front half with fewer elements in unshared list
    results in a spanned list with space only in front since smaller segment moved
} -body {
    set l [lreplace [freeSpaceNone] $one $four 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 10 5 6 7} 3 0]

test listrep-1.17 {
    Replacement of elements in back half with fewer elements in unshared list
    results in a spanned list with space only at back
} -body {
    set l [lreplace [freeSpaceNone] end-$four end-$one 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 10 7} 0 3]

test listrep-1.18 {
    Replacement of elements in middle more elements in unshared list
    results in a reallocated spanned list with space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $one $two 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 10 11 12 3 4 5 6 7} 1]

test listrep-1.19 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 0 0]

test listrep-1.19.1 {
    Replacement of elements at back with same number elements in unshared list
    is in-place - lset version
} -body {
    set l [freeSpaceNone]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0]

test listrep-1.20 {
    Replacement of elements at back with fewer elements in unshared list
    is in-place with space only at the back
} -body {
    set l [lreplace [freeSpaceNone] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 0 2]

test listrep-1.21 {
    Replacement of elements at back with more elements in unshared list
    allocates new representation with equal space at front and back
} -body {
    set l [lreplace [freeSpaceNone] $end-1 $end 10 11 12]
    validate $l
    list $l [spaceEqual $l]
} -result [list {0 1 2 3 4 5 10 11 12} 1]

#
# listrep-2.* tests all operate on shared list reps with no free space. Note the
# *list internal rep* must be shared, not only the Tcl_Obj so just assigning to
# another variable does not suffice. The lrange construct on an variable's value
# will do the needful.

test listrep-2.1 {
    Inserts in front of shared list with no free space should reallocate with
    more leading space in front - linsert version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [linsert $b $zero 99]
    validate $l
    list [repStoreRefCount $b] $l [leadSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {99 0 1 2 3 4 5 6 7} 1 1]

test listrep-2.1.1 {
    Inserts in front of shared list with no free space should reallocate with
    more leading space in front - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero -1 99]
    validate $l
    list [repStoreRefCount $b] $l [leadSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {99 0 1 2 3 4 5 6 7} 1 1]

test listrep-2.2 {
    Inserts at back of shared list with no free space should reallocate with
    more leading space in back - linsert version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [linsert $b $end 99]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5 6 7 99} 1 1]

test listrep-2.2.1 {
    Inserts at back of shared list with no free space should reallocate with
    more leading space in back - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $end+1 end+$one 99]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5 6 7 99} 1 1]

test listrep-2.2.2 {
    Inserts at back of shared list with no free space should reallocate with
    more leading space in back - lappend version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lappend b 99]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 1 {0 1 2 3 4 5 6 7 99} 1 1]

test listrep-2.2.3 {
    Inserts at back of shared list with no free space should reallocate with
    more leading space in back - lset version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lset b $end+1 99]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 1 {0 1 2 3 4 5 6 7 99} 1 1]

test listrep-2.3 {
    Inserts in middle of shared list with no free space should reallocate with
    equal spacing - linsert version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [linsert $b $four 99]
    validate $l
    list [repStoreRefCount $b] $l [spaceEqual $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 99 4 5 6 7} 1 1]

test listrep-2.3.1 {
    Inserts in middle of shared list with no free space should reallocate with
    equal spacing - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $four $four-1 99]
    validate $l
    list [repStoreRefCount $b] $l [spaceEqual $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 99 4 5 6 7} 1 1]

test listrep-2.4 {
    Deletes from front of small shared list with no free space should
    allocate new list of exact size - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero $zero]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {1 2 3 4 5 6 7} 0 0 1]

test listrep-2.4.1 {
    Deletes from front of small shared list with no free space should
    allocate new list of exact size - lremove version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lremove $b $zero $one]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {2 3 4 5 6 7} 0 0 1]

test listrep-2.4.2 {
    Deletes from front of small shared list with no free space should
    allocate new list of exact size - lrange version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lrange $b $one $end]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {1 2 3 4 5 6 7} 0 0 1]

test listrep-2.4.3 {
    Deletes from front of small shared list with no free space should
    allocate new list of exact size - lassign version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lassign $b e]
    validate $l
    list $e [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 0 2 {1 2 3 4 5 6 7} 0 0 1]

test listrep-2.4.4 {
    Deletes from front of small shared list with no free space should
    allocate new list of exact size - lpop version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set l [lrange $a $zero end]; # Ensure shared listrep
    set e [lpop l $zero]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 0 {1 2 3 4 5 6 7} 0 0 1]

test listrep-2.5 {
    Deletes from front of large shared list with no free space should
    create span - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero $zero]
    validate $l
    # The listrep store should be shared among a, b, l (3 refs)
    list [sameStore $b $l] [repStoreRefCount $b] $l [hasSpan $l] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 1 3 [irange 1 999] 1 0 0 3]

test listrep-2.5.1 {
    Deletes from front of large shared list with no free space should
    create span - lremove version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lremove $b $zero $one]
    validate $l
    # The listrep store should be shared among a, b, l (3 refs)
    list [sameStore $b $l] [repStoreRefCount $b] $l [hasSpan $l] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 1 3 [irange 2 999] 1 0 0 3]

test listrep-2.5.2 {
    Deletes from front of large shared list with no free space should
    create span - lrange version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lrange $b $two $end]
    validate $l
    # The listrep store should be shared among a, b, l (3 refs)
    list [sameStore $b $l] [repStoreRefCount $b] $l [hasSpan $l] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 1 3 [irange 2 999] 1 0 0 3]

test listrep-2.5.3 {
    Deletes from front of large shared list with no free space should
    create span - lassign version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lassign $b e]
    validate $l
    # The listrep store should be shared among a, b, l (3 refs)
    list $e [sameStore $b $l] [repStoreRefCount $b] $l [hasSpan $l] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 0 1 3 [irange 1 999] 1 0 0 3]

test listrep-2.5.4 {
    Deletes from front of large shared list with no free space should
    create span - lpop version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set l [lrange $a $zero end]; # Ensure shared listrep
    set e [lpop l $zero]
    validate $l
    # The listrep store should be shared among a, b, l (3 refs)
    list $e $l [hasSpan $l] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 0 [irange 1 999] 1 0 0 2]

test listrep-2.6 {
    Deletes from back of small shared list with no free space should
    allocate new list of exact size - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $end $end]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5 6} 0 0 1]

test listrep-2.6.1 {
    Deletes from back of small shared list with no free space should
    allocate new list of exact size - lremove version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lremove $b $end $end-1]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5} 0 0 1]

test listrep-2.6.2 {
    Deletes from back of small shared list with no free space should
    allocate new list of exact size - lrange version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lrange $b $zero $end-1]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5 6} 0 0 1]

test listrep-2.6.3 {
    Deletes from back of small shared list with no free space should
    allocate new list of exact size - lpop version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set l [lrange $a $zero end]; # Ensure shared listrep
    set e [lpop l]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 7 {0 1 2 3 4 5 6} 0 0 1]

test listrep-2.7 {
    Deletes from back of large shared list with no free space should
    use a span - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $end $end]
    validate $l
    # Note lead and tail space is 0 because original list store in a,b is used
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 3 [irange 0 998] 0 0 3]

test listrep-2.7.1 {
    Deletes from back of large shared list with no free space should
    use a span - lremove version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lremove $b $end-1 $end]
    validate $l
    # Note lead and tail space is 0 because original list store in a,b is used
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 3 [irange 0 997] 0 0 3]

test listrep-2.7.2 {
    Deletes from back of large shared list with no free space should
    use a span - lrange version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lrange $b $zero $end-1]
    validate $l
    # Note lead and tail space is 0 because original list store in a,b is used
    list [repStoreRefCount $b] $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 3 [irange 0 998] 0 0 3]

test listrep-2.7.3 {
    Deletes from back of large shared list with no free space should
    use a span - lpop version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set l [lrange $a $zero end]; # Ensure shared listrep
    set e [lpop l]
    validate $l
    # Note lead and tail space is 0 because original list store in a,b is used
    list $e $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 999 [irange 0 998] 0 0 2]

test listrep-2.8 {
    no-op on shared list should force a canonical list representation
    with original unchanged - lreplace version
} -body {
    set l {     1 2   3 4   }
    list [lreplace $l $zero -1] $l
} -result [list {1 2 3 4} {     1 2   3 4   }]

test listrep-2.8.1 {
    no-op on shared list should force a canonical list representation
    with original unchanged - lrange version
} -body {
    set l {     1 2   3 4   }
    list [lrange $l $zero end] $l
} -result [list {1 2 3 4} {     1 2   3 4   }]

test listrep-2.9 {
    Appends to back of large shared list with no free space allocates new
    list with space only at the back - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $end+1 $end+1 1000]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [expr {[tailSpace $l]>0}] [repStoreRefCount $l]
} -result [list 2 [irange 0 1000] 0 1 1]

test listrep-2.9.1 {
    Appends to back of large shared list with no free space allocates new
    list with space only at the back - linsert version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [linsert $b $end+1 1000 1001]
    validate $l
    list [repStoreRefCount $b] $l [leadSpace $l] [expr {[tailSpace $l]>0}] [repStoreRefCount $l]
} -result [list 2 [irange 0 1001] 0 1 1]

test listrep-2.9.2 {
    Appends to back of large shared list with no free space allocates new
    list with space only at the back - lappend version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set l [lrange $a $zero end]; # Ensure shared listrep
    lappend l 1000
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l]>0}] [repStoreRefCount $l]
} -result [list [irange 0 1000] 0 1 1]

test listrep-2.9.3 {
    Appends to back of large shared list with no free space allocates new
    list with space only at the back - lset version
} -constraints testlistrep -body {
    set a [freeSpaceNone 1000]
    set l [lrange $a $zero end]; # Ensure shared listrep
    lset l $end+1 1000
    validate $l
    list $l [leadSpace $l] [expr {[tailSpace $l]>0}] [repStoreRefCount $l]
} -result [list [irange 0 1000] 0 1 1]

test listrep-2.10 {
    Replacement of elements at front with same number in shared list results
    in a new list store with more space in front than back - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero $one 10 11]
    validate $l
    list [repStoreRefCount $b] $l [leadSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {10 11 2 3 4 5 6 7} 1 1]

test listrep-2.10.1 {
    Replacement of elements at front with same number in shared list results
    in a new list store with no extra space - lset version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set l [lrange $a $zero end]; # Ensure shared listrep
    lset l $zero 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 1 2 3 4 5 6 7} 0 0 1]

test listrep-2.11 {
    Replacement of elements at front with fewer elements in shared list
    results in a new list store with more space in front than back
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero $four 10]
    validate $l
    list [repStoreRefCount $b] $l [leadSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {10 5 6 7} 1 1]

test listrep-2.12 {
    Replacement of elements at front with more elements in shared list
    results in a new spanned list with more space in front
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $zero $one 10 11 12]
    validate $l
    list [repStoreRefCount $b] $l [leadSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {10 11 12 2 3 4 5 6 7} 1 1]

test listrep-2.13 {
    Replacement of elements in middle with same number in shared list results
    in a new list store with equal space in front and back - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $one $two 10 11]
    validate $l
    list [repStoreRefCount $b] $l [spaceEqual $l] [repStoreRefCount $l]
} -result [list 2 {0 10 11 3 4 5 6 7} 1 1]

test listrep-2.13.1 {
    Replacement of elements in middle with same number in shared list results
    in a new list store with exact allocation - lset version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set l [lrange $a $zero end]; # Ensure shared listrep
    lset l $one 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 10 2 3 4 5 6 7} 0 0 1]

test listrep-2.14 {
    Replacement of elements in middle with fewer elements in shared list
    results in a new list store with equal space
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $one 5 10]
    validate $l
    list [repStoreRefCount $b] $l [spaceEqual $l] [repStoreRefCount $l]
} -result [list 2 {0 10 6 7} 1 1]

test listrep-2.15 {
    Replacement of elements in middle with more elements in shared list
    results in a new spanned list with space in front and back
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b $one $two 10 11 12]
    validate $l
    list [repStoreRefCount $b] $l [spaceEqual $l] [repStoreRefCount $l]
} -result [list 2 {0 10 11 12 3 4 5 6 7} 1 1]

test listrep-2.16 {
    Replacement of elements at back with same number in shared list results
    in a new list store with more space in back than front - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b end-$one $end 10 11]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 3 4 5 10 11} 1 1]

test listrep-2.16.1 {
    Replacement of elements at back with same number in shared list results
    in a new list store with no extra - lreplace version
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set l [lrange $a $zero end]; # Ensure shared listrep
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 10} 0 0 1]

test listrep-2.17 {
    Replacement of elements at back with fewer elements in shared list
    results in a new list store with more space in back than front
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b end-$four $end 10]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 10} 1 1]

test listrep-2.18 {
    Replacement of elements at back with more elements in shared list
    results in a new list store with more space in back than front
} -constraints testlistrep -body {
    set a [freeSpaceNone]
    set b [lrange $a $zero end]; # Ensure shared listrep
    set l [lreplace $b end-$four $end 10]
    validate $l
    list [repStoreRefCount $b] $l [tailSpaceMore $l] [repStoreRefCount $l]
} -result [list 2 {0 1 2 10} 1 1]

#
# listrep-3.* - tests on unshared spanned listreps

test listrep-3.1 {
    Inserts in front of unshared spanned list with room in front should just
    shrink the lead space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $zero -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -2 7] 1 3 1]

test listrep-3.1.1 {
    Inserts in front of unshared spanned list with room in front should just
    shrink the lead space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero -1 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -2 7] 1 3 1]

test listrep-3.2 {
    Inserts in front of unshared spanned list with insufficient room in front
    but enough total freespace should redistribute free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 10] $zero -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -2 7] 5 4 1]

test listrep-3.2.1 {
    Inserts in front of unshared spanned list with insufficient room in front
    but enough total freespace should redistribute free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 10] $zero -1 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -2 7] 5 4 1]

test listrep-3.3 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $zero -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 6 5 1]

test listrep-3.3.1 {
    Inserts in front of unshared spanned list with insufficient total freespace
    should reallocate with equal free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange -3 7] 6 5 1]

test listrep-3.4 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end 8]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 3 2 1]

test listrep-3.4.1 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end+1 $end+1 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 9] 3 1 1]

test listrep-3.4.2 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lappend l 8 9 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 3 0 1]

test listrep-3.4.3 {
    Inserts at back of unshared spanned list with room at back should not
    reallocate - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    lset l $end+1 8
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 3 2 1]

test listrep-3.5 {
    Inserts at back of unshared spanned list with insufficient room in back
    but enough total freespace should redistribute free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 10 1] $end 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 9] 5 4 1]

test listrep-3.5.1 {
    Inserts at back of unshared spanned list with insufficient room in back
    but enough total freespace should redistribute free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 10 1] $end+1 $end+1 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 9] 5 4 1]

test listrep-3.5.2 {
    Inserts at back of unshared spanned list with insufficient room in back
    but enough total freespace should redistribute free space - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 8 10 1]
    lappend l 8 9
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 9] 5 4 1]

test listrep-3.5.3 {
    Inserts at back of unshared spanned list with insufficient room in back
    but enough total freespace should redistribute free space - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 8 10 0]
    lset l $end+1 8
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 5 4 1]

test listrep-3.6 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc(). - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.1 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end+1 $end+1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.2 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 8 1 1]
    lappend l 8 9 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 10] 1 10 1]

test listrep-3.6.3 {
    Inserts in back of unshared spanned list with insufficient total freespace
    should reallocate with all *additional* space at back. Note this differs
    from the insert in front case because here we realloc() - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    lset l $end+1 8
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 0 8] 0 9 1]

test listrep-3.7 {
    Inserts in front half of unshared spanned list with room in front should not
    reallocate and should move front segment
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $one -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -2 -1 1 2 3 4 5 6 7} 1 3 1]

test listrep-3.8 {
    Inserts in front half of unshared spanned list with insufficient leading
    space but with enough tail space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 5] $one -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -2 -1 1 2 3 4 5 6 7} 1 3 1]

test listrep-3.8.1 {
    Inserts in front half of unshared spanned list with insufficient leading
    space but with enough tail space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 5] $one -1 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -2 -1 1 2 3 4 5 6 7} 1 3 1]

test listrep-3.9 {
    Inserts in front half of unshared spanned list with sufficient total
    free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 2 2] $one -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 0 1 1]

test listrep-3.9.1 {
    Inserts in front half of unshared spanned list with sufficient total
    free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $one -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 0 1 1]

test listrep-3.10 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $one -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]

test listrep-3.10.1 {
    Inserts in front half of unshared spanned list with insufficient total space.
    Note use of realloc() means new space will be at the back - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one -1 -3 -2 -1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 -3 -2 -1 1 2 3 4 5 6 7} 1 10 1]

test listrep-3.11 {
    Inserts in back half of unshared spanned list with room in back should not
    reallocate and should move back segment - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth] $end-$one 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 7} 3 1 1]

test listrep-3.11.1 {
    Inserts in back half of unshared spanned list with room in back should not
    reallocate and should move back segment - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end -1 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 7} 3 1 1]

test listrep-3.12 {
    Inserts in back half of unshared spanned list with insufficient tail
    space but with enough leading space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 5 1] $end-$one 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 7} 3 1 1]

test listrep-3.12.1 {
    Inserts in back half of unshared spanned list with insufficient tail
    space but with enough leading space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 5 1] $end -1 8 9]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 7} 3 1 1]

test listrep-3.13 {
    Inserts in back half of unshared spanned list with sufficient total
    free space - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 2 2] $end-$one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 0 1 1]

test listrep-3.13.1 {
    Inserts in back half of unshared spanned list with sufficient total
    free space - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $end -1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 0 1 1]

test listrep-3.14 {
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - linsert version
} -constraints testlistrep -body {
    set l [linsert [freeSpaceBoth 8 1 1] $end-$one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]

test listrep-3.14.1 {
    Inserts in back half of unshared spanned list with insufficient
    total space. Note use of realloc() means new space will be at the
    back - lrepalce version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end -1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {0 1 2 3 4 5 6 8 9 10 7} 1 10 1]

test listrep-3.15 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $zero $zero]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {1 2 3 4 5 6 7} 0 7 0]

test listrep-3.15.1 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth] $zero $one]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {2 3 4 5 6 7} 0 8 0]

test listrep-3.15.2 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceBoth] $one $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {1 2 3 4 5 6 7} 0 7 0]

test listrep-3.15.3 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lassign version
} -constraints testlistrep -body {
    set l [lassign [freeSpaceBoth] e]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list 0 {1 2 3 4 5 6 7} 0 7 0]

test listrep-3.15.4 {
    Deletes from front of small unshared span list results in elements
    moved up front and span removal - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    set e [lpop l $zero]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {1 2 3 4 5 6 7} 0 7 0]

test listrep-3.16 {
    Deletes from front of large unshared span list results in another
    span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 1000 10 10] $zero $one]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 12 998]
} -result [list [irange 2 999] 12 10 1]

test listrep-3.16.1 {
    Deletes from front of large unshared span list results in another
    span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth 1000 10 10] $zero $one]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 12 998]
} -result [list [irange 2 999] 12 10 1]

test listrep-3.16.2 {
    Deletes from front of large unshared span list results in another
    span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceBoth 1000 10 10] $two $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 12 998]
} -result [list [irange 2 999] 12 10 1]

test listrep-3.16.3 {
    Deletes from front of large unshared span list results in another
    span - lassign version
} -constraints testlistrep -body {
    set l [lassign [freeSpaceBoth 1000 10 10] e]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 11 999]
} -result [list 0 [irange 1 999] 11 10 1]

test listrep-3.16.4 {
    Deletes from front of large unshared span list results in another
    span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 1000 10 10]
    set e [lpop l $zero]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 11 999]
} -result [list 0 [irange 1 999] 11 10 1]

test listrep-3.17 {
    Deletes from back of small unshared span list results in new store
    without span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5 6} 0 7 0]

test listrep-3.17.1 {
    Deletes from back of small unshared span list results in new store
    without span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth] $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5 6} 0 7 0]

test listrep-3.17.2 {
    Deletes from back of small unshared span list results in new store
    without span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceBoth] $zero $end-1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list {0 1 2 3 4 5 6} 0 7 0]

test listrep-3.17.3 {
    Deletes from back of small unshared span list results in new store
    without span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceBoth]
    set e [lpop l]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l]
} -result [list 7 {0 1 2 3 4 5 6} 0 7 0]

test listrep-3.18 {
    Deletes from back of large unshared span list results in another
    span - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 1000 10 10] $end-1 $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [irange 0 997] 10 12 1]

test listrep-3.18.1 {
    Deletes from back of large unshared span list results in another
    span - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth 1000 10 10] $end-1 $end]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [irange 0 997] 10 12 1]

test listrep-3.18.2 {
    Deletes from back of large unshared span list results in another
    span - lrange version
} -constraints testlistrep -body {
    set l [lrange [freeSpaceBoth 1000 10 10] $zero $end-2]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [irange 0 997] 10 12 1]

test listrep-3.18.3 {
    Deletes from back of large unshared span list results in another
    span - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 1000 10 10]
    set e [lpop l]
    validate $l
    list $e $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 999]
} -result [list 999 [irange 0 998] 10 11 1]

test listrep-3.19 {
    Deletes from front half of small unshared span list results in
    movement of smaller front segment - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $one $two]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 5 6]
} -result [list {0 3 4 5 6 7} 5 3 1]

test listrep-3.19.1 {
    Deletes from front half of small unshared span list results in
    movement of smaller front segment - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth] $one $two]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 5 6]
} -result [list {0 3 4 5 6 7} 5 3 1]

test listrep-3.20 {
    Deletes from front half of large unshared span list results in
    movement of smaller front segment - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 1000 10 10] $one $two]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 12 998]
} -result [list [list 0 {*}[irange 3 999]] 12 10 1]

test listrep-3.20.1 {
    Deletes from front half of large unshared span list results in
    movement of smaller front segment - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth 1000 10 10] $one $two]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 12 998]
} -result [list [list 0 {*}[irange 3 999]] 12 10 1]

test listrep-3.21 {
    Deletes from back half of small unshared span list results in
    movement of smaller back segment - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 3 6]
} -result [list {0 1 2 3 4 7} 3 5 1]

test listrep-3.21.1 {
    Deletes from back half of small unshared span list results in
    movement of smaller back segment - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth] $end-2 $end-1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 3 6]
} -result [list {0 1 2 3 4 7} 3 5 1]

test listrep-3.22 {
    Deletes from back half of large unshared span list results in
    movement of smaller back segment - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 1000 10 10] $end-2 $end-1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]

test listrep-3.22.1 {
    Deletes from back half of large unshared span list results in
    movement of smaller back segment - lremove version
} -constraints testlistrep -body {
    set l [lremove [freeSpaceBoth 1000 10 10] $end-2 $end-1]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [hasSpan $l 10 998]
} -result [list [list {*}[irange 0 996] 999] 10 12 1]

test listrep-3.23 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 2 3 4 5 6 7} 3 3]

test listrep-3.23.1 {
    Replacement of elements at front with same number elements in unshared
    spanned list is in-place - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $zero 10
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 1 2 3 4 5 6 7} 3 3]

test listrep-3.24 {
    Replacement of elements at front with fewer elements in unshared
    spanned list expands leading space - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $zero $four 10]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 5 6 7} 7 3]

test listrep-3.25 {
    Replacement of elements at front with more elements in unshared
    spanned list with sufficient leading space shrinks leading space
} -body {
    set l [lreplace [freeSpaceBoth] $zero $one 10 11 12]
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {10 11 12 2 3 4 5 6 7} 2 3]

test listrep-3.26 {
    Replacement of elements at front with more elements in unshared
    spanned list with insufficient leading space but sufficient total
    free space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 10] $zero $one 10 11 12 13]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 2 3 4 5 6 7} 5 4 1]

test listrep-3.27 {
    Replacement of elements at front in unshared spanned list with insufficient
    total freespace should reallocate with equal free space
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $zero $one 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list {10 11 12 13 14 2 3 4 5 6 7} 6 5 1]

test listrep-3.28 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11} 3 3]

test listrep-3.28.1 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $end 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 6 10} 3 3]

test listrep-3.29 {
    Replacement of elements at back with fewer elements in unshared
    spanned list expands tail space
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10} 3 5]

test listrep-3.30 {
    Replacement of elements at back with more elements in unshared
    spanned list with sufficient tail space shrinks tailspace
} -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12} 3 2]

test listrep-3.31 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient tail space but enough total free space moves up the span
} -body {
    set l [lreplace [freeSpaceBoth 8 2 2] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 0 1]

test listrep-3.32 {
    Replacement of elements at back with more elements in unshared spanned list
    with insufficient total space reallocates with more room in the tail because
    of realloc()
} -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $end-1 $end 10 11 12 13 14]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 10 11 12 13 14} 1 10]

test listrep-3.33 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lreplace version
} -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 12 5 6 7} 3 3]

test listrep-3.33.1 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lset version
} -body {
    set l [freeSpaceBoth]
    lset l $two 10
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 3 4 5 6 7} 3 3]

test listrep-3.34 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the front half moves the front (smaller) segment
} -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 10 11 5 6 7} 4 3]

test listrep-3.35 {
    Replacement of elements in an unshared spanned list with fewer elements
    in the back half moves the tail (smaller) segment
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 10 7} 3 4]

test listrep-3.36 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (front case)
} -body {
    set l [lreplace [freeSpaceBoth] $one $two 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 3 4 5 6 7} 2 3]

test listrep-3.37 {
    Replacement of elements in an unshared spanned list with more elements
    when both front and back have room should move the smaller segment
    (back case)
} -body {
    set l [lreplace [freeSpaceBoth] $end-2 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 8 9 10 7} 3 2]

test listrep-3.38 {
    Replacement of elements in an unshared spanned list with more elements
    when only front has room
} -body {
    set l [lreplace [freeSpaceBoth 8 3 1] $end-1 $end-1 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 1 2 3 4 5 8 9 10 7} 1 1]

test listrep-3.39 {
    Replacement of elements in an unshared spanned list with more elements
    when only back has room
} -body {
    set l [lreplace [freeSpaceBoth 8 1 3] $one $one 8 9 10]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 2 3 4 5 6 7} 1 1]

test listrep-3.40 {
    Replacement of elements in an unshared spanned list with more elements
    when neither send has enough room by itself
} -body {
    set l [lreplace [freeSpaceBoth] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 1]

test listrep-3.41 {
    Replacement of elements in an unshared spanned list with more elements
    when there is not enough free space results in new allocation. The back
    end has more space because of realloc()
} -body {
    set l [lreplace [freeSpaceBoth 8 1 1] $one $one 8 9 10 11 12]
    validate $l
    list $l [leadSpace $l] [tailSpace $l]
} -result [list {0 8 9 10 11 12 2 3 4 5 6 7} 1 11]

#
# 4.* - tests on shared spanned lists

test listrep-4.1 {
    Inserts in front of shared spanned list with used elements in lead space
    creates new list rep with more lead than tail space - linsert version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [linsert $spanl $zero -1]
    validate $l
    list $master $spanl $l [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $master] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 999] [irange 2 997] [list -1 {*}[irange 2 997]] 1 1 2 2 1]

test listrep-4.1.1 {
    Inserts in front of shared spanned list with used elements in lead space
    creates new list rep with more lead than tail space - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $zero -1 -2]
    validate $l
    list $master $spanl $l [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $master] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 999] [irange 2 997] [list -2 {*}[irange 2 997]] 1 1 2 2 1]

test listrep-4.2 {
    Inserts in front of shared spanned list with orphaned leading elements
    allocate a new list rep with more lead than tail space - linsert version
    TODO - ideally this should garbage collect the orphans and reuse the lead space
    but that needs a "lprepend" command else the listrep operand is shared and hence
    orphans cannot be freed
} -constraints testlistrep -body {
    set master [freeSpaceLead 1000 100]
    set spanl [lrange $master $two $end-2]
    unset master; # So elements at 0, 1 are not used
    set l [linsert $spanl $zero -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [list -1 {*}[irange 2 997]] 0 1 1 1 1]

test listrep-4.2.1 {
    Inserts in front of shared spanned list with orphaned leading elements
    allocate a new list rep with more lead than tail space - lreplace version
    TODO - ideally this should garbage collect the orphans and reuse the lead space
    but that needs a "lprepend" command else the listrep operand is shared and hence
    orphans cannot be freed
} -constraints testlistrep -body {
    set master [freeSpaceLead 1000 100]
    set spanl [lrange $master $two $end-2]
    unset master; # So elements at 0, 1 are not used
    set l [lreplace $spanl $zero -1 -2]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [list -2 {*}[irange 2 997]] 0 1 1 1 1]

test listrep-4.3 {
    Inserts in front of shared spanned list where span is at front of used
    space reuses the same list store - linsert version
} -constraints testlistrep -body {
    set master [freeSpaceLead 1000 100]
    set spanl [lrange $master $zero $end-2]
    set l [linsert $spanl $zero -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpace $l] [tailSpace $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 997] [irange -1 997] 1 99 0 1 3 3]

test listrep-4.3.1 {
    Inserts in front of shared spanned list where span is at front of used
    space reuses the same list store - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceLead 1000 100]
    set spanl [lrange $master $zero $end-2]
    set l [lreplace $spanl $zero -1 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpace $l] [tailSpace $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 997] [irange -1 997] 1 99 0 1 3 3]

test listrep-4.4 {
    Inserts in front of shared spanned list where span is at front of used
    space allocates new listrep if lead space insufficient even if total free space
    is sufficient. New listrep should have more lead space than tail space.
    - linsert version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $zero $end-2]
    set l [linsert $spanl $zero -3 -2 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 997] [irange -3 997] 0 1 1 2 1]

test listrep-4.4.1 {
    Inserts in front of shared spanned list where span is at front of used
    space allocates new listrep if lead space insufficient even if total free space
    is sufficient. New listrep should have more lead space than tail space.
    - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $zero $end-2]
    set l [lreplace $spanl $zero -1 -3 -2 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 0 997] [irange -3 997] 0 1 1 2 1]

test listrep-4.5 {
    Inserts in back of shared spanned list where span is at end of used space
    still allocates a new listrep and trailing space is more than leading space
    - linsert version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $two $end]
    set l [linsert $spanl $end 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 999] [irange 2 1000] 0 1 1 2 1]

test listrep-4.5.1 {
    Inserts in back of shared spanned list where span is at end of used space
    still allocates a new listrep and trailing space is more than leading space
    - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $two $end]
    set l [lreplace $spanl $end+1 $end+1 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 999] [irange 2 1000] 0 1 1 2 1]

test listrep-4.5.2 {
    Inserts in back of shared spanned list where span is at end of used space
    still allocates a new listrep and trailing space is more than leading space
    - lappend version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set l [lrange $master $two $end]
    lappend l 1000
    validate $l
    list $l [sameStore $master $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list  [irange 2 1000] 0 1 1 1]

test listrep-4.5.3 {
    Inserts in back of shared spanned list where span is at end of used space
    still allocates a new listrep and trailing space is more than leading space
    - lset version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set l [lrange $master $two $end]
    lset l $end+1 1000
    validate $l
    list $l [sameStore $master $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list  [irange 2 1000] 0 1 1 1]


test listrep-4.6 {
    Inserts in middle of shared spanned list allocates a new listrep with equal
    lead and tail space - linsert version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $two $end-2]
    set i 200
    set l [linsert $spanl $i 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [spaceEqual $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 201] 1000 [irange 202 997]] 0 1 1 2 1]

test listrep-4.6.1 {
    Inserts in middle of shared spanned list allocates a new listrep with equal
    lead and tail space - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceBoth 1000 2]
    set spanl [lrange $master $two $end-2]
    set i 200
    set l [lreplace $spanl $i -1 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [spaceEqual $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 201] 1000 [irange 202 997]] 0 1 1 2 1]

test listrep-4.7 {
    Deletes from front of shared spanned list do not create a new allocation
    - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $zero $one]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 4 997] 1 1 3 3]

test listrep-4.7.1 {
    Deletes from front of shared spanned list do not create a new allocation
    - lremove version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lremove $spanl $zero $one]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 4 997] 1 1 3 3]

test listrep-4.7.2 {
    Deletes from front of shared spanned list do not create a new allocation
    - lrange version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lrange $spanl $two $end]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 4 997] 1 1 3 3]

test listrep-4.7.3 {
    Deletes from front of shared spanned list do not create a new allocation
    - lassign version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lassign $spanl e]
    validate $l
    list $e $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list 2 [irange 2 997] [irange 3 997] 1 1 3 3]

test listrep-4.7.4 {
    Deletes from front of shared spanned list do not create a new allocation
    - lpop version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    set e [lpop l $zero]
    validate $l
    list $e $l [sameStore $master $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list 2 [irange 3 997] 1 1 2]

test listrep-4.8 {
    Deletes from end of shared spanned list do not create a new allocation
    - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-1 $end]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 2 995] 1 1 3 3]

test listrep-4.8.1 {
    Deletes from end of shared spanned list do not create a new allocation
    - lremove version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lremove $spanl $end-1 $end]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 2 995] 1 1 3 3]

test listrep-4.8.2 {
    Deletes from end of shared spanned list do not create a new allocation
    - lrange version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lrange $spanl 0 $end-2]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [irange 2 995] 1 1 3 3]

test listrep-4.8.3 {
    Deletes from end of shared spanned list do not create a new allocation
    - lpop version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    set e [lpop l]
    validate $l
    list $e $l [sameStore $master $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list 997 [irange 2 996] 1 1 2]

test listrep-4.9 {
    Deletes from middle of shared spanned list creates a new allocation with
    equal free space at front and back - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set i 500
    set l [lreplace $spanl $i $i]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [spaceEqual $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 501] [irange 503 997]] 0 1 1 2 1]

test listrep-4.9.1 {
    Deletes from middle of shared spanned list creates a new allocation with
    equal free space at front and back - lremove version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set i 500
    set l [lremove $spanl $i $i]
    validate $l
    list $spanl $l [sameStore $spanl $l] [hasSpan $l] [spaceEqual $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 501] [irange 503 997]] 0 1 1 2 1]

test listrep-4.9.2 {
    Deletes from middle of shared spanned list creates a new allocation with
    equal free space at front and back - lpop version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    set i 500
    set e [lpop l $i]
    validate $l
    list $e $l [sameStore $master $l] [hasSpan $l] [spaceEqual $l] [repStoreRefCount $l]
} -result [list 502 [concat [irange 2 501] [irange 503 997]] 0 1 1 1]

test listrep-4.10 {
    Replacements with same number of elements at front of shared spanned list
    create a new allocation with more space in front - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $zero $one -2 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat {-2 -1} [irange 4 997]] 0 1 1 2 1]

test listrep-4.10.1 {
    Replacements with same number of elements at front of shared spanned list
    create a new allocation with exact size
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    lset l $zero -1
    validate $l
    list $l [sameStore $master $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list [concat {-1} [irange 3 997]] 0 0 1]

test listrep-4.11 {
    Replacements with fewer elements at front of shared spanned list
    create a new allocation with more space in front
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $zero $one -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat {-1} [irange 4 997]] 0 1 1 2 1]

test listrep-4.12 {
    Replacements with more elements at front of shared spanned list
    create a new allocation with more space in front
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $zero $one -3 -2 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [leadSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat {-3 -2 -1} [irange 4 997]] 0 1 1 2 1]

test listrep-4.13 {
    Replacements with same number of elements at back of shared spanned list
    create a new allocation with more space in back - lreplace version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-1 $end 1000 1001]
    validate $l
    list $spanl $l [sameStore $spanl $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 995] {1000 1001}] 0 1 1 2 1]

test listrep-4.13.1 {
    Replacements with same number of elements at back of shared spanned list
    create a new exact allocation with no span - lset version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    lset l $end 1000
    validate $l
    list $l [sameStore $master $l] [tailSpace $l] [hasSpan $l] [repStoreRefCount $l]
} -result [list [concat [irange 2 996] {1000}] 0 0 0 1]

test listrep-4.14 {
    Replacements with fewer elements at back of shared spanned list
    create a new allocation with more space in back
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-1 $end 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 995] {1000}] 0 1 1 2 1]

test listrep-4.15 {
    Replacements with more elements at back of shared spanned list
    create a new allocation with more space in back
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-1 $end 1000 1001 1002]
    validate $l
    list $spanl $l [sameStore $spanl $l] [tailSpaceMore $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 995] {1000 1001 1002}] 0 1 1 2 1]

test listrep-4.16 {
    Replacements with same number of elements in middle of shared spanned list
    create a new allocation with equal lead and tail sapce
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $one $two -2 -1]
    validate $l
    list $spanl $l [sameStore $spanl $l] [spaceEqual $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat {2 -2 -1} [irange 5 997]] 0 1 1 2 1]

test listrep-4.16.1 {
    Replacements with same number of elements in middle of shared spanned list
    create a new exact allocation - lset version
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set l [lrange $master $two $end-2]
    lset l $one -2
    validate $l
    list $l [sameStore $master $l] [hasSpan $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [concat {2 -2} [irange 4 997]] 0 0 0 1]

test listrep-4.17 {
    Replacements with fewer elements in middle of shared spanned list
    create a new allocation with equal lead and tail sapce
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-2 $end-1 1000]
    validate $l
    list $spanl $l [sameStore $spanl $l] [spaceEqual $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 994] {1000 997}] 0 1 1 2 1]

test listrep-4.18 {
    Replacements with more elements in middle of shared spanned list
    create a new allocation with equal lead and tail sapce
} -constraints testlistrep -body {
    set master [freeSpaceNone 1000]
    set spanl [lrange $master $two $end-2]
    set l [lreplace $spanl $end-2 $end-1 1000 1001 1002]
    validate $l
    list $spanl $l [sameStore $spanl $l] [spaceEqual $l] [hasSpan $l] [repStoreRefCount $spanl] [repStoreRefCount $l]
} -result [list [irange 2 997] [concat [irange 2 994] {1000 1001 1002 997}] 0 1 1 2 1]

# 5.* - tests on shared Tcl_Obj
# Tests when Tcl_Obj is shared but listrep is not. This is to ensure that
# checks for shared values check the Tcl_Obj reference counts in addition to
# the list internal representation reference counts. Probably some or all
# cases are already covered elsewhere but easier to just test than look.
test listrep-5.1 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
    list representation only modifies the target object - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    set l2 $l
    set same [sameStore $l $l2]
    lappend l 8
    list $same $l $l2 [sameStore $l $l2]
} -result [list 1 [irange 0 8] [irange 0 7] 0]

test listrep-5.1.1 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
    list representation only modifies the target object - lset version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    set l2 $l
    set same [sameStore $l $l2]
    lset l $end+1 8
    list $same $l $l2 [sameStore $l $l2]
} -result [list 1 [irange 0 8] [irange 0 7] 0]

test listrep-5.1.2 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanless
    list representation only modifies the target object - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone]
    set l2 $l
    set same [sameStore $l $l2]
    lpop l
    list $same $l $l2 [sameStore $l $l2] [hasSpan $l]
} -result [list 1 [irange 0 6] [irange 0 7] 0 0]

test listrep-5.2 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
    list representation only modifies the target object - lappend version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 1000 10 10]
    set l2 $l
    set same [sameStore $l $l2]
    lappend l 1000
    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
} -result [list 1 [irange 0 1000] [irange 0 999] 0 1 1]

test listrep-5.2.1 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
    list representation only modifies the target object - lset version
} -constraints testlistrep -body {
    set l [freeSpaceBoth 1000 10 10]
    set l2 $l
    set same [sameStore $l $l2]
    lset l $end+1 1000
    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
} -result [list 1 [irange 0 1000] [irange 0 999] 0 1 1]

test listrep-5.2.2 {
    Verify that operation on a shared Tcl_Obj with a single-ref, spanned
    list representation only modifies the target object - lpop version
} -constraints testlistrep -body {
    set l [freeSpaceNone 1000]
    set l2 $l
    set same [sameStore $l $l2]
    lpop l
    list $same $l $l2 [sameStore $l $l2] [hasSpan $l] [hasSpan $l2]
} -result [list 1 [irange 0 998] [irange 0 999] 1 1 0]

#
# 6.* - tests when lists contain zombies.
# The list implementation does lazy freeing in some cases so the list store
# contain Tcl_Obj's that are not actually referenced by any list (zombies).
# These are to be freed next time the list store is modified by a list
# operation as long as it is no longer shared.
test listrep-6.1 {
    Verify that zombies are freed up - linsert at front
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [linsert $l[set l {}] $zero -1]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [list -1 {*}[irange 10 209]] 1 9 10 1]

test listrep-6.1.1 {
    Verify that zombies are freed up - linsert in middle
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [linsert $l[set l {}] $one -1]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [list 10 -1 {*}[irange 11 209]] 1 9 10 1]

test listrep-6.1.2 {
    Verify that zombies are freed up - linsert at end
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [linsert $l[set l {}] $end 210]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 10 210] 1 10 9 1]

test listrep-6.2 {
    Verify that zombies are freed up - lrange version (whole)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lrange $l[set l {}] $zero $end]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 10 209] 1 10 10 1]

test listrep-6.2.1 {
    Verify that zombies are freed up - lrange version (subrange)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lrange $l[set l {}] $one $end-1]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 11 208] 1 11 11 1]

test listrep-6.3 {
    Verify that zombies are freed up - lassign version
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lassign $l[set l {}] e]
    list $e $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 10 [irange 11 209] 1 11 10 1]

test listrep-6.4 {
    Verify that zombies are freed up - lremove version (front)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lremove $l[set l {}] $zero]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 11 209] 1 11 10 1]

test listrep-6.4.1 {
    Verify that zombies are freed up - lremove version (back)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lremove $l[set l {}] $end]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 10 208] 1 10 11 1]

test listrep-6.5 {
    Verify that zombies are freed up - lreplace at front
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lreplace $l[set l {}] $zero $one -3 -2 -1]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [list -3 -2 -1 {*}[irange 12 209]] 1 9 10 1]

test listrep-6.5.1 {
    Verify that zombies are freed up - lreplace at back
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    # set l {} is for reference counts to drop to 1
    set l [lreplace $l[set l {}] $end-1 $end -1 -2 -3]
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [list {*}[irange 10 207] -1 -2 -3] 1 10 9 1]

test listrep-6.6 {
    Verify that zombies are freed up - lappend
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    lappend l 210
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 10 210] 1 10 9 1]

test listrep-6.7 {
    Verify that zombies are freed up - lpop version (front)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    set e [lpop l $zero]
    list $e $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 10 [irange 11 209] 1 11 10 1]

test listrep-6.7.1 {
    Verify that zombies are freed up - lpop version (back)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    set e [lpop l]
    list $e $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list 209 [irange 10 208] 1 10 11 1]

test listrep-6.8 {
    Verify that zombies are freed up - lset version
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    lset l $zero -1
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [list -1 {*}[irange 11 209]] 1 10 10 1]

test listrep-6.8.1 {
    Verify that zombies are freed up - lset version (back)
} -constraints testlistrep -body {
    set l [zombieSample 200 10 10]
    set addr [storeAddress $l]
    lset l $end+1 210
    list $l [expr {$addr == [storeAddress $l]}] [leadSpace $l] [tailSpace $l] [repStoreRefCount $l]
} -result [list [irange 10 210] 1 10 9 1]


# All done
::tcltest::cleanupTests

return
Changes to tests/lrepeat.test.
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0 a b c
    }
    -result {}
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
     lrepeat 0x10000000 a b c d e f g h
} -returnCodes error -match glob -result *

## Okay
test lrepeat-2.1 {normal cases} {
    lrepeat 10 a
} {a a a a a a a a a a}







|







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0 a b c
    }
    -result {}
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -constraints knownBug -body {
     lrepeat 0x10000000 a b c d e f g h
} -returnCodes error -match glob -result *

## Okay
test lrepeat-2.1 {normal cases} {
    lrepeat 10 a
} {a a a a a a a a a a}
Changes to tools/tsdPerf.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#include <tcl.h>

extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;

static Tcl_ThreadDataKey key;

typedef struct {
    Tcl_WideInt value;
} TsdPerf;


static int
tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
    Tcl_WideInt i;

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

    if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &i)) {
	return TCL_ERROR;
    }

    perf->value = i;

    return TCL_OK;
}

static int
tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));


    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(perf->value));

    return TCL_OK;
}












|


















|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
#include <tcl.h>

extern DLLEXPORT Tcl_LibraryInitProc Tsdperf_Init;

static Tcl_ThreadDataKey key;

typedef struct {
    Tcl_WideInt value;
} TsdPerf;


static int
tsdPerfSetObjCmd(void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
    Tcl_WideInt i;

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

    if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &i)) {
	return TCL_ERROR;
    }

    perf->value = i;

    return TCL_OK;
}

static int
tsdPerfGetObjCmd(void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));


    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(perf->value));

    return TCL_OK;
}
Changes to unix/tclEpollNotfy.c.
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 * Side effects:
 *	If no initNotifierProc notifier hook exists, PlatformEventsInit is
 *	called.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    PlatformEventsInit();
    return tsdPtr;
}







|







146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
 * Side effects:
 *	If no initNotifierProc notifier hook exists, PlatformEventsInit is
 *	called.
 *
 *----------------------------------------------------------------------
 */

void *
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    PlatformEventsInit();
    return tsdPtr;
}
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
    if (tsdPtr->triggerEventFd) {
	close(tsdPtr->triggerEventFd);







|







271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
    if (tsdPtr->triggerEventFd) {
	close(tsdPtr->triggerEventFd);
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));







|







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    ClientData clientData,	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,







|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    void *clientData,	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to unix/tclKqueueNotfy.c.
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;







|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeNotifier(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
 *	  fd(2), registering interest for TCL_READABLE on it via Platform-
 *	  EventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512 kevents.
 *
 *----------------------------------------------------------------------
 */

ClientData
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int i, fdFl;
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);







|







326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
 *	  fd(2), registering interest for TCL_READABLE on it via Platform-
 *	  EventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512 kevents.
 *
 *----------------------------------------------------------------------
 */

void *
TclpInitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int i, fdFl;
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));







|







514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL);
    int isNew = (filePtr == NULL);

    if (isNew) {
	filePtr = (FileHandler *) Tcl_Alloc(sizeof(FileHandler));
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    ClientData clientData,	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,







|







783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    Tcl_ThreadId threadId,	/* Target thread. */
    void *clientData,	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
Changes to unix/tclSelectNotfy.c.
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(ClientData),	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,







|







917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
 *----------------------------------------------------------------------
 */

int
TclAsyncNotifier(
    int sigNumber,		/* Signal number. */
    TCL_UNUSED(Tcl_ThreadId),	/* Target thread. */
    TCL_UNUSED(void *),	/* Notifier data. */
    int *flagPtr,		/* Flag to mark. */
    int value)			/* Value of mark. */
{
#if TCL_THREADS
    /*
     * WARNING:
     * This code most likely runs in a signal handler. Thus,
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;
    int i, fds[2], receivePipe, ret;
    long found;







|







982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
    TCL_UNUSED(void *))
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;
    int i, fds[2], receivePipe, ret;
    long found;
Changes to unix/tclUnixCompat.c.
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
static int		CopyHostent(struct hostent *tgtPtr, char *buf,
			    int buflen);
static int		CopyString(const char *src, char *buf, int buflen);

#endif

#ifdef NEED_PW_CLEANER
static void		FreePwBuf(ClientData dummy);
#endif
#ifdef NEED_GR_CLEANER
static void		FreeGrBuf(ClientData dummy);
#endif
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --







|


|







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
static int		CopyHostent(struct hostent *tgtPtr, char *buf,
			    int buflen);
static int		CopyString(const char *src, char *buf, int buflen);

#endif

#ifdef NEED_PW_CLEANER
static void		FreePwBuf(void *dummy);
#endif
#ifdef NEED_GR_CLEANER
static void		FreeGrBuf(void *dummy);
#endif
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --
Changes to unix/tclUnixPipe.c.
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_PidObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    PipeState *pipePtr;
    size_t i;







|







1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_PidObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    PipeState *pipePtr;
    size_t i;
Changes to unix/tclUnixSock.c.
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
    TcpState *statePtr;
    int fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
    TcpFdList fds;		/* The file descriptors of the sockets. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    int interest;		/* Event types of interest */

    /*
     * Only needed for server sockets







<
<







49
50
51
52
53
54
55


56
57
58
59
60
61
62
    TcpState *statePtr;
    int fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */


    TcpFdList fds;		/* The file descriptors of the sockets. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    int interest;		/* Event types of interest */

    /*
     * Only needed for server sockets
76
77
78
79
80
81
82


83
84
85
86
87
88
89
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */


};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */








>
>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	asynchroneous connects.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */







|







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	asynchronous connects.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), TCL_INDEX_NONE);
        }
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
        Tcl_DStringAppend(dsPtr,
                GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE);
        return TCL_OK;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
        address peername;
        socklen_t size = sizeof(peername);







|
|







873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), TCL_INDEX_NONE);
        }
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", TCL_INDEX_NONE);
        return TCL_OK;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
        address peername;
        socklen_t size = sizeof(peername);
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);

        if (error != 0) {
            SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
        }

        /*
         * We need to forward the writable event that brought us here, bcasue
         * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
         * writable state from the socket, and so a subsequent select() on
         * behalf of a script level [fileevent] would not fire. It doesn't
         * hurt that this is also called in the successful case and will save
         * the event mechanism one roundtrip through select().
         */








|







1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);

        if (error != 0) {
            SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
        }

        /*
         * We need to forward the writable event that brought us here, because
         * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
         * writable state from the socket, and so a subsequent select() on
         * behalf of a script level [fileevent] would not fire. It doesn't
         * hurt that this is also called in the successful case and will save
         * the event mechanism one roundtrip through select().
         */

Changes to unix/tclUnixTest.c.
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilehandlerCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Pipe *pipePtr;
    int i, mask, timeout;
    static int initialized = 0;







|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilehandlerCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Pipe *pipePtr;
    int i, mask, timeout;
    static int initialized = 0;
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
TestFileHandlerProc(
    ClientData clientData,	/* Points to a Pipe structure. */
    int mask)			/* Indicates which events happened:
				 * TCL_READABLE or TCL_WRITABLE. */
{
    Pipe *pipePtr = (Pipe *)clientData;

    if (mask & TCL_READABLE) {
	pipePtr->readCount++;







|







306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
TestFileHandlerProc(
    void *clientData,	/* Points to a Pipe structure. */
    int mask)			/* Indicates which events happened:
				 * TCL_READABLE or TCL_WRITABLE. */
{
    Pipe *pipePtr = (Pipe *)clientData;

    if (mask & TCL_READABLE) {
	pipePtr->readCount++;
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilewaitCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    int mask, result, timeout;
    Tcl_Channel channel;
    int fd;
    ClientData data;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout");
	return TCL_ERROR;
    }
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (channel == NULL) {







|







|







339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilewaitCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    int mask, result, timeout;
    Tcl_Channel channel;
    int fd;
    void *data;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout");
	return TCL_ERROR;
    }
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (channel == NULL) {
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
    } else {
	Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]),
		"\": must be readable, writable, or both", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(channel,
	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
	    (ClientData*) &data) != TCL_OK) {
	Tcl_AppendResult(interp, "couldn't get channel file", NULL);
	return TCL_ERROR;
    }
    fd = PTR2INT(data);
    if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) {
	return TCL_ERROR;
    }







|







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
    } else {
	Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]),
		"\": must be readable, writable, or both", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(channel,
	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
	    (void **) &data) != TCL_OK) {
	Tcl_AppendResult(interp, "couldn't get channel file", NULL);
	return TCL_ERROR;
    }
    fd = PTR2INT(data);
    if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) {
	return TCL_ERROR;
    }
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfindexecutableCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Obj *saveName;

    if (objc != 2) {







|







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

static int
TestfindexecutableCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Obj *saveName;

    if (objc != 2) {
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestforkCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    pid_t pid;

    if (objc != 1) {







|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestforkCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    pid_t pid;

    if (objc != 1) {
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 *	Sets up an signal and async handlers.
 *
 *----------------------------------------------------------------------
 */

static int
TestalarmCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
#ifdef SA_RESTART
    unsigned int sec = 1;
    struct sigaction action;







|







495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 *	Sets up an signal and async handlers.
 *
 *----------------------------------------------------------------------
 */

static int
TestalarmCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
#ifdef SA_RESTART
    unsigned int sec = 1;
    struct sigaction action;
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
 *	Resets the value of gotsig back to '0'.
 *
 *----------------------------------------------------------------------
 */

static int
TestgotsigCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *))
{
    Tcl_AppendResult(interp, gotsig, NULL);
    gotsig = "0";
    return TCL_OK;







|







573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
 *	Resets the value of gotsig back to '0'.
 *
 *----------------------------------------------------------------------
 */

static int
TestgotsigCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *))
{
    Tcl_AppendResult(interp, gotsig, NULL);
    gotsig = "0";
    return TCL_OK;
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
 *	Changes permissions of specified files.
 *
 *---------------------------------------------------------------------------
 */

static int
TestchmodCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    int i, mode;

    if (objc < 2) {







|







604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
 *	Changes permissions of specified files.
 *
 *---------------------------------------------------------------------------
 */

static int
TestchmodCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    int i, mode;

    if (objc < 2) {
Changes to unix/tclXtNotify.c.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
				 * time FileHandlerEventProc was called for
				 * this file. */
    XtInputId read;		/* Xt read callback handle. */
    XtInputId write;		/* Xt write callback handle. */
    XtInputId except;		/* Xt exception callback handle. */
    Tcl_FileProc *proc;		/* Procedure to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */







|







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
				 * time FileHandlerEventProc was called for
				 * this file. */
    XtInputId read;		/* Xt read callback handle. */
    XtInputId write;		/* Xt write callback handle. */
    XtInputId except;		/* Xt exception callback handle. */
    Tcl_FileProc *proc;		/* Procedure to call, in the style of
				 * Tcl_CreateFileHandler. */
    void *clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
/*
 * Static routines defined in this file.
 */

static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		FileProc(XtPointer clientData, int *source,
			    XtInputId *id);
static void		NotifierExitHandler(ClientData clientData);
static void		TimerProc(XtPointer clientData, XtIntervalId *id);
static void		CreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, ClientData clientData);
static void		DeleteFileHandler(int fd);
static void		SetTimer(const Tcl_Time * timePtr);
static int		WaitForEvent(const Tcl_Time * timePtr);

/*
 * Functions defined in this file for use by users of the Xt Notifier:
 */







|


|







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
/*
 * Static routines defined in this file.
 */

static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		FileProc(XtPointer clientData, int *source,
			    XtInputId *id);
static void		NotifierExitHandler(void *clientData);
static void		TimerProc(XtPointer clientData, XtIntervalId *id);
static void		CreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, void *clientData);
static void		DeleteFileHandler(int fd);
static void		SetTimer(const Tcl_Time * timePtr);
static int		WaitForEvent(const Tcl_Time * timePtr);

/*
 * Functions defined in this file for use by users of the Xt Notifier:
 */
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
 *	Destroys the notifier window.
 *
 *----------------------------------------------------------------------
 */

static void
NotifierExitHandler(
    TCL_UNUSED(ClientData))
{
    if (notifier.currentTimeout != 0) {
	XtRemoveTimeOut(notifier.currentTimeout);
    }
    for (; notifier.firstFileHandlerPtr != NULL; ) {
	Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
    }







|







225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
 *	Destroys the notifier window.
 *
 *----------------------------------------------------------------------
 */

static void
NotifierExitHandler(
    TCL_UNUSED(void *))
{
    if (notifier.currentTimeout != 0) {
	XtRemoveTimeOut(notifier.currentTimeout);
    }
    for (; notifier.firstFileHandlerPtr != NULL; ) {
	Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
    }
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Procedure to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    FileHandler *filePtr;

    if (!initialized) {
	InitNotifier();
    }








|







335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Procedure to call for each selected
				 * event. */
    void *clientData)	/* Arbitrary data to pass to proc. */
{
    FileHandler *filePtr;

    if (!initialized) {
	InitNotifier();
    }

Changes to unix/tclXtTest.c.
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventloopCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static int *framePtr = NULL;/* Pointer to integer on stack frame of
				 * innermost invocation of the "wait"
				 * subcommand. */







|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventloopCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static int *framePtr = NULL;/* Pointer to integer on stack frame of
				 * innermost invocation of the "wait"
				 * subcommand. */
Changes to win/tclWinConsole.c.
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
				      * pointer. */
} ConsoleEvent;

/*
 * Declarations for functions used only in this file.
 */

static int	ConsoleBlockModeProc(ClientData instanceData, int mode);
static void	ConsoleCheckProc(ClientData clientData, int flags);
static int	ConsoleCloseProc(ClientData instanceData,
		    Tcl_Interp *interp, int flags);
static int	ConsoleEventProc(Tcl_Event *evPtr, int flags);
static void	ConsoleExitHandler(ClientData clientData);
static int	ConsoleGetHandleProc(ClientData instanceData,
		    int direction, ClientData *handlePtr);
static int	ConsoleGetOptionProc(ClientData instanceData,
		    Tcl_Interp *interp, const char *optionName,
		    Tcl_DString *dsPtr);
static void	ConsoleInit(void);
static int	ConsoleInputProc(ClientData instanceData, char *buf,
		    int toRead, int *errorCode);
static int	ConsoleOutputProc(ClientData instanceData,
		    const char *buf, int toWrite, int *errorCode);
static int	ConsoleSetOptionProc(ClientData instanceData,
		    Tcl_Interp *interp, const char *optionName,
		    const char *value);
static void	ConsoleSetupProc(ClientData clientData, int flags);
static void	ConsoleWatchProc(ClientData instanceData, int mask);
static void	ProcExitHandler(ClientData clientData);
static void	ConsoleThreadActionProc(ClientData instanceData, int action);
static DWORD	ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
		    RingSizeT nChars, RingSizeT *nCharsReadPtr);
static DWORD	WriteConsoleChars(HANDLE hConsole,
		    const WCHAR *lpBuffer, RingSizeT nChars,
		    RingSizeT *nCharsWritten);
static void	RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity);
static void	RingBufferClear(RingBuffer *ringPtr);







|
|
|


|
|
|
|



|

|

|


|
|
|
|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
				      * pointer. */
} ConsoleEvent;

/*
 * Declarations for functions used only in this file.
 */

static int	ConsoleBlockModeProc(void *instanceData, int mode);
static void	ConsoleCheckProc(void *clientData, int flags);
static int	ConsoleCloseProc(void *instanceData,
		    Tcl_Interp *interp, int flags);
static int	ConsoleEventProc(Tcl_Event *evPtr, int flags);
static void	ConsoleExitHandler(void *clientData);
static int	ConsoleGetHandleProc(void *instanceData,
		    int direction, void **handlePtr);
static int	ConsoleGetOptionProc(void *instanceData,
		    Tcl_Interp *interp, const char *optionName,
		    Tcl_DString *dsPtr);
static void	ConsoleInit(void);
static int	ConsoleInputProc(void *instanceData, char *buf,
		    int toRead, int *errorCode);
static int	ConsoleOutputProc(void *instanceData,
		    const char *buf, int toWrite, int *errorCode);
static int	ConsoleSetOptionProc(void *instanceData,
		    Tcl_Interp *interp, const char *optionName,
		    const char *value);
static void	ConsoleSetupProc(void *clientData, int flags);
static void	ConsoleWatchProc(void *instanceData, int mask);
static void	ProcExitHandler(void *clientData);
static void	ConsoleThreadActionProc(void *instanceData, int action);
static DWORD	ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
		    RingSizeT nChars, RingSizeT *nCharsReadPtr);
static DWORD	WriteConsoleChars(HANDLE hConsole,
		    const WCHAR *lpBuffer, RingSizeT nChars,
		    RingSizeT *nCharsWritten);
static void	RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity);
static void	RingBufferClear(RingBuffer *ringPtr);
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
 *	Removes the console event source.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleExitHandler(
    TCL_UNUSED(ClientData))
{
    Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *







|







666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
 *	Removes the console event source.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleExitHandler(
    TCL_UNUSED(void *))
{
    Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    TCL_UNUSED(ClientData))
{
    AcquireSRWLockExclusive(&gConsoleLock);
    gInitialized = 0;
    ReleaseSRWLockExclusive(&gConsoleLock);
}

/*







|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    TCL_UNUSED(void *))
{
    AcquireSRWLockExclusive(&gConsoleLock);
    gInitialized = 0;
    ReleaseSRWLockExclusive(&gConsoleLock);
}

/*
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
ConsoleSetupProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleChannelInfo *chanInfoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;

    if (!(flags & TCL_FILE_EVENTS)) {







|







755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
ConsoleSetupProc(
    TCL_UNUSED(void *),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleChannelInfo *chanInfoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;

    if (!(flags & TCL_FILE_EVENTS)) {
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleCheckProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleChannelInfo *chanInfoPtr;
    Tcl_ThreadId me;
    int needEvent;

    if (!(flags & TCL_FILE_EVENTS)) {







|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleCheckProc(
    TCL_UNUSED(void *),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleChannelInfo *chanInfoPtr;
    Tcl_ThreadId me;
    int needEvent;

    if (!(flags & TCL_FILE_EVENTS)) {
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleBlockModeProc(
    ClientData instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    /*
     * Consoles on Windows can not be switched between blocking and







|







920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleBlockModeProc(
    void *instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    /*
     * Consoles on Windows can not be switched between blocking and
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
 *	Closes the physical channel.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleCloseProc(
    ClientData instanceData,	/* Pointer to ConsoleChannelInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    int errorCode = 0;
    ConsoleChannelInfo **nextPtrPtr;







|







960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
 *	Closes the physical channel.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleCloseProc(
    void *instanceData,	/* Pointer to ConsoleChannelInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    int errorCode = 0;
    ConsoleChannelInfo **nextPtrPtr;
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
 * Side effects:
 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleInputProc(
    ClientData instanceData,	/* Console state. */
    char *bufPtr,		/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;







|







1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
 * Side effects:
 *	Reads input from the actual channel.
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleInputProc(
    void *instanceData,	/* Console state. */
    char *bufPtr,		/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
 * Side effects:
 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleOutputProc(
    ClientData instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    RingSizeT numWritten;







|







1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
 * Side effects:
 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleOutputProc(
    void *instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    ConsoleHandleInfo *handleInfoPtr;
    RingSizeT numWritten;
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleWatchProc(
    ClientData instanceData,	/* Console state. */
    int newMask)		/* What events to watch for, one of
				 * of TCL_READABLE, TCL_WRITABLE
				 */
{
    ConsoleChannelInfo **nextPtrPtr, *ptr;
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int oldMask = chanInfoPtr->watchMask;







|







1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleWatchProc(
    void *instanceData,	/* Console state. */
    int newMask)		/* What events to watch for, one of
				 * of TCL_READABLE, TCL_WRITABLE
				 */
{
    ConsoleChannelInfo **nextPtrPtr, *ptr;
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int oldMask = chanInfoPtr->watchMask;
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetHandleProc(
    ClientData instanceData,	/* The console state. */
    TCL_UNUSED(int) /*direction*/,
    ClientData *handlePtr)	/* Where to store the handle. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	return TCL_ERROR;
    } else {
	*handlePtr = chanInfoPtr->handle;







|

|







1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetHandleProc(
    void *instanceData,	/* The console state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
	return TCL_ERROR;
    } else {
	*handlePtr = chanInfoPtr->handle;
2000
2001
2002
2003
2004
2005
2006

2007
2008
2009
2010
2011
2012
2013
{
    ConsoleHandleInfo *handleInfoPtr;
    DWORD consoleMode;


    handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr));
    memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));

    handleInfoPtr->console = consoleHandle;
    InitializeSRWLock(&handleInfoPtr->lock);
    InitializeConditionVariable(&handleInfoPtr->consoleThreadCV);
    InitializeConditionVariable(&handleInfoPtr->interpThreadCV);
    RingBufferInit(&handleInfoPtr->buffer, CONSOLE_BUFFER_SIZE);
    handleInfoPtr->lastError = 0;
    handleInfoPtr->permissions = permissions;







>







2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
{
    ConsoleHandleInfo *handleInfoPtr;
    DWORD consoleMode;


    handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr));
    memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
    memset(handleInfoPtr, 0, sizeof(*handleInfoPtr));
    handleInfoPtr->console = consoleHandle;
    InitializeSRWLock(&handleInfoPtr->lock);
    InitializeConditionVariable(&handleInfoPtr->consoleThreadCV);
    InitializeConditionVariable(&handleInfoPtr->interpThreadCV);
    RingBufferInit(&handleInfoPtr->buffer, CONSOLE_BUFFER_SIZE);
    handleInfoPtr->lastError = 0;
    handleInfoPtr->permissions = permissions;
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleThreadActionProc(
    ClientData instanceData,
    int action)
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    /* No need for any locks as no other thread will be writing to it */
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	ConsoleInit(); /* Needed to set up event source handlers for this thread */







|







2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleThreadActionProc(
    void *instanceData,
    int action)
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;

    /* No need for any locks as no other thread will be writing to it */
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	ConsoleInit(); /* Needed to set up event source handlers for this thread */
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
 *	May modify an option on a console. Sets Error message if needed (by
 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleSetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int len = strlen(optionName);
    int vlen = strlen(value);







|







2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
 *	May modify an option on a console. Sets Error message if needed (by
 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */
static int
ConsoleSetOptionProc(
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int len = strlen(optionName);
    int vlen = strlen(value);
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    unsigned int len;







|







2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetOptionProc(
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    unsigned int len;
Changes to win/tclWinInit.c.
509
510
511
512
513
514
515






516

517
518
519
520
521
522
523
	if (ptr != NULL) {
	    Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE);
	}
	if (Tcl_DStringLength(&ds) > 0) {
	    Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
		    TCL_GLOBAL_ONLY);
	} else {






	    Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);

	}
    }

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.







>
>
>
>
>
>
|
>







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
	if (ptr != NULL) {
	    Tcl_DStringAppend(&ds, ptr, TCL_INDEX_NONE);
	}
	if (Tcl_DStringLength(&ds) > 0) {
	    Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
		    TCL_GLOBAL_ONLY);
	} else {
            /* None of HOME, HOMEDRIVE, HOMEPATH exists. Try USERPROFILE */
            ptr = Tcl_GetVar2(interp, "env", "USERPROFILE", TCL_GLOBAL_ONLY);
            if (ptr != NULL && ptr[0]) {
                Tcl_SetVar2(interp, "env", "HOME", ptr, TCL_GLOBAL_ONLY);
            } else {
                /* Last resort */
                Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
            }
	}
    }

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
Changes to win/tclWinSock.c.
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
    TcpState *statePtr;
    SOCKET fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this socket. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
    struct TcpFdList *sockets;	/* Windows SOCKET handle. */
    int flags;			/* Bit field comprised of the flags described
				 * below. */
    int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
				 * indicate which events are interesting. */
    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,







<
<







121
122
123
124
125
126
127


128
129
130
131
132
133
134
    TcpState *statePtr;
    SOCKET fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this socket. */


    struct TcpFdList *sockets;	/* Windows SOCKET handle. */
    int flags;			/* Bit field comprised of the flags described
				 * below. */
    int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
				 * indicate which events are interesting. */
    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169


170
171
172
173
174
175
176
    volatile int acceptEventCount;
				/* Count of the current number of FD_ACCEPTs
				 * that have arrived and not yet processed.
				 * Set by notifier thread, access must be
				 * protected by semaphore */
    Tcl_TcpAcceptProc *acceptProc;
				/* Proc to call on accept. */
    ClientData acceptProcData;	/* The data for the accept proc. */

    /*
     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int connectError;		/* Cache status of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
    volatile int notifierConnectError;
				/* Async connect error set by notifier thread.
				 * This error is still a windows error code.
				 * Access must be protected by semaphore */
    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
				 * list. */


};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */








|

















>
>







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    volatile int acceptEventCount;
				/* Count of the current number of FD_ACCEPTs
				 * that have arrived and not yet processed.
				 * Set by notifier thread, access must be
				 * protected by semaphore */
    Tcl_TcpAcceptProc *acceptProc;
				/* Proc to call on accept. */
    void *acceptProcData;	/* The data for the accept proc. */

    /*
     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int connectError;		/* Cache status of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
    volatile int notifierConnectError;
				/* Async connect error set by notifier thread.
				 * This error is still a windows error code.
				 * Access must be protected by semaphore */
    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
				 * list. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
 * Static routines for this file:
 */

static int		TcpConnect(Tcl_Interp *interp,
			    TcpState *state);
static void		InitSockets(void);
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
static void		TcpThreadActionProc(ClientData instanceData,
			    int action);
static int		TcpCloseProc(void *, Tcl_Interp *);

static Tcl_EventCheckProc	SocketCheckProc;
static Tcl_EventProc		SocketEventProc;
static Tcl_EventSetupProc	SocketSetupProc;
static Tcl_DriverBlockModeProc	TcpBlockModeProc;







|










|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
 * Static routines for this file:
 */

static int		TcpConnect(Tcl_Interp *interp,
			    TcpState *state);
static void		InitSockets(void);
static TcpState *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(void *clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		WaitForSocketEvent(TcpState *statePtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
static void		TcpThreadActionProc(void *instanceData,
			    int action);
static int		TcpCloseProc(void *, Tcl_Interp *);

static Tcl_EventCheckProc	SocketCheckProc;
static Tcl_EventProc		SocketEventProc;
static Tcl_EventSetupProc	SocketSetupProc;
static Tcl_DriverBlockModeProc	TcpBlockModeProc;
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&inDs), TCL_INDEX_NONE,
			TCL_ENCODING_NOCOMPLAIN, &ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);







|
|







384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_ExternalToUtfDStringEx(NULL, Tcl_DStringValue(&inDs),
			TCL_INDEX_NONE, TCL_ENCODING_NOCOMPLAIN, &ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    Tcl_MutexUnlock(&socketMutex);

    if (SocketsEnabled()) {
	return TCL_OK;
    }
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"sockets are not available on this system", -1));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *







|







458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
    Tcl_MutexUnlock(&socketMutex);

    if (SocketsEnabled()) {
	return TCL_OK;
    }
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"sockets are not available on this system", TCL_INDEX_NONE));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
 *	Sets the device into blocking or nonblocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
        CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *







|









|







540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
 *	Sets the device into blocking or nonblocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    void *instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
	CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	asynchroneous connect.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */







|







581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	asynchronous connect.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
	 * Get the statePtr lock.
	 */

	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
         * Check for connect event.
         */

	if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
	    /*
             * Consume the connect event.
             */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);

	    /*
	     * For blocking sockets and foreground processing, disable async
	     * connect as we continue now synchoneously.
	     */

	    if (errorCodePtr != NULL &&
		    !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	    }

	    /*
             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Continue connect. If switched to synchroneous connect, the
	     * connect is terminated.
	     */

	    result = TcpConnect(NULL, statePtr);

	    /*
             * Restore event service mode.
             */

	    (void) Tcl_SetServiceMode(oldMode);

	    /*
	     * Check for Succesfull connect or async connect restart
	     */








|
|



|
|














|
|











|
|







648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
	 * Get the statePtr lock.
	 */

	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
	 * Check for connect event.
	 */

	if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
	    /*
	     * Consume the connect event.
	     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);

	    /*
	     * For blocking sockets and foreground processing, disable async
	     * connect as we continue now synchoneously.
	     */

	    if (errorCodePtr != NULL &&
		    !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	    }

	    /*
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Continue connect. If switched to synchroneous connect, the
	     * connect is terminated.
	     */

	    result = TcpConnect(NULL, statePtr);

	    /*
	     * Restore event service mode.
	     */

	    (void) Tcl_SetServiceMode(oldMode);

	    /*
	     * Check for Succesfull connect or async connect restart
	     */

771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    ClientData instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;







|







771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    void *instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
     * using non-blocking sockets.
     */

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
         * Single fd operation: this proc is only called for a connected
         * socket.
         */

	bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
	CLEAR_BITS(statePtr->readyEvents, FD_READ);

	/*
	 * Check for end-of-file condition or successful read.
	 */







|
|
|







826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
     * using non-blocking sockets.
     */

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
	 * Single fd operation: this proc is only called for a connected
	 * socket.
	 */

	bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
	CLEAR_BITS(statePtr->readyEvents, FD_READ);

	/*
	 * Check for end-of-file condition or successful read.
	 */
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
	}

	/*
	 * Check for error condition or underflow in non-blocking case.
	 */

	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
                || (error != WSAEWOULDBLOCK)) {
	    Tcl_WinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesRead = -1;
	    break;
	}

	/*







|







873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
	}

	/*
	 * Check for error condition or underflow in non-blocking case.
	 */

	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
	        || (error != WSAEWOULDBLOCK)) {
	    Tcl_WinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesRead = -1;
	    break;
	}

	/*
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
 *	Produces output on the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    ClientData instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;







|







915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
 *	Produces output on the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    void *instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
	return -1;
    }

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
         * Single fd operation: this proc is only called for a connected
         * socket.
         */

	written = send(statePtr->sockets->fd, buf, toWrite, 0);
	if (written != SOCKET_ERROR) {
	    /*
	     * Since Windows won't generate a new write event until we hit an
	     * overflow condition, we need to force the event loop to poll
	     * until the condition changes.







|
|
|







952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
	return -1;
    }

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
	 * Single fd operation: this proc is only called for a connected
	 * socket.
	 */

	written = send(statePtr->sockets->fd, buf, toWrite, 0);
	if (written != SOCKET_ERROR) {
	    /*
	     * Since Windows won't generate a new write event until we hit an
	     * overflow condition, we need to force the event loop to poll
	     * until the condition changes.
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
 *	Closes the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *))
{
    TcpState *statePtr = (TcpState *)instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);








|







1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
 *	Closes the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    void *instanceData,	/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *))
{
    TcpState *statePtr = (TcpState *)instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
     * This may be called, if an async socket connect fails or is closed
     * between connect and thread action callback.
     */

    if (tsdPtr->pendingTcpState != NULL
	    && tsdPtr->pendingTcpState == statePtr) {
	/*
         * Get infoPtr lock, because this concerns the notifier thread.
         */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	tsdPtr->pendingTcpState = NULL;

	/*
         * Free list lock.
         */

	SetEvent(tsdPtr->socketListLock);
    }

    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only







|
|






|
|







1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
     * This may be called, if an async socket connect fails or is closed
     * between connect and thread action callback.
     */

    if (tsdPtr->pendingTcpState != NULL
	    && tsdPtr->pendingTcpState == statePtr) {
	/*
	 * Get infoPtr lock, because this concerns the notifier thread.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	tsdPtr->pendingTcpState = NULL;

	/*
	 * Free list lock.
	 */

	SetEvent(tsdPtr->socketListLock);
    }

    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
 *	Shuts down one side of the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;








|







1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
 *	Shuts down one side of the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    void *instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;

1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
 *	Changes attributes of the socket at the system level.
 *
 *----------------------------------------------------------------------
 */

static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    TCL_UNUSED(const char *) /*value*/)		/* New value for option. */
{
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SOCKET sock;







|







1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
 *	Changes attributes of the socket at the system level.
 *
 *----------------------------------------------------------------------
 */

static int
TcpSetOptionProc(
    void *instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    TCL_UNUSED(const char *) /*value*/)		/* New value for option. */
{
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SOCKET sock;
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{







|







1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    void *instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {
	/*
         * Do not return any errors if async connect is running.
         */

	if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
		/*
		 * In case of a failed async connect, eventually report the
		 * connect error only once.  Do not report the system error,
		 * as this comes again and again.







|
|







1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {
	/*
	 * Do not return any errors if async connect is running.
	 */

	if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
		/*
		 * In case of a failed async connect, eventually report the
		 * connect error only once.  Do not report the system error,
		 * as this comes again and again.
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

		/*
		 * Return error message.
		 */

		if (err) {
		    Tcl_WinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),
                            -1);
		}
	    }
	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
		? "1" : "0", -1);
        return TCL_OK;
    }

    if (interp != NULL
            && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);

	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
	    } else {
		return TCL_OK;
	    }
	} else if (getpeername(sock, (LPSOCKADDR) &(peername.sa),
                &size) == 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);







|
<















|




















|







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

		/*
		 * Return error message.
		 */

		if (err) {
		    Tcl_WinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);

		}
	    }
	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
		? "1" : "0", -1);
        return TCL_OK;
    }

    if (interp != NULL
	    && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);

	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
	    } else {
		return TCL_OK;
	    }
	} else if (getpeername(sock, (LPSOCKADDR) &(peername.sa),
		&size) == 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
	    Tcl_DStringStartSublist(dsPtr);
	}
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

            found = 1;
	} else {
	    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
		sock = fds->fd;
		size = sizeof(sockname);
		if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		    int flags = reverseDNS;








|







1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
	    Tcl_DStringStartSublist(dsPtr);
	}
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

	    found = 1;
	} else {
	    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
		sock = fds->fd;
		size = sizeof(sockname);
		if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		    int flags = reverseDNS;

1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
 *	already true.
 *
 *----------------------------------------------------------------------
 */

static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    /*







|







1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
 *	already true.
 *
 *----------------------------------------------------------------------
 */

static void
TcpWatchProc(
    void *instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    /*
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    TCL_UNUSED(int) /*direction*/,
    ClientData *handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    *handlePtr = INT2PTR(statePtr->sockets->fd);
    return TCL_OK;
}








|

|







1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    void *instanceData,	/* The socket state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    *handlePtr = INT2PTR(statePtr->sockets->fd);
    return TCL_OK;
}

1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
	    statePtr->addr = statePtr->addr->ai_next) {
        for (statePtr->myaddr = statePtr->myaddrlist;
                statePtr->myaddr != NULL;
                statePtr->myaddr = statePtr->myaddr->ai_next) {
	    /*
	     * No need to try combinations of local and remote addresses
	     * of different families.
	     */

	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
		continue;
	    }

            /*
             * Close the socket if it is still open from the last unsuccessful
             * iteration.
             */

	    if (statePtr->sockets->fd != INVALID_SOCKET) {
		closesocket(statePtr->sockets->fd);
	    }

	    /*
             * Get statePtr lock.
             */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
	     * Reset last error from last try
	     */

	    statePtr->notifierConnectError = 0;
	    Tcl_SetErrno(0);

	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family,
                    SOCK_STREAM, 0);

	    /*
             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);

	    /*
             * Continue on socket creation error.
             */

	    if (statePtr->sockets->fd == INVALID_SOCKET) {
		Tcl_WinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * Win-NT has a misfeature that sockets are inherited in child
	     * processes by default. Turn off the inherit bit.
	     */

	    SetHandleInformation((HANDLE) statePtr->sockets->fd,
                    HANDLE_FLAG_INHERIT, 0);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers((void *) statePtr->sockets->fd,
                    TCP_BUFFER_SIZE);

	    /*
	     * Try to bind to a local port.
	     */

	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
		    statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
		Tcl_WinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * For asynchroneous connect set the socket in nonblocking mode
	     * and activate connect notification
	     */

	    if (async_connect) {
		TcpState *statePtr2;
		int in_socket_list = 0;

		/*
                 * Get statePtr lock.
                 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
		 * Bugfig for 336441ed59 to not ignore notifications until the
		 * infoPtr is in the list.
		 * Check if my statePtr is already in the tsdPtr->socketList







|
|
|



















|
|











|


|
|




|
|












|






|












|








|
|







1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
	    statePtr->addr = statePtr->addr->ai_next) {
	for (statePtr->myaddr = statePtr->myaddrlist;
		statePtr->myaddr != NULL;
		statePtr->myaddr = statePtr->myaddr->ai_next) {
	    /*
	     * No need to try combinations of local and remote addresses
	     * of different families.
	     */

	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
		continue;
	    }

            /*
             * Close the socket if it is still open from the last unsuccessful
             * iteration.
             */

	    if (statePtr->sockets->fd != INVALID_SOCKET) {
		closesocket(statePtr->sockets->fd);
	    }

	    /*
	     * Get statePtr lock.
	     */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
	     * Reset last error from last try
	     */

	    statePtr->notifierConnectError = 0;
	    Tcl_SetErrno(0);

	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family,
		    SOCK_STREAM, 0);

	    /*
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Continue on socket creation error.
	     */

	    if (statePtr->sockets->fd == INVALID_SOCKET) {
		Tcl_WinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * Win-NT has a misfeature that sockets are inherited in child
	     * processes by default. Turn off the inherit bit.
	     */

	    SetHandleInformation((HANDLE) statePtr->sockets->fd,
		    HANDLE_FLAG_INHERIT, 0);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers((void *) statePtr->sockets->fd,
		    TCP_BUFFER_SIZE);

	    /*
	     * Try to bind to a local port.
	     */

	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
		    statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
		Tcl_WinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * For asynchronous connect set the socket in nonblocking mode
	     * and activate connect notification
	     */

	    if (async_connect) {
		TcpState *statePtr2;
		int in_socket_list = 0;

		/*
		 * Get statePtr lock.
		 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
		 * Bugfig for 336441ed59 to not ignore notifications until the
		 * infoPtr is in the list.
		 * Check if my statePtr is already in the tsdPtr->socketList
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
		}
		if (!in_socket_list) {
		    tsdPtr->pendingTcpState = statePtr;
		}

		/*
		 * Set connect mask to connect events
                 *
		 * This is activated by a SOCKET_SELECT message to the
		 * notifier thread.
		 */

		SET_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
		 * Free list lock.
		 */

		SetEvent(tsdPtr->socketListLock);

    		/*
                 * Activate accept notification.
                 */

		SendSelectMessage(tsdPtr, SELECT, statePtr);
	    }

	    /*
	     * Attempt to connect to the remote socket.
	     */







|












|
|
|







1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
		}
		if (!in_socket_list) {
		    tsdPtr->pendingTcpState = statePtr;
		}

		/*
		 * Set connect mask to connect events
		 *
		 * This is activated by a SOCKET_SELECT message to the
		 * notifier thread.
		 */

		SET_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
		 * Free list lock.
		 */

		SetEvent(tsdPtr->socketListLock);

		/*
		 * Activate accept notification.
		 */

		SendSelectMessage(tsdPtr, SELECT, statePtr);
	    }

	    /*
	     * Attempt to connect to the remote socket.
	     */
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
		 *
		 * Clear the reenter flag
		 */

		CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);

		/*
                 * Get statePtr lock.
                 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
                 * Get signaled connect error.
                 */

		Tcl_WinConvertError((DWORD) statePtr->notifierConnectError);

		/*
                 * Clear eventual connect flag.
                 */

		CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
                 * Free list lock.
                 */

		SetEvent(tsdPtr->socketListLock);
	    }

	    /*
	     * Clear the tsd socket list pointer if we did not wait for
	     * the FD_CONNECT asynchroneously
	     */

	    tsdPtr->pendingTcpState = NULL;

	    if (Tcl_GetErrno() == 0) {
		goto out;
	    }







|
|




|
|




|
|




|
|






|







1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
		 *
		 * Clear the reenter flag
		 */

		CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);

		/*
		 * Get statePtr lock.
		 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
		 * Get signaled connect error.
		 */

		Tcl_WinConvertError((DWORD) statePtr->notifierConnectError);

		/*
		 * Clear eventual connect flag.
		 */

		CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
		 * Free list lock.
		 */

		SetEvent(tsdPtr->socketListLock);
	    }

	    /*
	     * Clear the tsd socket list pointer if we did not wait for
	     * the FD_CONNECT asynchronously
	     */

	    tsdPtr->pendingTcpState = NULL;

	    if (Tcl_GetErrno() == 0) {
		goto out;
	    }
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
	    /*
	     * Set up the select mask for read/write events.
	     */

	    statePtr->selectEvents = FD_WRITE|FD_READ;

	    /*
             * Get statePtr lock.
             */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
             * Signal ready readable and writable events.
             */

	    SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ);

	    /*
             * Flag error to event routine.
             */

	    SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);

	    /*
             * Save connect error to be reported by 'fconfigure -error'.
             */

	    statePtr->connectError = Tcl_GetErrno();

	    /*
             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on synchroneous connect
	 */







|
|




|
|




|
|




|
|




|
|







1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
	    /*
	     * Set up the select mask for read/write events.
	     */

	    statePtr->selectEvents = FD_WRITE|FD_READ;

	    /*
	     * Get statePtr lock.
	     */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
	     * Signal ready readable and writable events.
	     */

	    SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ);

	    /*
	     * Flag error to event routine.
	     */

	    SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);

	    /*
	     * Save connect error to be reported by 'fconfigure -error'.
	     */

	    statePtr->connectError = Tcl_GetErrno();

	    /*
	     * Free list lock.
	     */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on synchroneous connect
	 */
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    ClientData sock)		/* The socket to wrap up into a channel. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;







|







2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    void *sock)		/* The socket to wrap up into a channel. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    ClientData acceptProcData)	/* Data for the callback. */
{
    SOCKET sock = INVALID_SOCKET;
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL;
    struct addrinfo *addrPtr;	/* Socket address to listen on. */
    TcpState *statePtr = NULL;	/* The returned value. */
    char channelName[SOCK_CHAN_LENGTH];







|







2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    void *acceptProcData)	/* Data for the callback. */
{
    SOCKET sock = INVALID_SOCKET;
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL;
    struct addrinfo *addrPtr;	/* Socket address to listen on. */
    TcpState *statePtr = NULL;	/* The returned value. */
    char channelName[SOCK_CHAN_LENGTH];
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235

    if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";
	goto error;
    }

    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1,
            &errorMsg)) {
	goto error;
    }

    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
                addrPtr->ai_protocol);
	if (sock == INVALID_SOCKET) {







|







2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234

    if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";
	goto error;
    }

    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1,
	    &errorMsg)) {
	goto error;
    }

    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
                addrPtr->ai_protocol);
	if (sock == INVALID_SOCKET) {
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
	 *
	 * Bind should not be affected by the socket having already been
	 * set into nonblocking mode. If there is trouble, this is one
	 * place to look for bugs.
	 */

	if (bind(sock, addrPtr->ai_addr,
                addrPtr->ai_addrlen) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    continue;
	}
	if (port == 0 && chosenport == 0) {
	    address sockname;
	    socklen_t namelen = sizeof(sockname);







|







2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
	 *
	 * Bind should not be affected by the socket having already been
	 * set into nonblocking mode. If there is trouble, this is one
	 * place to look for bugs.
	 */

	if (bind(sock, addrPtr->ai_addr,
		addrPtr->ai_addrlen) == SOCKET_ERROR) {
	    Tcl_WinConvertError((DWORD) WSAGetLastError());
	    closesocket(sock);
	    continue;
	}
	if (port == 0 && chosenport == 0) {
	    address sockname;
	    socklen_t namelen = sizeof(sockname);
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SocketExitHandler(
    TCL_UNUSED(ClientData))
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */







|







2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SocketExitHandler(
    TCL_UNUSED(void *))
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
SocketSetupProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready socket.	 If so, poll.
     */
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
                statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) {
	    Tcl_SetMaxBlockTime(&blockTime);
	    break;
	}
    }
    SetEvent(tsdPtr->socketListLock);
}








|

















|







2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
SocketSetupProc(
    TCL_UNUSED(void *),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready socket.	 If so, poll.
     */
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
		statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) {
	    Tcl_SetMaxBlockTime(&blockTime);
	    break;
	}
    }
    SetEvent(tsdPtr->socketListLock);
}

2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SocketCheckProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    SocketEvent *evPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {







|







2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SocketCheckProc(
    TCL_UNUSED(void *),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    SocketEvent *evPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
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
    /*
     * Handle connection requests directly.
     */

    if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) {
	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
	    /*
             * Accept the incoming connection request.
             */

	    len = sizeof(address);
	    newSocket = accept(fds->fd, &(addr.sa), &len);

	    /*
             * On Tcl server sockets with multiple OS fds we loop over the fds
	     * trying an accept() on each, so we expect INVALID_SOCKET.  There
	     * are also other network stack conditions that can result in
	     * FD_ACCEPT but a subsequent failure on accept() by the time we
	     * get around to it.
             *
	     * Access to sockets (acceptEventCount, readyEvents) in socketList
	     * is still protected by the lock (prevents reintroduction of
	     * SF Tcl Bug 3056775.
	     */

	    if (newSocket == INVALID_SOCKET) {
		/* int err = WSAGetLastError(); */







|
|





|




|







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
    /*
     * Handle connection requests directly.
     */

    if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) {
	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
	    /*
	     * Accept the incoming connection request.
	     */

	    len = sizeof(address);
	    newSocket = accept(fds->fd, &(addr.sa), &len);

	    /*
	     * On Tcl server sockets with multiple OS fds we loop over the fds
	     * trying an accept() on each, so we expect INVALID_SOCKET.  There
	     * are also other network stack conditions that can result in
	     * FD_ACCEPT but a subsequent failure on accept() by the time we
	     * get around to it.
	     *
	     * Access to sockets (acceptEventCount, readyEvents) in socketList
	     * is still protected by the lock (prevents reintroduction of
	     * SF Tcl Bug 3056775.
	     */

	    if (newSocket == INVALID_SOCKET) {
		/* int err = WSAGetLastError(); */
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
	    if (statePtr->acceptEventCount <= 0) {
		CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
	    }

	    SetEvent(tsdPtr->socketListLock);

	    /*
             * Caution: TcpAccept() has the side-effect of evaluating the
	     * server accept script (via AcceptCallbackProc() in tclIOCmd.c),
	     * which can close the server socket and invalidate statePtr and
	     * fds. If TcpAccept() accepts a socket we must return immediately
	     * and let SocketCheckProc queue additional FD_ACCEPT events.
	     */

	    TcpAccept(fds, newSocket, addr);
	    return 1;
	}

	/*
         * Loop terminated with no sockets accepted; clear the ready mask so
	 * we can detect the next connection request. Note that connection
	 * requests are level triggered, so if there is a request already
	 * pending, a new event will be generated.
	 */

	statePtr->acceptEventCount = 0;
	CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);







|











|







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
	    if (statePtr->acceptEventCount <= 0) {
		CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
	    }

	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Caution: TcpAccept() has the side-effect of evaluating the
	     * server accept script (via AcceptCallbackProc() in tclIOCmd.c),
	     * which can close the server socket and invalidate statePtr and
	     * fds. If TcpAccept() accepts a socket we must return immediately
	     * and let SocketCheckProc queue additional FD_ACCEPT events.
	     */

	    TcpAccept(fds, newSocket, addr);
	    return 1;
	}

	/*
	 * Loop terminated with no sockets accepted; clear the ready mask so
	 * we can detect the next connection request. Note that connection
	 * requests are level triggered, so if there is a request already
	 * pending, a new event will be generated.
	 */

	statePtr->acceptEventCount = 0;
	CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
    TcpState *statePtr,
    SOCKET socket)
{
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = fds->next;







|
|





|
|







2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
    TcpState *statePtr,
    SOCKET socket)
{
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
	 * Add the first FD.
	 */

	statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
	 * Find end of list and append FD.
	 */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = fds->next;
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
    SendSelectMessage(tsdPtr, UNSELECT, statePtr);
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    while (1) {
	int event_found;

	/*
         * Get statePtr lock.
         */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
         * Check if event occured.
         */

	event_found = GOT_BITS(statePtr->readyEvents, events);

	/*
         * Free list lock.
         */

	SetEvent(tsdPtr->socketListLock);

	/*
         * Exit loop if event occured.
         */

	if (event_found) {
	    break;
	}

	/*
         * Exit loop if event did not occur but this is a non-blocking channel
         */

	if (statePtr->flags & TCP_NONBLOCKING) {
	    *errorCodePtr = EWOULDBLOCK;
	    result = 0;
	    break;
	}








|
|




|
|




|
|




|
|






|
|







3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
    SendSelectMessage(tsdPtr, UNSELECT, statePtr);
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    while (1) {
	int event_found;

	/*
	 * Get statePtr lock.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
	 * Check if event occured.
	 */

	event_found = GOT_BITS(statePtr->readyEvents, events);

	/*
	 * Free list lock.
	 */

	SetEvent(tsdPtr->socketListLock);

	/*
	 * Exit loop if event occured.
	 */

	if (event_found) {
	    break;
	}

	/*
	 * Exit loop if event did not occur but this is a non-blocking channel
	 */

	if (statePtr->flags & TCP_NONBLOCKING) {
	    *errorCodePtr = EWOULDBLOCK;
	    result = 0;
	    break;
	}

3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
TcpThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr;
    TcpState *statePtr = (TcpState *)instanceData;
    int notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {







|







3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
 *	Changes thread local list of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
TcpThreadActionProc(
    void *instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr;
    TcpState *statePtr = (TcpState *)instanceData;
    int notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
Changes to win/tclWinTime.c.
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
} wideClick = {0, 0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */

static void		StopCalibration(ClientData clientData);
static DWORD WINAPI	CalibrationThread(LPVOID arg);
static void 		UpdateTimeEachSecond(void);
static void		ResetCounterSamples(unsigned long long fileTime,
			    long long perfCounter, long long perfFreq);
static long long	AccumulateSample(long long perfCounter,
			    unsigned long long fileTime);
static void		NativeScaleTime(Tcl_Time* timebuf,
			    ClientData clientData);
static long long	NativeGetMicroseconds(void);
static void		NativeGetTime(Tcl_Time* timebuf,
			    ClientData clientData);

/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
ClientData tclTimeClientData = NULL;

/*
 * Inlined version of Tcl_GetTime.
 */

static inline void
GetTime(







|







|


|







|







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
} wideClick = {0, 0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */

static void		StopCalibration(void *clientData);
static DWORD WINAPI	CalibrationThread(LPVOID arg);
static void 		UpdateTimeEachSecond(void);
static void		ResetCounterSamples(unsigned long long fileTime,
			    long long perfCounter, long long perfFreq);
static long long	AccumulateSample(long long perfCounter,
			    unsigned long long fileTime);
static void		NativeScaleTime(Tcl_Time* timebuf,
			    void *clientData);
static long long	NativeGetMicroseconds(void);
static void		NativeGetTime(Tcl_Time* timebuf,
			    void *clientData);

/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
void *tclTimeClientData = NULL;

/*
 * Inlined version of Tcl_GetTime.
 */

static inline void
GetTime(
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
 *
 *----------------------------------------------------------------------
 */

static void
NativeScaleTime(
    TCL_UNUSED(Tcl_Time *),
    TCL_UNUSED(ClientData))
{
    /*
     * Native scale is 1:1. Nothing is done.
     */
}

/*







|







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

static void
NativeScaleTime(
    TCL_UNUSED(Tcl_Time *),
    TCL_UNUSED(void *))
{
    /*
     * Native scale is 1:1. Nothing is done.
     */
}

/*
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    TCL_UNUSED(ClientData))
{
    long long usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */








|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    TCL_UNUSED(void *))
{
    long long usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */

720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
 *----------------------------------------------------------------------
 */

void TclWinResetTimerResolution(void);

static void
StopCalibration(
    TCL_UNUSED(ClientData))
{
    SetEvent(timeInfo.exitEvent);

    /*
     * If Tcl_Finalize was called from DllMain, the calibration thread is in a
     * paused state so we need to timeout and continue.
     */







|







720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
 *----------------------------------------------------------------------
 */

void TclWinResetTimerResolution(void);

static void
StopCalibration(
    TCL_UNUSED(void *))
{
    SetEvent(timeInfo.exitEvent);

    /*
     * If Tcl_Finalize was called from DllMain, the calibration thread is in a
     * paused state so we need to timeout and continue.
     */
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimeProc(
    Tcl_GetTimeProc *getProc,
    Tcl_ScaleTimeProc *scaleProc,
    ClientData clientData)
{
    tclGetTimeProcPtr = getProc;
    tclScaleTimeProcPtr = scaleProc;
    tclTimeClientData = clientData;
}

/*







|







1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimeProc(
    Tcl_GetTimeProc *getProc,
    Tcl_ScaleTimeProc *scaleProc,
    void *clientData)
{
    tclGetTimeProcPtr = getProc;
    tclScaleTimeProcPtr = scaleProc;
    tclTimeClientData = clientData;
}

/*
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
 *----------------------------------------------------------------------
 */

void
Tcl_QueryTimeProc(
    Tcl_GetTimeProc **getProc,
    Tcl_ScaleTimeProc **scaleProc,
    ClientData *clientData)
{
    if (getProc) {
	*getProc = tclGetTimeProcPtr;
    }
    if (scaleProc) {
	*scaleProc = tclScaleTimeProcPtr;
    }







|







1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
 *----------------------------------------------------------------------
 */

void
Tcl_QueryTimeProc(
    Tcl_GetTimeProc **getProc,
    Tcl_ScaleTimeProc **scaleProc,
    void **clientData)
{
    if (getProc) {
	*getProc = tclGetTimeProcPtr;
    }
    if (scaleProc) {
	*scaleProc = tclScaleTimeProcPtr;
    }