.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
to UTF-8 based on the channel's encoding and storing the produced data in
\fIreadObjPtr\fR's string representation.  The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
that were stored in \fIreadObjPtr\fR.  If an error occurs while reading, the
return value is -1 and \fBTcl_ReadChars\fR records a POSIX error
code that can be retrieved with \fBTcl_GetErrno\fR. If an encoding error happens
while the channel is in blocking mode with -profile strict, the characters
retrieved until the encoding error happened will be stored in \fIreadObjPtr\fR.
.PP
Setting \fIcharsToRead\fR to -1 will cause the command to read
all characters currently available (non-blocking) or everything until
eof (blocking mode).
.PP
The return value may be smaller than the value to read, indicating that less
data than requested was available.  This is called a \fIshort read\fR.  In
blocking mode, this can only happen on an end-of-file.  In nonblocking mode,
a short read can also occur if an encoding error is encountered (with -profile
strict) or if there is not enough input currently available:
\fBTcl_ReadChars\fR returns a short count rather than waiting for more data.

.PP
If the channel is in blocking mode, a return value of zero indicates an
end-of-file condition.  If the channel is in nonblocking mode, a return
value of zero indicates either that no input is currently available or an
end-of-file condition.  Use \fBTcl_Eof\fR and \fBTcl_InputBlocked\fR to tell
which of these conditions actually occurred.
.PP

\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
compression dictionary used with the stream, a compression dictionary being an
array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
is used to initialize the compression engine rather than leaving it to create
it on the fly from the data being compressed. Setting a compression dictionary
allows for more efficient compression in the case where the start of the data
is highly regular, but it does require both the compressor and the
decompressor to agree on the value to use. Compression dictionaries are only
fully supported for zlib-format data; on compression, they must be set before
any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
\fB\-errorcode\fR set to
.QW "\fBZLIB NEED_DICT\fI code\fR" ;
the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
the compression dictionary sought. (Note that this is only true for

.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP void *clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP size_t stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
waited upon into it.

.PP
\fBchan close\fR fully flushes any output before closing the write side of a
channel unless it is non-blocking mode, where it returns immediately and the
channel is flushed in the background before finally being closed.
.PP
\fBchan close\fR may return an error if an error occurs while flushing
output.  If a process in a command pipeline created by \fBopen\fR returns an
error (either by returning a non-zero exit code or writing to its standard
error file descriptor), \fBchan close\fR generates an error in the same
manner as \fBexec\fR.
.PP
Closing one side of a socket or command pipeline may lead to the shutdown() or
close() of the underlying system resource, leading to a reaction from whatever
is on the other side of the pipeline or socket.
.PP
If the channel for a command pipeline is in blocking mode, \fBchan close\fR
waits for the connected processes to complete.
.PP
\fBchan close\fR only affects the current interpreter.  If the channel is open
in any other interpreter, its state is unchanged there.  See \fBinterp\fR for a
description of channel sharing.
.PP
When the last interpreter sharing a channel is destroyed, the channel is
switched to blocking mode and fully flushed and then closed.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to
blocking mode when exiting; this guarantees a timely exit even when the
peer or a communication channel is stalled. To ensure proper flushing of
stalled nonblocking channels on exit, one must now either (a) actively
switch them back to blocking or (b) use the environment variable
\fBTCL_FLUSH_NONBLOCKING_ON_EXIT\fR, which when set and not equal to
.QW \fB0\fR
restores the previous behavior.
.RE
.TP
\fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
Configures or reports the configuration of \fIchannelName\fR.
.RS
.PP

as its handler, and returns the name of the channel.  \fBcmdPrefix\fR is the
first words of a command that provides the interface for a \fBrefchan\fR.
.RS
.PP
\fBImode\fR is a list of one or more of the strings
.QW \fBread\fR
or
.QW \fBwrite\fR ,
indicating whether the channel is a read channel, a write channel, or both.
It is an error if the handler does not support the chosen mode.
.PP
The handler is called as needed from the global namespace at the top level, and
command resolution happens there at the time of the call.  If the handler is
renamed or deleted any subsequent attempt to call it is an error, which may
not be able to describe the failure.
.PP

.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
.SH SYNOPSIS
\fBclose \fIchannelId\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)?
.BE
.SH DESCRIPTION
.PP
Closes or half-closes the channel given by \fIchannelId\fR. \fBchan close\fR
is another name for this command.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
The single-argument form is a simple

channel.
When the last interpreter in which the channel is registered invokes
\fBclose\fR, the cleanup actions described above occur. See the
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to
blocking mode when exiting; this guarantees a timely exit even when the
peer or a communication channel is stalled. To ensure proper flushing of
stalled nonblocking channels on exit, one must now either (a) actively
switch them back to blocking or (b) use the environment variable
\fBTCL_FLUSH_NONBLOCKING_ON_EXIT\fR, which when set and not equal to
.QW \fB0\fR
restores the previous behavior.
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error (either by returning a
non-zero exit code or writing to its standard error file descriptor),
\fBclose\fR generates an error (similar to the \fBexec\fR command.)
.PP
The two-argument form is a
.QW "half-close" :
given a bidirectional channel like a
socket or command pipeline and a (possibly abbreviated) direction, it closes
only the sub-stream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the

        uplevel 1 $script
    } result options
    \fBclose\fR $chan
    return -options $options $result
}
.CE
.SH "SEE ALSO"
chan(n), file(n), open(n), socket(n), eof(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, channel, close, nonblocking, half-close
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

'\"
'\" Copyright © 2019 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH configurable n 0.4 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::configurable, configure, property \- class that makes configurable classes and objects, and supports making configurable properties
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::configurable create \fIclass\fR ?\fIdefinitionScript\fR?

\fBoo::define \fIclass\fB {\fR
    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
\fB}\fR

\fBoo::objdefine \fIobject\fB {\fR
    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
\fB}\fR

\fIobjectName \fBconfigure\fR
\fIobjectName \fBconfigure\fR \fI\-prop\fR
\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR...
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::configurable\fR

\fBoo::configurable\fR metaclass works by mixing in a class and setting
definition namespaces during object creation that provide the other bits and
pieces of machinery. The key pieces of the implementation are enumerated here
so that they can be used by other code:
.TP
\fBoo::configuresupport::configurable\fR
.
This is a class that provides the implementation of the \fBconfigure\fR method
(described above in \fBCONFIGURE METHOD\fR).
.TP
\fBoo::configuresupport::configurableclass\fR
.
This is a namespace that contains the definition dialect that provides the
\fBproperty\fR declaration for use in classes (i.e., via \fBoo::define\fR, and
class constructors under normal circumstances), as described above in
\fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR
command so that it may be used easily in user definition dialects.
.TP

\fBoo::configuresupport::configurableobject\fR
.
This is a namespace that contains the definition dialect that provides the
\fBproperty\fR declaration for use in instance objects (i.e., via
\fBoo::objdefine\fR, and the \fBself\fR declaration in \fBoo::define\fR), as
described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its
\fBproperty\fR command so that it may be used easily in user definition
dialects.
.PP
The underlying property discovery mechanism relies on four slots (see
\fBoo::define\fR for what that implies) that list the properties that can be
configured. These slots do not themselves impose any semantics on what the

with the \fIvalue\fR arguments. The resulting list is then stored back in
\fIlistVar\fR and returned as the result of the command.
.PP
Arguments \fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace. They are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list. The index \fB0\fR refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
.PP
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered to
refer to the position before the first element of the list. This allows
elements to be prepended.
.PP
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the

the list.  If no \fIvalue\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.
.SH EXAMPLES
.PP
Prepend to a list.
.PP
.CS
set lst {c d e f g}
      \fI\(-> c d e f g\fR
\fBledit\fR lst -1 -1 a b
      \fI\(-> a b c d e f g\fR
.CE
.PP
Append to the list.
.PP
.CS
\fBledit\fR lst end+1 end+1 h i
      \fI\(-> a b c d e f g h i\fR
.CE
.PP
Delete third and fourth elements.
.PP
.CS
\fBledit\fR lst 2 3
      \fI\(-> a b e f g h i\fR
.CE
.PP
Replace two elements with three.
.PP
.CS
\fBledit\fR lst 2 3 x y z
      \fI\(-> a b x y z g h i\fR
set lst
      \fI\(-> a b x y z g h i\fR
.CE
.PP
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lseq(n), lset(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

and arrange for the other procedures to be loaded on-demand using
the auto-load mechanism defined below.
.SH "COMMAND PROCEDURES"
.PP
The following procedures are provided in the Tcl library:
.TP
\fBauto_execok \fIcmd\fR
.
Determines whether there is an executable file or shell builtin
by the name \fIcmd\fR.  If so, it returns a list of arguments to be
passed to \fBexec\fR to execute the executable file or shell builtin
named by \fIcmd\fR.  If not, it returns an empty string.  This command
examines the directories in the current search path (given by the PATH
environment variable) in its search for an executable file named
\fIcmd\fR.  On Windows platforms, the search is expanded with the same
directories and file extensions as used by \fBexec\fR. \fBAuto_execok\fR
remembers information about previous searches in an array named
\fBauto_execs\fR;  this avoids the path search in future calls for the
same \fIcmd\fR.  The command \fBauto_reset\fR may be used to force
\fBauto_execok\fR to forget its cached information.
.RS
.PP
For example, to run the \fIumask\fR shell builtin on Linux, you would do:
.PP
.CS
exec {*}[\fBauto_execok\fR umask]
.CE
.PP
To run the \fIDIR\fR shell builtin on Windows, you would do:
.PP
.CS
exec {*}[\fBauto_execok\fR dir]
.CE
.PP
To discover if there is a \fIfrobnicate\fR binary on the user's PATH,
you would do:
.PP
.CS
set mayFrob [expr {[llength [\fBauto_execok\fR frobnicate]] > 0}]
.CE
.RE
.TP
\fBauto_import \fIpattern\fR
.
\fBAuto_import\fR is invoked during \fBnamespace import\fR to see if
the imported commands specified by \fIpattern\fR reside in an
autoloaded library.  If so, the commands are loaded so that they will
be available to the interpreter for creating the import links.  If the
commands do not reside in an autoloaded library, \fBauto_import\fR
does nothing.  The pattern matching is performed according to the
matching rules of \fBnamespace import\fR.
.RS
.PP
It is not normally necessary to call this command directly.
.RE
.TP
\fBauto_load \fIcmd\fR
.
This command attempts to load the definition for a Tcl command named
\fIcmd\fR.  To do this, it searches an \fIauto-load path\fR, which is
a list of one or more directories.  The auto-load path is given by the
global variable \fBauto_path\fR if it exists.  If there is no
\fBauto_path\fR variable, then the \fBTCLLIBPATH\fR environment variable is
used, if it exists.  Otherwise the auto-load path consists of just the
Tcl library directory.  Within each directory in the auto-load path
there must be a file \fBtclIndex\fR that describes one or more
commands defined in that directory and a script to evaluate to load
each of the commands.  The \fBtclIndex\fR file should be generated
with the \fBauto_mkindex\fR command.  If \fIcmd\fR is found in an
index file, then the appropriate script is evaluated to create the
command.  The \fBauto_load\fR command returns 1 if \fIcmd\fR was
successfully created.  The command returns 0 if there was no index
entry for \fIcmd\fR or if the script did not actually define \fIcmd\fR
(e.g. because index information is out of date).  If an error occurs
while processing the script, then that error is returned.
\fBAuto_load\fR only reads the index information once and saves it in
the array \fBauto_index\fR;  future calls to \fBauto_load\fR check for
\fIcmd\fR in the array rather than re-reading the index files.  The
cached index information may be deleted with the command
\fBauto_reset\fR.  This will force the next \fBauto_load\fR command to
reload the index database from disk.
.RS
.PP
It is not normally necessary to call this command directly; the
default \fBunknown\fR handler will do so.
.RE
.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
.
Generates an index suitable for use by \fBauto_load\fR.  The command
searches \fIdir\fR for all files whose names match any of the
\fIpattern\fR arguments (matching is done with the \fBglob\fR
command), generates an index of all the Tcl command procedures defined

Destroys all the information cached by \fBauto_execok\fR and
\fBauto_load\fR.  This information will be re-read from disk the next
time it is needed.  \fBAuto_reset\fR also deletes any procedures
listed in the auto-load index, so that fresh copies of them will be
loaded the next time that they are used.
.TP
\fBauto_qualify \fIcommand namespace\fR
.
Computes a list of fully qualified names for \fIcommand\fR.  This list
mirrors the path a standard Tcl interpreter follows for command
lookups:  first it looks for the command in the current namespace, and
then in the global namespace.  Accordingly, if \fIcommand\fR is
relative and \fInamespace\fR is not \fB::\fR, the list returned has
two elements:  \fIcommand\fR scoped by \fInamespace\fR, as if it were
a command in the \fInamespace\fR namespace; and \fIcommand\fR as if it
were a command in the global namespace.  Otherwise, if either
\fIcommand\fR is absolute (it begins with \fB::\fR), or
\fInamespace\fR is \fB::\fR, the list contains only \fIcommand\fR as
if it were a command in the global namespace.
.RS
.PP
\fBAuto_qualify\fR is used by the auto-loading facilities in Tcl, both
for producing auto-loading indexes such as \fIpkgIndex.tcl\fR, and for
performing the actual auto-loading of functions at runtime.
.RE
.TP
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
.
This is a standard search procedure for use by extensions during
their initialization.  They call this procedure to look for their
script library in several standard directories.
The last component of the name of the library directory is
normally \fIbasenameversion\fR
(e.g., tk8.0), but it might be
.QW library

relative to the Tcl library directory;
relative to the executable file in the standard installation
bin or bin/\fIarch\fR directory;
relative to the executable file in the current build tree;
relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR ?\fIpattern\fR?
.
Prints on standard output the names and values of all the elements in the
array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
given.
\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
The result of this command is the empty string.
.RS
.PP
For example, to print the contents of the \fBtcl_platform\fR array, do:
.PP
.CS
\fBparray\fR tcl_platform
.CE
.RE
.TP
\fBtcl_endOfWord \fIstr start\fR
.
Returns the index of the first end-of-word location that occurs after
a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
location is defined to be the first non-word character following the
first word character after the starting point.  Returns -1 if there
are no more end-of-word locations after the starting point.  See the
description of \fBtcl_wordchars\fR and \fBtcl_nonwordchars\fR below
for more details on how Tcl determines which characters are word
characters.
.TP
\fBtcl_startOfNextWord \fIstr start\fR
.
Returns the index of the first start-of-word location that occurs
after a starting index \fIstart\fR in the string \fIstr\fR.  A
start-of-word location is defined to be the first word character
following a non-word character.  Returns \-1 if there are no more
start-of-word locations after the starting point.
.RS
.PP
For example, to print the indices of the starts of each word in a
string according to platform rules:
.PP
.CS
set theString "The quick brown fox"
for {set idx 0} {$idx >= 0} {
        set idx [\fBtcl_startOfNextWord\fR $theString $idx]} {
    puts "Word start index: $idx"
}
.CE
.RE
.TP
\fBtcl_startOfPreviousWord \fIstr start\fR
.
Returns the index of the first start-of-word location that occurs
before a starting index \fIstart\fR in the string \fIstr\fR.  Returns
\-1 if there are no more start-of-word locations before the starting
point.
.TP
\fBtcl_wordBreakAfter \fIstr start\fR
.
Returns the index of the first word boundary after the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries after the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.TP
\fBtcl_wordBreakBefore \fIstr start\fR
.
Returns the index of the first word boundary before the starting index
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries before the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
the Tcl library. They fall into two broad classes, handling unknown
commands and packages, and determining what are words.
.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP
\fBauto_execs\fR
.
Used by \fBauto_execok\fR to record information about whether
particular commands exist as executable files.
.RS
.PP
Not normally usefully accessed directly by user code.
.RE
.TP
\fBauto_index\fR
.
Used by \fBauto_load\fR to save the index information read from
disk.
.RS
.PP
Not normally usefully accessed directly by user code.
.RE
.TP
\fBauto_noexec\fR
.
If set to any value, then \fBunknown\fR will not attempt to auto-exec
any commands.
.TP
\fBauto_noload\fR
.
If set to any value, then \fBunknown\fR will not attempt to auto-load
any commands.
.TP
\fBauto_path\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations (including for package index
files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
the directories listed in the \fBTCLLIBPATH\fR environment variable,
the directory named by the \fBtcl_library\fR global variable,
the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
.RS
.PP
For example, to add the \fIlib\fR directory next to the running
script, you would do:
.PP
.CS
lappend \fBauto_path\fR [file dirname [info script]]/lib
.CE
.PP
Note that if the script uses \fBcd\fR, it is advisable to ensure that
entries on the \fBauto_path\fR are \fBfile normalize\fRd.
.RE
.TP
\fBenv(TCL_LIBRARY)\fR
.
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then
a default value is used.
.RS
.PP
Use of this environment variable is not recommended outside of testing.
Tcl installations should already know where to find their own script
files, as the value is baked in during the build or installation.
.RE
.TP
\fBenv(TCLLIBPATH)\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.  Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
.RS
.PP
A key consequence of this variable is that it gives a way to let the user
of a script specify the list of places where that script may use
\fBpackage require\fR to read packages from. It is not normally usefully
settable within a Tcl script itself \fIexcept\fR to influence where other
interpreters load from (whether made with \fBinterp create\fR or launched
as their own threads or subprocesses).
.RE
.SS "WORD BOUNDARY DETERMINATION VARIABLES"
These variables are only used in the \fBtcl_endOfWord\fR,
\fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR,
\fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands.
.TP
\fBtcl_nonwordchars\fR
.
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a non-word character. The default value is
.QW "\\W" .
.TP
\fBtcl_wordchars\fR
.
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a word character. The default value is
.QW "\\w" .
.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
'\"Local Variables:
'\"mode: nroff
'\"End:

oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method Foo is now directly accessible as Foo here
        \fBlink\fR {bar Foo}
        # The method Foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method Foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is Foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is Foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is Foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly accessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"

lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbitrary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES

'\"
'\" Copyright (c) 2022 Eric Taylor.  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 lseq n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lseq \- Build a numeric sequence returned as a list
.SH SYNOPSIS
\fBlseq \fIstart \fR?(\fB..\fR|\fBto\fR)? \fIend\fR ??\fBby\fR? \fIstep\fR?

\fBlseq \fIstart \fBcount\fR \fIcount\fR ??\fBby\fR? \fIstep\fR?

\fBlseq \fIcount\fR ?\fBby \fIstep\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlseq\fR command creates a sequence of numeric values using the given
parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
The \fIoperation\fR argument
.QW \fB..\fR
or
.QW \fBto\fR
defines an inclusive range; if it is omitted, the range is exclusive.
The \fBcount\fR option is used to define a count of the number of elements in
the list.
The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
The short form with a
single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
\fIcount\fR values).
.PP
The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
can also be a valid expression. the \fBlseq\fR command will evaluate the
expression (as if with \fBexpr\fR)
and use the numeric result, or return an error as with any invalid argument

value; a non-numeric expression result will result in an error.

.SH EXAMPLES
.CS
.\"

\fBlseq\fR 3
         \fI\(-> 0 1 2\fR

\fBlseq\fR 3 0
         \fI\(-> 3 2 1 0\fR

\fBlseq\fR 10 .. 1 by -2
         \fI\(-> 10 8 6 4 2\fR

set l [\fBlseq\fR 0 -5]
         \fI\(-> 0 -1 -2 -3 -4 -5\fR

foreach i [\fBlseq\fR [llength $l]] {
    puts l($i)=[lindex $l $i]
}
        \fI\(-> l(0)=0\fR
        \fI\(-> l(1)=-1\fR
        \fI\(-> l(2)=-2\fR
        \fI\(-> l(3)=-3\fR
        \fI\(-> l(4)=-4\fR
        \fI\(-> l(5)=-5\fR

foreach i [\fBlseq\fR {[llength $l]-1} 0] {
    puts l($i)=[lindex $l $i]
}
        \fI\(-> l(5)=-5\fR
        \fI\(-> l(4)=-4\fR
        \fI\(-> l(3)=-3\fR
        \fI\(-> l(2)=-2\fR
        \fI\(-> l(1)=-1\fR
        \fI\(-> l(0)=0\fR

set i 17
         \fI\(-> 17\fR
if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i < 50)
    puts "Ok"
} else {
    puts "outside :("
}
        \fI\(-> Ok\fR

set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
        \fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
.\"
.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n),
llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS

.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
.PP
.VS "8.7, TIP 603"
When the file opened is an ordinary disk file, the \fBchan configure\fR and
\fBfconfigure\fR commands can be used to query this additional configuration
option:
.TP
\fB\-stat\fR
.
This option, when read, returns a dictionary of values much as is obtained
from the \fBfile stat\fR command, where that stat information relates to the
real opened file. Keys in the dictionary may include \fBatime\fR, \fBctime\fR,
\fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR,
\fBsize\fR, \fBtype\fR, and \fBuid\fR among others; the \fBmtime\fR,
\fBsize\fR and \fBtype\fR fields are guaranteed to be present and meaningful
on all platforms; other keys may be present too.
.RS
.PP
\fIImplementation note:\fR This option maps to a call to \fBfstat()\fR on
POSIX platforms, and to a call to \fBGetFileInformationByHandle()\fR on
Windows; the information reported is what those system calls produce.
.RE
.VE "8.7, TIP 603"
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
.QW \fB|\fR
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the

.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evaluation will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical Tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 net-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3

.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the \fBtimerate\fR command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.
.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including

    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    void *clientData, TCL_HASH_TYPE stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    Tcl_Size Tcl_ReadRaw(Tcl_Channel chan, char *dst, Tcl_Size bytesToRead)
}
declare 395 {

 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    Tcl_Size length;		/* Number of bytes in string excluding
				 * terminating nul */
    Tcl_Size spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

 * Reserve top byte for profile values (disjoint, not a mask). In case of
 * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
 * necessary.
 */
#define TCL_ENCODING_PROFILE_TCL8     0x01000000
#define TCL_ENCODING_PROFILE_STRICT   0x02000000
#define TCL_ENCODING_PROFILE_REPLACE  0x03000000
#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_STRICT

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large

		NULL,
		ArithSeriesObjReverse,
	  	NULL,
		NULL,
    },
};
const ObjectType tclArithSeriesObjType = {
    "arithseries",
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny,		/* setFromAnyProc */
    2,
    (Tcl_ObjInterface *)&tclArithSeriesInterface
};

	assignNumber(useDoubles, &step, &dstep, stepObj);
	if (useDoubles) {
	    step = dstep;
	} else {
	    dstep = step;
	}
	if (dstep == 0) {
	    TclNewObj(*arithSeriesObj);
	    return TCL_OK;
	}
    }
    if (endObj) {
	assignNumber(useDoubles, &end, &dend, endObj);
    }
    if (lenObj) {

    iPtr->legacyResult = NULL;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->errorLine = 0;
    iPtr->stubTable = &tclStubs;
    TclNewObj(iPtr->objResultPtr);
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->optimizer = TclOptimizeBytecode;

    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->tracesForbiddingInline = 0;
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    TclNewObj(iPtr->emptyObjPtr);
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;

    iPtr->chanMsg = NULL;

    /*
     * TIP #285, Script cancellation support.
     */

    TclNewObj(iPtr->asyncCancelMsg);

    cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;

    if ((BYTEARRAY_MAX_LEN - byteArrayPtr->used) < len) {
	/* Will wrap around !! */
	Tcl_Panic("max size of a byte array exceeded");
    }
    needed = byteArrayPtr->used + len;
    if (needed > byteArrayPtr->allocated) {






	Tcl_Size newCapacity;




	byteArrayPtr =


	    (ByteArray *)TclReallocElemsEx(byteArrayPtr,







					   needed,








					   1,



					   offsetof(ByteArray, bytes),
					   &newCapacity);
	byteArrayPtr->allocated = newCapacity;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;

 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This code contributed by Karl Lehenbauer and Mark Diekhans
 */

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

#define FALSE	0
#define TRUE	1

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc

    TCL_UNUSED(void *),
    TCL_UNUSED(int) /*flags*/)
{
    return 1;
}

#endif	/* TCL_MEM_DEBUG */

/*
 *------------------------------------------------------------------------
 *
 * TclAllocElemsEx --
 *
 *    See TclAttemptAllocElemsEx. This function differs in that it panics
 *    on failure.
 *
 * Results:
 *    Non-NULL pointer to allocated memory block.
 *
 * Side effects:
 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclAllocElemsEx(
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	NULL, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,
		  elemSize);
    }
    return ptr;
}

/*
 *------------------------------------------------------------------------
 *
 * TclAttemptReallocElemsEx --
 *
 *    Attempts to allocate (oldPtr == NULL) or reallocate memory of the
 *    requested size plus some more for future growth. The amount of
 *    reallocation is adjusted depending on on failure.
 *
 *
 * Results:
 *    Pointer to allocated memory block which is at least as large
 *    as the requested size or NULL if allocation failed.
 *
 *------------------------------------------------------------------------
 */
void *
TclAttemptReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate or
			     * NULL to indicate this is a new allocation */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr;
    Tcl_Size limit;
    Tcl_Size attempt;

    assert(elemCount > 0);
    assert(elemSize > 0);
    assert(elemSize < TCL_SIZE_MAX);
    assert(leadSize >= 0);
    assert(leadSize < TCL_SIZE_MAX);

    limit = (TCL_SIZE_MAX - leadSize) / elemSize;
    if (elemCount > limit) {
	return NULL;
    }
    /* Loop trying for extra space, reducing request each time */
    attempt = TclUpsizeAlloc(0, elemCount, limit);
    ptr = NULL;
    while (attempt > elemCount) {
	if (oldPtr) {
	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
	} else {
	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
	}
	if (ptr) {
	    break;
	}
	attempt = TclUpsizeRetry(elemCount, attempt);
    }
    /* Try exact size as a last resort */
    if (ptr == NULL) {
	attempt = elemCount;
	if (oldPtr) {
	    ptr = Tcl_AttemptRealloc(oldPtr, leadSize + attempt * elemSize);
	} else {
	    ptr = Tcl_AttemptAlloc(leadSize + attempt * elemSize);
	}
    }
    if (ptr && capacityPtr) {
	*capacityPtr = attempt;
    }
    return ptr;
}

/*
 *------------------------------------------------------------------------
 *
 * TclReallocElemsEx --
 *
 *    See TclAttemptReallocElemsEx. This function differs in that it panics
 *    on failure.
 *
 * Results:
 *    Non-NULL pointer to allocated memory block.
 *
 * Side effects:
 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	oldPtr, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,
		  elemSize);
    }
    return ptr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFinalizeMemorySubsystem --
 *
 *	This procedure is called to finalize all the structures that are used

    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
        TclNewObj(result);
        Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
        Tcl_DictObjPut(NULL, result,            \
            Tcl_NewStringObj((key), -1),        \
            (objValue));
        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));

    STORE_ARY("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
    STORE_ARY("size",	Tcl_NewWideIntObj(statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj(statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
#ifdef HAVE_STRUCT_STAT_ST_RDEV
    if (S_ISCHR(statPtr->st_mode) || S_ISBLK(statPtr->st_mode)) {
	STORE_ARY("rdev", Tcl_NewWideIntObj((long) statPtr->st_rdev));
    }
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(
	    Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;

	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		TclNewObj(elemObjPtr);
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);

		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr;
		TclNewObj(nullObjPtr);

		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));

			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
	    } else {
	    simpleProcOK:
		if (specificNsInPattern) {
		    TclNewObj(elemObjPtr);
		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
			    elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }

			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
		} else {
		procOK:
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}

	    &elemPtrs) != TCL_OK) {
	    return TCL_ERROR;
	}
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	Tcl_Size i;

	TclNewObj(resObjPtr);
	if (TclObjectHasInterface(objv[1], list, index)) {
	    Tcl_Obj *valueObj;
	    for (i = 0;  i < listLen;  i++) {
		if (i > 0) {

		    /*
		     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**

	    /*
	     * It's the number of substitutions, plus one for the matchVar at
	     * index 0
	     */

	    objc = info.nsubs + 1;
	    if (all <= 1) {
		TclNewObj(resultPtr);
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		Tcl_Size start, end;

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if ((i <= (int)info.nsubs) && (info.matches[i].end > 0)) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    TclNewObj(newPtr);
		}
	    }
	    if (doinline) {
		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
	return TCL_ERROR;
    }

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

    if (stringLen == 0) {
	/*
	 * Do nothing.
	 */
    } else if (splitCharLen == 0) {
	Tcl_HashTable charReuseTable;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"body ?handler ...? ?finally script?");
	return TCL_ERROR;
    }
    bodyObj = objv[1];
    TclNewObj(handlersObj);
    bodyShared = 0;
    haveHandlers = 0;
    for (i=2 ; i<objc ; i++) {
	enum Handlers type;
	Tcl_Obj *info[5];

	if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",

/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,
				TCL_HASH_TYPE stackSize, int flags);
/* 394 */
EXTERN Tcl_Size		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				Tcl_Size bytesToRead);
/* 395 */
EXTERN Tcl_Size		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				Tcl_Size srcLen);
/* 396 */

    void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, TCL_HASH_TYPE stackSize, int flags); /* 393 */
    Tcl_Size (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, Tcl_Size bytesToRead); /* 394 */
    Tcl_Size (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, Tcl_Size srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */

    do {                                                                \
        Tcl_ObjInternalRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \
        Tcl_StoreInternalRep((objPtr), &tclDictType, &ir);                   \
    } while (0)

#define DictGetInternalRep(objPtr, dictRepPtr)				\
    do {                                                                \
        const Tcl_ObjInternalRep *irPtr;                                     \
        irPtr = TclFetchInternalRep((objPtr), &tclDictType);                \
        (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;          \
    } while (0)

/*

DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict, *newDict = (Dict *)Tcl_Alloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetInternalRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);
    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {

static void
FreeDictInternalRep(
    Tcl_Obj *dictPtr)
{
    Dict *dict;

    DictGetInternalRep(dictPtr, dict);

    if (dict->refCount-- <= 1) {
	DeleteDict(dict);
    }
}

/*

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    Tcl_Size numElems;

    DictGetInternalRep(dictPtr, dict);

    assert (dict != NULL);

    numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {

static Dict *
GetDictFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr)
{
    Dict *dict;

    DictGetInternalRep(dictPtr, dict);
    if (dict == NULL) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetInternalRep(dictPtr, dict);
    }
    return dict;
}

/*
 *----------------------------------------------------------------------
 *

    Tcl_Size keyc,
    Tcl_Obj *const keyv[],
    int flags)
{
    Dict *dict, *newDict;
    Tcl_Size i;

    DictGetInternalRep(dictPtr, dict);
    if (dict == NULL) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetInternalRep(dictPtr, dict);
    }
    if (flags & DICT_PATH_UPDATE) {
	dict->chain = NULL;
    }

    for (i=0 ; i<keyc ; i++) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);

	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
	    tmpObj = Tcl_NewDictObj();
	    Tcl_IncrRefCount(tmpObj);
	    Tcl_SetHashValue(hPtr, tmpObj);
	} else {
	    tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	    DictGetInternalRep(tmpObj, newDict);

	    if (newDict == NULL) {
		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
		    return NULL;
		}
	    }
	}

	DictGetInternalRep(tmpObj, newDict);
	if (flags & DICT_PATH_UPDATE) {
	    if (Tcl_IsShared(tmpObj)) {
		TclDecrRefCount(tmpObj);
		tmpObj = Tcl_DuplicateObj(tmpObj);
		Tcl_IncrRefCount(tmpObj);
		Tcl_SetHashValue(hPtr, tmpObj);
		dict->epoch++;
		DictGetInternalRep(tmpObj, newDict);
	    }

	    newDict->chain = dictPtr;
	}
	dict = newDict;
	dictPtr = tmpObj;
    }

static void
InvalidateDictChain(
    Tcl_Obj *dictObj)
{
    Dict *dict;

    DictGetInternalRep(dictObj, dict);
    assert( dict != NULL);

    do {
	dict->refCount++;
	TclInvalidateStringRep(dictObj);
	TclFreeInternalRep(dictObj);
	DictSetIntRep(dictObj, dict);

	dict->epoch++;
	dictObj = dict->chain;
	if (dictObj == NULL) {
	    break;
	}
	dict->chain = NULL;
	DictGetInternalRep(dictObj, dict);
    } while (dict != NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjPut --

    if (DeleteChainEntry(dict, keyPtr)) {
	TclInvalidateStringRep(dictPtr);
	dict->epoch++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictGetSize
 *
 *	Returns the size of dictPtr.  Caller must ensure that dictPtr has type
 *	'tclDicttype'.
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclDictGetSize(Tcl_Obj *dictPtr)
{
    Dict *dict;
    DictGetInternalRep(dictPtr, dict);
    return dict->table.numEntries;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjSize --
 *
 *	How many key,value pairs are there in the dictionary?

    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetInternalRep(dictPtr, dict);
    assert(dict != NULL);
    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);

    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetInternalRep(dictPtr, dict);
    assert(dict != NULL);
    DeleteChainEntry(dict, keyv[keyc-1]);
    InvalidateDictChain(dictPtr);
    return TCL_OK;
}

/*

 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,		/* The one argument to Main() */
    TCL_HASH_TYPE stackSize,	/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
    int result;

#define OBJ_AT_TOS	*tosPtr

#define OBJ_UNDER_TOS	*(tosPtr-1)

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

#define CURR_DEPTH	(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_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(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_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels,	\
		CURR_DEPTH,				\
		(pc - codePtr->codeStart),		\
		GetOpcodeName(pc));				\
	printf a;						\
	TclPrintObject(stdout, objPtr, 30);			\
	fprintf(stdout, "\n");					\
	break;							\
    }
#   define O2S(objPtr) \

			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int searchMode, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, Tcl_Size *lengthPtr,
			    const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	wordSkip(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, TCL_HASH_TYPE numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, TCL_HASH_TYPE numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;
static Tcl_NRPostProc	FinalizeOONext;
static Tcl_NRPostProc	FinalizeOONextFilter;
static Tcl_NRPostProc   TEBCresume;

/*

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

ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    TCL_HASH_TYPE size)		/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords)
	    + size * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;

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

static Tcl_Obj **
GrowEvaluationStack(
    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
				 * stack to enlarge. */
    TCL_HASH_TYPE growth1,		/* How much larger than the current used
				 * size. */
    int move)			/* 1 if move words since last marker. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
    TCL_HASH_TYPE newBytes;
    Tcl_Size growth = growth1;
    Tcl_Size newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
    Tcl_Size moveWords = 0;

    if (move) {
	if (!markerPtr) {

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

static Tcl_Obj **
StackAllocWords(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numWords)
{
    /*
     * Note that GrowEvaluationStack sets a marker in the stack. This marker
     * is read when rewinding, e.g., by TclStackFree.
     */

    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;
}

static Tcl_Obj **
StackReallocWords(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numWords)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr = iPtr->execEnvPtr;
    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);

    eePtr->execStackPtr->tosPtr += numWords;
    return resPtr;

	eePtr->execStackPtr = esPtr;
    }
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    TCL_HASH_TYPE numBytes)
{
    Interp *iPtr = (Interp *) interp;
    TCL_HASH_TYPE numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Alloc(numBytes);
    }
    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return StackAllocWords(interp, numWords);
}

void *
TclStackRealloc(
    Tcl_Interp *interp,
    void *ptr,
    TCL_HASH_TYPE numBytes)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr;
    TCL_HASH_TYPE numWords;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return Tcl_Realloc(ptr, numBytes);
    }

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;

int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;
    TCL_HASH_TYPE size = sizeof(TEBCdata) - 1
	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
		* sizeof(void *);
    TCL_HASH_TYPE numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);

    TclPreserveByteCode(codePtr);

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately

#endif

    TEBC_DATA_DIG();

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

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

	}

	/*
	 * Push the call's object result and continue execution with the next
	 * instruction.
	 */

	TRACE_WITH_OBJ(("%" TCL_SIZE_MODIFIER "d => ... after \"%.20s\": TCL_OK, result=",
		objc, cmdNameBuf), Tcl_GetObjResult(interp));

	/*
	 * Obtain and reset interp's result to avoid possible duplications of
	 * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
	 * side effects caused by the resetting of errorInfo and errorCode
	 * [Bug 804681], which are not needed here. We chose instead to

#ifdef TCL_COMPILE_DEBUG
    /*
     * Skip the stack depth check if an expansion is in progress.
     */

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

    TCL_DTRACE_INST_NEXT();

	}

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE_APPEND(("YIELD...\n"));
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) yielding value \"%.30s\"\n",
			iPtr->numLevels, (pc - codePtr->codeStart),
			Tcl_GetString(OBJ_AT_TOS));
	    }
	    fflush(stdout);
	}
#endif
	yieldParameter = NULL;	/*==CORO_ACTIVATE_YIELD*/

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) yielding to [%.30s]\n",
			iPtr->numLevels, (pc - codePtr->codeStart),
			TclGetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	 * 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 %" TCL_T_MODIFIER "d\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 - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
	POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
	/* Ugly abuse! */
	starting = 1;
#endif
	TRACE(("=> drop %" TCL_SIZE_MODIFIER "d items\n", objc));
	NEXT_INST_V(1, objc, 0);

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

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

	/*

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceExec >= 2) {
	    Tcl_Size i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
		TRACE(("%" TCL_SIZE_MODIFIER "d => call ", objc));
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) invoking ", iPtr->numLevels,
			(pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < objc;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");

			miPtr->mPtr->declaringClassPtr == classPtr) {
		    newDepth = i;
#ifdef TCL_COMPILE_DEBUG
		    if (tclTraceExec >= 2) {
			if (traceInstructions) {
			    strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
			} else {
			    fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_T_MODIFIER "d) invoking ",
				    iPtr->numLevels,
				    (size_t)(pc - codePtr->codeStart));
			}
			for (i = 0;  i < opnd;  i++) {
			    TclPrintObject(stdout, objv[i], 15);
			    fprintf(stdout, " ");
			}

#ifdef TCL_COMPILE_DEBUG
	} else if (tclTraceExec >= 2) {
	    int i;

	    if (traceInstructions) {
		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
	    } else {
		fprintf(stdout, "%" TCL_SIZE_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ",
			iPtr->numLevels, (pc - codePtr->codeStart));
	    }
	    for (i = 0;  i < opnd;  i++) {
		TclPrintObject(stdout, objv[i], 15);
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);

    case INST_LIST_LENGTH:
	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
	if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TclNewIntObj(objResultPtr, length);
	TRACE_APPEND(("%" TCL_SIZE_MODIFIER "d\n", length));
	NEXT_INST_F(1, 1, 1);

    case INST_LIST_INDEX:	/* lindex with objc == 3 */
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
	if (

	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 1, 0);
	}

    case INST_LREPLACE4:
	{
	TCL_HASH_TYPE numToDelete, numNewElems;
	int end_indicator;
	int haveSecondIndex, flags;
	Tcl_Obj *fromIdxObj, *toIdxObj;
	opnd = TclGetInt4AtPtr(pc + 1);
	flags = TclGetInt1AtPtr(pc + 5);

	/* Stack: ... listobj index1 ?index2? new1 ... newN */

			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();
			    TRACE_APPEND(("ERROR init. index temp %" TCL_SIZE_MODIFIER "d: %.30s",
				    varIndex, O2S(Tcl_GetObjResult(interp))));
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}

	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %" TCL_SIZE_MODIFIER "d\n", 3 + numLists));

	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }
    break;

    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 *)INT2PTR(CURR_DEPTH);
	TRACE(("%u => catchTop=%" TCL_T_MODIFIER "d, stackTop=%" TCL_T_MODIFIER "d\n",
		TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1),
		CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);
    break;

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();

	    while (cleanup--) {
		valuePtr = POP_OBJECT();
		TclDecrRefCount(valuePtr);
	    }
	    if (result == TCL_BREAK) {
		result = TCL_OK;
		pc = (codePtr->codeStart + rangePtr->breakOffset);
		TRACE_APPEND(("%s, range at %" TCL_SIZE_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
			StringForResultCode(result),
			rangePtr->codeOffset, rangePtr->breakOffset));
		NEXT_INST_F(0, 0, 0);
	    }
	    if (rangePtr->continueOffset == TCL_INDEX_NONE) {
		TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
			StringForResultCode(result)));
		goto checkForCatch;
	    }
	    result = TCL_OK;
	    pc = (codePtr->codeStart + rangePtr->continueOffset);
	    TRACE_APPEND(("%s, range at %" TCL_SIZE_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
		    StringForResultCode(result),
		    rangePtr->codeOffset, rangePtr->continueOffset));
	    NEXT_INST_F(0, 0, 0);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    objPtr = Tcl_GetObjResult(interp);

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

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

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

	 * "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 > PTR2INT(*catchTop)) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %" TCL_SIZE_MODIFIER "d, catchTop=%" TCL_T_MODIFIER "d, "
		    "unwound to %" TCL_T_MODIFIER "d, new pc %" TCL_SIZE_MODIFIER "d\n",
		    rangePtr->codeOffset, (catchTop - initCatchTop - 1),
		    PTR2INT(*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.

	while (tosPtr > initTosPtr) {
	    objPtr = POP_OBJECT();
	    Tcl_DecrRefCount(objPtr);
	}

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

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;

    Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
    int bestCmdIdx = -1;

    /* The pc must point within the bytecode */
    assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));

    /*
     * Decode the code and source offset and length for each command. The
     * closest enclosing command is the last one whose code started before
     * pcOffset.
     */

    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n",
	    tclObjsAlloced);
    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n",
	    (tclObjsAlloced - tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
	    statsPtr->numLiteralsCreated);

    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_SIZE_MODIFIER "d (%0.1f%% of current objects)\n",
	    globalTablePtr->numEntries,
	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
	    numByteCodeLits,
	    Percent(numByteCodeLits, globalTablePtr->numEntries));
    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n",
	    numSharedMultX);

	    break;
	}
    }
    sum = 0;
    for (i = 0;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->literalCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
    }

    litTableStats = TclLiteralStats(globalTablePtr);
    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
	    litTableStats);
    Tcl_Free(litTableStats);

	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->srcCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {

	}
    }
    maxSizeDecade = i;
    sum = 0;
    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
	decadeHigh = (1 << (i+1)) - 1;
	sum += statsPtr->byteCodeCount[i];
	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
		decadeHigh, Percent(sum, statsPtr->numCompilations));
    }

    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
    minSizeDecade = maxSizeDecade = 0;
    for (i = 0;  i < 31;  i++) {

		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    if (statePtr->refCount <= 0) {
		/*
		 * Close it only if the refcount indicates that the channel is
		 * not referenced from any interpreter. If it is, that
		 * interpreter will close the channel when it gets destroyed.
		 */

		(void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0);

{
    ChannelState *statePtr = ((Channel *) chan)->state;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdinInitialized == 1
	    && tsdPtr->stdinChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdoutChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stderrInitialized == 1
	    && tsdPtr->stderrChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}


    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount <= 0) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_CloseEx().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {

    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (chanPtr->refCount == 0) {
	Tcl_Free(chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*

	}
    } else {
	/*
	 * This channel does not cover another one. Simply do a close, if
	 * necessary.
	 */

	if (statePtr->refCount <= 0) {
	    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * "TclChanCaughtErrorBypass" is not required here, it was
		 * done already by "Tcl_Close".
		 */

    Tcl_Free(bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount > 1;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */

    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }

     * This operation should occur at the top of a channel stack.
     */

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"

     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);

    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
    if (src == NULL) {
	Tcl_SetErrno(EILSEQ);
	result = TCL_INDEX_NONE;
    } else {
	result = WriteBytes(chanPtr, src, len);
    }

	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = (char *)memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0 && !encodingError) {
	ChannelBuffer *bufPtr;
	char *dst;
	int result, srcRead, dstLen, dstWrote;
	Tcl_Size srcLimit = srcLen;

	if (nextNewLine) {
	    srcLimit = nextNewLine - src;
	}

	/* Get space to write into */
	bufPtr = statePtr->curOutPtr;

				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    Tcl_Size charsStored;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored > 0) {
	TclDStringAppendObj(lineRead, objPtr);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*

     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; toRead != 0 ; ) {
	int copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }

	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = newValue[0];
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -eofchar: must be non-NUL ASCII"
			" character", TCL_INDEX_NONE));
	    }
	    Tcl_Free((void *)argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)argv);
	}

int
Tcl_IsChannelShared(
    Tcl_Channel chan)		/* The channel to query */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    return ((statePtr->refCount > 1) ? 1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *

ChanPendingObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;

    static const char *const options[] = {"input", "output", NULL};
    enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT} index;
    int mode;

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

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,

declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, TCL_HASH_TYPE numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)

#    ifdef LITTLE_ENDIAN
#	 if BYTE_ORDER == LITTLE_ENDIAN
#	     undef WORDS_BIGENDIAN
#	 endif
#    endif
#endif







/*
 * Macros used to cast between pointers and integers (e.g. when storing an int
 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
 * to/from pointer from/to integer of different size".
 */

#if !defined(INT2PTR)

#define ENCODING_PROFILE_MASK     0xFF000000
#define ENCODING_PROFILE_GET(flags_)  ((flags_) & ENCODING_PROFILE_MASK)
#define ENCODING_PROFILE_SET(flags_, profile_) \
    do {                                       \
	(flags_) &= ~ENCODING_PROFILE_MASK;    \
	(flags_) |= profile_;                  \
    } while (0)

/*
 *----------------------------------------------------------------------
 * Common functions for calculating overallocation. Trivial but allows for
 * experimenting with growth factors without having to change code in
 * multiple places. See TclAttemptAllocElemsEx and similar for usage
 * examples. Best to use those functions. Direct use of TclUpsizeAlloc /
 * TclResizeAlloc is needed in special cases such as when total size of
 * memory block is limited to less than TCL_SIZE_MAX.
 *
 *----------------------------------------------------------------------
 */
static inline Tcl_Size
TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with
				     * some growth algorithms that use this
				     * information. */,
	       Tcl_Size needed,
	       Tcl_Size limit)
{
    /* assert (oldCapacity < needed <= limit) */
    if (needed < (limit - needed/2)) {
	return needed + needed / 2;
    }
    else {
	return limit;
    }
}
static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) {
	/* assert (needed < lastAttempt) */
    if (needed < lastAttempt - 1) {
	/* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */
	return needed + (lastAttempt - needed) / 2;
    } else {
	return needed;
    }
}
MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr);
MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount,
			Tcl_Size elemSize, Tcl_Size leadSize,
			Tcl_Size *capacityPtr);
MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr,
			Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr);
/* Alloc elemCount elements of size elemSize with leadSize header
 * returning actual capacity (in elements) in *capacityPtr. */
static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize,
			Tcl_Size leadSize, Tcl_Size *capacityPtr) {
    return TclAttemptReallocElemsEx(
	NULL, elemCount, elemSize, leadSize, capacityPtr);
}
/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclAllocElemsEx(numBytes, 1, 0, capacityPtr);
}
/* Alloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *
TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr)
{
    return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr);
}
/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
}
/* Realloc numByte bytes, returning actual capacity in *capacityPtr. */
static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) {
    return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr);
}

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
 *----------------------------------------------------------------
 */

#endif
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,
			    TCL_HASH_TYPE stackSize, int flags);
MODULE_SCOPE Tcl_Size	TclpFindVariable(const char *name, Tcl_Size *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 void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    TCL_HASH_TYPE numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, Tcl_Size reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    Tcl_Size *reqlength);
MODULE_SCOPE int	TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,

    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)

#undef USE_THREAD_ALLOC
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". The value of "len" must
 * not be negative.  When "len" is 0, then it is acceptable to pass
 * "bytePtr" = NULL.  When "len" > 0, "bytePtr" must not be NULL, and it
 * must point to a location from which "len" bytes may be read.  These
 * constraints are not checked here.  The validity of the bytes copied
 * as a value string representation is also not verififed.  This macro
 * must not be called while "objPtr" is being freed or when "objPtr"
 * already has a string representation.  The caller must use
 * this macro properly.  Improper use can lead to dangerous results.
 * Because "len" is referenced multiple times, take care that it is an
 * expression with the same value each use.
 *
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void TclInitEmptyStringRep(Tcl_Obj *objPtr);
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 * MODULE_SCOPE void TclAttemptInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 *
 *----------------------------------------------------------------
 */

#define TclInitEmptyStringRep(objPtr) \
	((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0))


#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	TclInitEmptyStringRep(objPtr); \

    } else { \
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

#define TclAttemptInitStringRep(objPtr, bytePtr, len) \
    ((((len) == 0) ? ( \
	TclInitEmptyStringRep(objPtr) \
    ) : ( \
	(objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \
	(objPtr)->length = ((objPtr)->bytes) ? \
		(memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \
		(objPtr)->bytes[len] = '\0', (len)) : (-1) \
    )), (objPtr)->bytes)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the

EXTERN void		TclpFindExecutable(const char *argv0);
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp,
				TCL_HASH_TYPE numBytes);
/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);

    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, TCL_HASH_TYPE numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);

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
























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

    if (objc > LIST_MAX) {
	if (flags & LISTREP_PANIC_ON_FAIL) {
	    Tcl_Panic("max length of a Tcl list exceeded");
	}
	return NULL;
    }

    storePtr = NULL;
    if (flags & LISTREP_SPACE_FLAGS) {
	/* Caller requests extra space front, back or both */
	storePtr = (ListStore *)TclAttemptAllocElemsEx(
	    objc, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity);
    } else {


	/* Exact allocation */



	capacity = objc;
	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;

 *    The memory pointed to by storePtr is freed if it a new block has to
 *    be returned.
 *
 *
 *------------------------------------------------------------------------
 */
ListStore *
ListStoreReallocate (ListStore *storePtr, Tcl_Size needed)
{
    Tcl_Size capacity;





    if (needed > LIST_MAX) {







	return NULL;

    }
    storePtr = (ListStore *)TclAttemptReallocElemsEx(storePtr,

						     needed,
						     sizeof(Tcl_Obj *),
						     offsetof(ListStore, slots),
						     &capacity);



    /* Only the capacity has changed, fix it in the header */
    if (storePtr) {
	storePtr->numAllocated = capacity;
    }
    return storePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ListRepInit --
 *
 *      Initializes a ListRep to hold a list internal representation
 *      with space for objc elements.

    /*
     * Gather the information. Unsorted! (Caller will sort.)
     */

    *allocated = 1;
    Tcl_InitObjHashTable(&hashTable);
    FindClassProps(clsPtr, writable, &hashTable);
    TclNewObj(result);
    FOREACH_HASH(propName, dummy, &hashTable) {
	Tcl_ListObjAppendElement(NULL, result, propName);
    }
    Tcl_DeleteHashTable(&hashTable);

    /*
     * Cache the information. Also purges the cache.

    /*
     * Gather the information. Unsorted! (Caller will sort.)
     */

    *allocated = 1;
    Tcl_InitObjHashTable(&hashTable);
    FindObjectProps(oPtr, writable, &hashTable);
    TclNewObj(result);
    FOREACH_HASH(propName, dummy, &hashTable) {
	Tcl_ListObjAppendElement(NULL, result, propName);
    }
    Tcl_DeleteHashTable(&hashTable);

    /*
     * Cache the information.

    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->classPtr->properties.readable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

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

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->properties.readable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->classPtr->properties.writable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

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

    TclNewObj(resultObj);
    FOREACH(propNameObj, oPtr->properties.writable) {
	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

    if (all) {
	result = TclOOGetAllClassProperties(clsPtr, writable, &allocated);
	if (allocated) {
	    SortPropList(result);
	}
    } else {
	TclNewObj(result);
	if (writable) {
	    FOREACH(propObj, clsPtr->properties.writable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	} else {
	    FOREACH(propObj, clsPtr->properties.readable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);

    if (all) {
	result = TclOOGetAllObjectProperties(oPtr, writable, &allocated);
	if (allocated) {
	    SortPropList(result);
	}
    } else {
	TclNewObj(result);
	if (writable) {
	    FOREACH(propObj, oPtr->properties.writable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);
	    }
	} else {
	    FOREACH(propObj, oPtr->properties.readable) {
		Tcl_ListObjAppendElement(NULL, result, propObj);

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from tools/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"

    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %" TCL_SIZE_MODIFIER "d\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",

    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. */
{
    objPtr->refCount = 0;
    objPtr->typePtr = NULL;
    TclInitEmptyStringRep(objPtr);

#if TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewObj(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    Tcl_Obj *objPtr;
    TclNewObj(objPtr);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --

    return dupPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TclDuplicatePureObj --
 *
 *	Duplicates a Tcl_Obj and converts the internal representation of the
 *	duplicate to the given type, changing neither the 'bytes' field
 *	nor the internal representation of the original object, and without
 *	duplicating the bytes field unless necessary, i.e. unless the
 *	duplicate provides no updateStringProc after conversion.  This can
 *	avoid an expensive memory allocation since the data in the 'bytes'

    if (bytes && (dupPtr->typePtr == NULL
	|| dupPtr->typePtr->updateStringProc == NULL
	|| typePtr == &tclStringType
	)
    ) {
	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"insufficient memory to initialize string", -1));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    status = TCL_ERROR;
	}
    }
    return status;
}

Tcl_Obj *
TclDuplicatePureObj(
    Tcl_Interp *interp,

    size_t numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    if (objPtr->bytes == NULL) {
	/* Start with no string rep */
	if (numBytes == 0) {
	    TclInitEmptyStringRep(objPtr);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		if (bytes) {
		    memcpy(objPtr->bytes, bytes, numBytes);

		objPtr->bytes[objPtr->length] = '\0';
	    }
	}
    } else {
	/* Start with non-empty string rep (allocated) */
	if (numBytes == 0) {
	    Tcl_Free(objPtr->bytes);
	    TclInitEmptyStringRep(objPtr);
	    return objPtr->bytes;
	} else {
	    objPtr->bytes = (char *)Tcl_AttemptRealloc(objPtr->bytes,
		    numBytes + 1);
	    if (objPtr->bytes) {
		objPtr->length = numBytes;
		objPtr->bytes[objPtr->length] = '\0';

 *----------------------------------------------------------------------
 *
 * Tcl_StoreInternalRep --
 *
 *	Called to set the object's internal representation to match a
 *	particular type.
 *
 *	It is the caller's responsibility to guarantee that
 *	the value of the submitted internalrep is in agreement with
 *	the value of any existing string rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
 *	Sets the internalRep and typePtr fields to the submitted values.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_StoreInternalRep(
    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
    const Tcl_ObjType *typePtr,	/* New type for the object */
    const Tcl_ObjInternalRep *irPtr)	/* New internalrep for the object */
{
    /* Clear out any existing internalrep ( "shimmer" ) */


    TclFreeInternalRep(objPtr);

    /* When irPtr == NULL, just leave objPtr with no internalrep for typePtr */
    if (irPtr) {
	/* Copy the new internalrep into place */
	objPtr->internalRep = *irPtr;

	/* Set the type to match */
	objPtr->typePtr = typePtr;
    }
}


    int newBool;
    char lowerCase[6];
    Tcl_Size i, length;
    const char *str = Tcl_GetStringFromObj(objPtr, &length);

    if ((length == 0) || (length > 5)) {
	/*
	 * Longest valid boolean string rep. is "false".
	 */

	return TCL_ERROR;
    }

    switch (str[0]) {
    case '0':
	if (length == 1) {

		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
		 * bignum values are converted to empty string.
		 */
		if (objPtr->bytes == NULL) {
		    TclInitEmptyStringRep(objPtr);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == tclIntType) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {

 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount > 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *

     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return result;
}

	copy = Tcl_DuplicateObj(copy);
    }

    Tcl_IncrRefCount(copy);
    /* Steal copy's string rep */
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitEmptyStringRep(copy);
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativePathInFilesystem --

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    va_start(argList, interp);
    TclNewObj(errorObj);

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    while (1) {

	}
    } else {
	/*
	 * Here no vars were specified, we want a list returned (inline scan)
	 * We create an empty Tcl_Obj to fill missing values rather than
	 * allocating a new Tcl_Obj every time. See test scan-bigdata-XX.
	 */
	Tcl_Obj *emptyObj;
	TclNewObj(emptyObj);
	Tcl_IncrRefCount(emptyObj);
	TclNewObj(objPtr);
	for (i = 0; code == TCL_OK && i < totalVars; i++) {
	    if (objs[i] != NULL) {
		code = Tcl_ListObjAppendElement(interp, objPtr, objs[i]);
		Tcl_DecrRefCount(objs[i]);
	    } else {

static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, Tcl_Size numBytes,
			    Tcl_Size numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static Tcl_Size		GetCharLength(Tcl_Obj *objPtr);
static Tcl_Obj*		GetRange(tclObjTypeInterfaceArgsStringRange);
static void		GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, Tcl_Size numChars);
static Tcl_Size		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

/*

#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif

static void
GrowStringBuffer(
    Tcl_Obj *objPtr,
    Tcl_Size needed, /* Not including terminating nul */
    int flag)      /* If 0, try to overallocate */
{
    /*
     * Preconditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    String *stringPtr = GET_STRING(objPtr);
    char *ptr;
    Tcl_Size capacity;

    assert(needed <= TCL_SIZE_MAX - 1);
    needed += 1; /* Include terminating nul */

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }




    /*


     * In code below, note 'capacity' and 'needed' include terminating nul,
     * while stringPtr->allocated does not.
     */
    if (flag == 0 || stringPtr->allocated > 0) {
	ptr = (char *)TclReallocEx(objPtr->bytes, needed, &capacity);


    } else {

	/* Allocate exact size */
	ptr = (char *)Tcl_Realloc(objPtr->bytes, needed);


	capacity = needed;



    }



    objPtr->bytes = ptr;
    stringPtr->allocated = capacity - 1; /* Does not include slot for end nul */
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    Tcl_Size needed)
{
    /*
     * Preconditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     */

    String *stringPtr = GET_STRING(objPtr);
    Tcl_Size maxChars;

    /* Note STRING_MAXCHARS already takes into account space for nul */
    if (needed > STRING_MAXCHARS) {
	Tcl_Panic("max size for a Tcl unicode rep (%" TCL_Z_MODIFIER "d bytes) exceeded",
		  STRING_MAXCHARS);
    }
    if (stringPtr->maxChars > 0) {



	/* Expansion - try allocating extra space */

	stringPtr = (String *)TclReallocElemsEx(stringPtr,

						needed + 1, /* +1 for nul */
						sizeof(Tcl_UniChar),


						offsetof(String, unicode),
						&maxChars);

	maxChars -= 1; /* End nul not included */


    }


    else {
	/*
	 * First allocation - just big enough. Note needed does
	 * not include terminating nul but STRING_SIZE does
	 */
	stringPtr = (String *)Tcl_Realloc(stringPtr, STRING_SIZE(needed));
	maxChars = needed;

    }

    stringPtr->maxChars = maxChars;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --

    }
    ch = stringPtr->unicode[index];
    return ch;
}

int
TclGetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode character
				 * from. */
    Tcl_Size index)		/* Get the index'th Unicode character. */
{
    int ch = 0;

    if (index < 0) {
	return -1;

Tcl_Obj *
GetRange(tclObjTypeInterfaceArgsStringRange) {
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    Tcl_Size length = 0;

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

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)Tcl_AttemptAlloc(length + 1U);
	    } else {
		newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1U);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}

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

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*

	    if (gotXpg) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotSequential = 1;
	}
	if ((objIndex < 0) || (objIndex >= objc)) {
	    msg = badIndex[gotXpg];
	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
	    goto errorMsg;
	}

	/*
	 * Step 2. Set of flags.

	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, snprintf(bytes, segment->length, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *q = TclGetString(segment) + 1;
		*q = 'x';

	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr),
		(count - done) * length);
    }
    return objResultPtr;

}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCat --
 *

    Tcl_Size first = objc - 1;	/* Index of first value possibly not empty */
    Tcl_Size last = 0;		/* Index of last value possibly not empty */
    int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);

    /* assert ( objc >= 0 ) */

    if (objc <= 1) {
	if (objc != 1) {
	    /* Negative (shouldn't be) no objects; return empty */
	    Tcl_Obj *obj;
	    TclNewObj(obj);
	    return obj;
	}
	/* One object; return first */
	return objv[0];
    }

    /* assert ( objc >= 2 ) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.

	    objResultPtr = *objv++; objc--;

	    (void)Tcl_GetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeInternalRep(objResultPtr);
	} else {
	    TclNewObj(objResultPtr);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_SIZE_MODIFIER "d bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr);
	}

			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
			if (reqlength > 0) {
			    reqlength *= sizeof(Tcl_UniChar);
			}
		    } else {
			memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {

		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength < 0) && !nocase) {
		    memCmpFn = (memCmpFn_t)(void *)TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)(void *)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	/* At this point s1len, s2len, and reqlength should by now have been
	 * adjusted so that they are all in the units expected by the selected

     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */

    stringPtr->allocated = 0;

    if (stringPtr->numChars == 0) {
	TclInitEmptyStringRep(objPtr);
    } else {
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

static Tcl_Size

typedef struct {
    Tcl_Size numChars;		/* The number of chars in the string.
				 * TCL_INDEX_NONE means this value has not been
				 * calculated. Any other means that there is a valid
				 * Unicode rep, or that the number of UTF bytes ==
				 * the number of chars. */
    Tcl_Size allocated;		/* The amount of space allocated for
				 * the UTF-8 string. Does not include nul
				 * terminator so actual allocation is
				 * (allocated+1). */
    Tcl_Size maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the Unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Tcl_UniChar representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Tcl_UniChar units.
				 * The actual size of this field depends on
				 * the maxChars field above. */

	return TCL_ERROR;
    }

    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n);
    if (p == NULL) {
	return TCL_ERROR;
    }
#if !defined(TCL_NO_DEPRECATED) && defined(__clang__)
#   pragma clang diagnostic pop
#endif

    if (x.m != 1) {
	Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n));
    return TCL_OK;
}

    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
	    NULL, NULL);
    if (sizeof(Tcl_Size) == sizeof(Tcl_WideInt)) {
	Tcl_CreateObjCommand(interp, "testbigdata", TestbigdataCmd,
		NULL, NULL);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbignumobjCmd --

    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	/* List object for which an element array
					 * is to be returned. */
    TCL_UNUSEDVAR(Tcl_Size *objcPtr),	/* Where to store the count of objects
					 * referenced by objv. */
    TCL_UNUSEDVAR(Tcl_Obj ***objvPtr)	/* Where to store the pointer to an
					 * array of */
) {
    ListInteger *listRepPtr;
    listRepPtr = ListGetInternalRep(listPtr);
    *objcPtr = listRepPtr->used;
    *objvPtr = listRepPtr->values;
    return TCL_OK;
}

static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
    int status;
    Tcl_Size length;
    status = Tcl_ListObjLength(interp, listPtr, &length);
    if (status != TCL_OK) {

{
    const char *p = src;
    Tcl_Size nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    Tcl_Size extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    Tcl_Size bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */

				 * at end. */
{
    Tcl_Size newSize;

    if (length < 0) {
	length = strlen(bytes);
    }

    if (length > (TCL_SIZE_MAX - dsPtr->length - 1)) {
	Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER
		  "d bytes) exceeded",
		  TCL_SIZE_MAX);
	return NULL; /* NOTREACHED */
    }
    newSize = length + dsPtr->length + 1;







    if (newSize > dsPtr->spaceAvl) {

	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString;
	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    Tcl_Size offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		/* Source string is within this DString. Note offset */
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string =
		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again. SPECIAL NOTE: must use
     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */
    newSize += 1; /* For terminating nul */
    if (newSize > dsPtr->spaceAvl) {

	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString;
	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		/* Source string is within this DString. Note offset */
		offset = element - dsPtr->string;
	    }

	    dsPtr->string =
		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;

    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend.
	 * TODO - the above makes no sense to me. How does the code below
	 * translate into distinguishing the two cases above? IMO, if caller
	 * specifically sets the length, there is no cause for overallocation.
	 */

	if (length >= TCL_SIZE_MAX) {
	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
	}
	newsize = TclUpsizeAlloc(dsPtr->spaceAvl, length + 1, TCL_SIZE_MAX);
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);

	 * Are there any entries in the zipHash? Don't need to enumerate them
	 * all to know.
	 */

	return (ZipFS.zipHash.numEntries ? TCL_OK : TCL_BREAK);
    }

    TclNewObj(resultList);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
		zf->mountPoint, -1));
	Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj(
		zf->name, -1));

    # make a reasonable guess, but this table needs to be taken with a grain
    # of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
	{-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
	{-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
	{-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
	{-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
	{-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
	{-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Phoenix
	{-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Regina
	{-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
	{-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
	{-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
	{-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Indianapolis
	{-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Caracas
	{-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
							 :America/Santiago
	{-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
	{-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
	{-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
	{-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
	{-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
	{-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :America/Buenos_Aires
	{-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
	{-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
	{-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0}   :America/Noronha
	{-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Atlantic/Azores
	{-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Atlantic/Cape_Verde
	{0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}       :UTC
	{0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0}      :Europe/London
	{3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Kinshasa
	{3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :CET
	{7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}    :Africa/Harare
	{7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
			      				 :Africa/Cairo
	{7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0}   :Europe/Helsinki
	{7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0}    :Asia/Jerusalem
	{7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0}    :Europe/Bucharest
	{7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}   :Europe/Athens
	{7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0}    :Asia/Amman
	{7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
							 :Asia/Beirut
	{7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0}   :Africa/Windhoek
	{10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Riyadh
	{10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0}  :Asia/Baghdad
	{10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Europe/Moscow
	{12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0}   :Asia/Tehran
	{14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0}  :Asia/Baku
	{14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Muscat
	{14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Tbilisi
	{16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Kabul
	{18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Karachi
	{18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0}  :Asia/Yekaterinburg
	{19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Calcutta
	{20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Asia/Katmandu

	wast	+0700 \
	wadt	+0800 \
	jt	+0730 \
	cct	+0800 \
	jst	+0900 \
	kst     +0900 \
	cast	+0930 \
	jdt     +1000 \
	kdt     +1000 \
	cadt	+1030 \
	east	+1000 \
	eadt	+1030 \
	gst	+1000 \
	nzt	+1200 \
	nzst	+1200 \
	nzdt	+1300 \

	}
	percentO {
	    append retval %%O
	}
    }

    proc $procName {clockval timezone} "
	$preFormatCode
	return \[::format [list $formatString] $substituents\]
    "

    #    puts [list $procName [info args $procName] [info body $procName]]

    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	Inputs a count of seconds since the Posix Epoch as a time of day.
#
# The 'clock scan' command scans times of day on input.  Refer to the user
# documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

    # Check the count of args

    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
	set cmdName "clock scan"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName string\
	     ?-base seconds?\
	     ?-format string? ?-gmt boolean?\
	     ?-locale LOCALE? ?-timezone ZONE?\""
    }

    # Set defaults

    set base [clock seconds]
    set string [lindex $args 0]
    set format {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    # Pick up command line options.

    foreach { flag value } [lreplace $args 0 0] {

	switch -exact -- $flag {
	    -b - -ba - -bas - -base {
		set base $value
	    }
	    -f - -fo - -for - -form - -forma - -format {
		set saw(-format) {}
		set format $value
	    }
	    -g - -gm - -gmt {
		set saw(-gmt) {}
		set gmt $value
	    }
	    -l - -lo - -loc - -loca - -local - -locale {
		set saw(-locale) {}
		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set saw(-timezone) {}
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\",\
		     must be -base, -format, -gmt, -locale or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {

    append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]

    # Assemble seconds from the Julian day and second of the day.
    # Convert to local time unless epoch seconds or stardate are
    # being processed - they're always absolute

    if { ![dict exists $fieldSet seconds]
	 && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds [expr {
		-210866803200

		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}

		d    %e
		MMMM %B
		MMM  %b
		MM   %m
		M    %N
		yyyy %Y
		yy   %y
		y    %y
		gg   {}
	    } $unquoted]
	    if { $quoted eq {} } {
		set quote '
	    } else {
		set quote $quoted
	    }
	}

    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
    } else {
	# Cache the time zone only if it was detected by one of the
	# expensive methods.
	if { [info exists CachedSystemTimeZone] } {
	    set timezone $CachedSystemTimeZone
	} elseif { $::tcl_platform(platform) eq {windows} } {
	    set timezone [GuessWindowsTimeZone]
	} elseif { [file exists /etc/localtime]
		   && ![catch {ReadZoneinfoFile \
				   Tcl/Localtime /etc/localtime}] } {
	    set timezone :Tcl/Localtime
	} else {
	    set timezone :localtime
	}
	set CachedSystemTimeZone $timezone
    }
    if { ![dict exists $TimeZoneBad $timezone] } {
	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime

	([-+]?)
	# 3 - Standard time zone offset, hours
	([[:digit:]]{1,2})
	(?:
	    # 4 - Standard time zone offset, minutes
	    : ([[:digit:]]{1,2})
	    (?:
		# 5 - Standard time zone offset, seconds
		: ([[:digit:]]{1,2} )
	    )?
	)?
	(?:
	    # 6 - DST time zone name
	    ([[:alpha:]]+ | <[-+[:alnum:]]+>)
	    (?:
		(?:
		    # 7 - DST time zone offset, signum
		    ([-+]?)
		    # 8 - DST time zone offset, hours
		    ([[:digit:]]{1,2})
		    (?:
			# 9 - DST time zone offset, minutes
			: ([[:digit:]]{1,2})
			(?:
			    # 10 - DST time zone offset, seconds
			    : ([[:digit:]]{1,2})
			)?
		    )?
		)?
		(?:
		    ,
		    (?:
			# 11 - Optional J in n and Jn form 12 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 13 - Month number 14 - Week of month 15 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 16 - Start time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 17 - Start time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 18 - Start time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		    ,
		    (?:
			# 19 - Optional J in n and Jn form 20 - Day of year
			( J ? )	( [[:digit:]]+ )
			| M
			# 21 - Month number 22 - Week of month 23 - Day of week
			( [[:digit:]] + )
			[.] ( [[:digit:]] + )
			[.] ( [[:digit:]] + )
		    )
		    (?:
			# 24 - End time of DST - hours
			/ ( [[:digit:]]{1,2} )
			(?:
			    # 25 - End time of DST - minutes
			    : ( [[:digit:]]{1,2} )
			    (?:
				# 26 - End time of DST - seconds
				: ( [[:digit:]]{1,2} )
			    )?
			)?
		    )?
		)?
	    )?
	)?
	$
    } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \

proc ::tcl::clock::add { clockval args } {
    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
	     \"$cmdName clockval ?number units?...\
	     ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {
	if { [string is integer -strict $a] } {
	    lappend offsets $a $b
	} else {
	    switch -exact -- $a {
		-g - -gm - -gmt {
		    set saw(-gmt) {}
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set saw(-timezone) {}
		    set timezone $b
		}
		default {
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\",\
			 must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", must be \
			years, months, weeks, days, hours, minutes or seconds"
		}
	    }
	}
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo

proc ::tcl::clock::ChangeCurrentLocale {args} {
    variable FormatProc
    variable LocaleNumeralCache
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*'current] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*'current] {
	rename $p {}
    }

    catch {array unset FormatProc *'current}
    set LocaleNumeralCache {}
}

#----------------------------------------------------------------------

    }
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-57.2 {clock scan - not -gmt and -timezone in the same call} {
    catch {clock scan 1970-01-01 -format %Y-%m-%d -gmt true -timezone :Europe/Berlin}
} 1

test clock-57.3 {clock scan - not -g and -timezone in the same call} {
    catch {clock scan 1970-01-01 -format %Y-%m-%d -g true -timezone :Europe/Berlin}
} 1

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {

	    set retval {}
	    foreach char [split $string {}] {

    -body {
	clock add 0 1 year -foo bar
    }
    -match glob
    -returnCodes error
    -result {bad option "-foo"*}
}

test clock-65.2 {clock add with both -timezone and -gmt} {*}{
    -body {
	clock add 0 1 year -timezone :CET -gmt true
    }
    -match glob
    -returnCodes error
    -result {cannot use -gmt and -timezone in same call}
}

test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
    -setup {
	::tcl::clock::ClearCaches
    }
    -body {
	clock scan 1200 \

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]

testConstraint utf8system [string equal [encoding system] utf-8]
if {[llength [auto_execok bash]]} {
    testConstraint haveBash 1
}

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {

    flush $pipe
    set result [gets $pipe]
    close $pipe
    if {$result ne $::env(USERPROFILE)} {
	list ERROR $result ne $::env(USERPROFILE)
    }
} -result {}

test env-10.0 {
    Unequal environment strings test should test unequal
} -constraints {unix haveBash utf8system knownBug} -setup {
    set tclScript [makeFile {
        puts [string equal $env(XX) $env(YY)]
    } tclScript]
    set shellCode {
        export XX=$'\351'
        export YY=$'\303\251'
    }
    append shellCode "[info nameofexecutable] $tclScript\n"
    set shScript [makeFile $shellCode shScript]
} -body {
    exec {*}[auto_execok bash] $shScript
} -result 0



# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}

    glob -nocomplain -directory [file home] -join * fileName-20.10
} -cleanup {
    cd $savewd
    removeDirectory isolate
    removeFile fileName-20.10 $s
    removeDirectory sub [file home]
} -result [file home]/sub/fileName-20.10
test fileName-20.11 {glob dir with undecodable file names} -setup {
    # Specifically use /tmp as on WSL [temporaryDirectory]
    # on NTFS prevents creation of arbitrary byte sequences in names.
    set prevDir [pwd]
    set testDir /tmp/tcltest/fileName-20.11
    file delete -force $testDir; # Clear it
    file mkdir $testDir
    cd $testDir
    set prevEnc [encoding system]
    # Create a file name that is invalid if interpreted as utf-8
    encoding system iso8859-1
    close [open \xe9 w]
} -cleanup {
    encoding system $prevEnc
    cd $prevDir
    file delete -force $testDir
} -constraints {unix knownBug} -body {
    set result [file exists [lindex [glob *] 0]]
    encoding system utf-8
    lappend result [file exists [lindex [glob *] 0]]
} -result {1 1}

apply [list {} {
    test fileName-6d4e9d1af5bf5b7d {
	memory leak in SetFsPathFromAny

	Runs under both a TCL_DEBUG_MEM build and a -DPURIFY build for
	valgrind, which is useful since Valgrind provides information about the

    set in [read $f]
    read $f
    scan [string index $in end] %c
} -cleanup {
    catch {close $f}
} -result 194


test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
    set f [open $path(test1) w]
    fconfigure $f -translation binary
    puts -nonewline $f [string repeat a 9]\xC2
    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding utf-8 -profile strict -buffersize 10
    set in [read $f]

    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}
test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
	writable so we can't change -eofchar or -translation } {
    set l [list]
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    fconfigure $sock -eofchar D -translation lf
    lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
    close $sock
    set l
} {{} auto}

    set f4 [open $path(foo) r]
    testfevent create
    testfevent share $f3
    testfevent share $f4
    fileevent $f readable {script 1}
    fileevent $f2 readable {script 2}
    testfevent cmd "fileevent $f3 readable {script 3}
    fileevent $f4 readable {script 4}"
    testfevent delete
    set x [list [fileevent $f readable] [fileevent $f2 readable] \
		[fileevent $f3 readable] [fileevent $f4 readable]]
    close $f
    close $f2
    close $f3
    close $f4

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means reading the "Á" gives an error
    fconfigure $in  -encoding ascii -profile strict
    fconfigure $out -encoding koi8-r -translation lf
    proc ::xxx args {
	set ::s0 $args
    }

    fcopy $in $out -command ::xxx
    vwait ::s0
    set ::s0
} -cleanup {
    close $in

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # Using "-encoding ascii" means writing the "Á" gives an error
    fconfigure $in  -encoding utf-8
    fconfigure $out -encoding ascii -translation lf -profile strict
    proc ::xxx args {
	set ::s0 $args
    }

    fcopy $in $out -command ::xxx
    vwait ::s0
    set ::s0
} -cleanup {
    close $in

    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is an incomplete byte sequence in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
	    -translation lf -profile strict
} -body {
    gets $f
} -cleanup {
    close $f
    removeFile io-75.6
} -match glob -returnCodes 1 -result {error reading "file*":\
	invalid or incomplete multibyte or wide character}

test io-75.7.gets {
    invalid utf-8 encoding gets is not ignored (-profile strict)
} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8
    puts -nonewline $f A\x81
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
	    -profile strict
} -body {
    list [catch {read $f} msg] $msg
} -cleanup {
    close $f
    removeFile io-75.7
} -match glob -result {1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\xA1\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set status [catch {read $f} cres copts]
    set d [dict get $copts -result read]
    binary scan $d H* hd
    lappend hd [eof $f]
    lappend hd $status
    lappend hd $cres
    fconfigure $f -encoding iso8859-1
    lappend hd [read $f];# We changed encoding, so now we can read the \xA1
    close $f
    set hd
} -cleanup {
    removeFile io-75.7
} -match glob -result {41 0 1 {error reading "file*":\
	invalid or incomplete multibyte or wide character} ¡}

test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
    set fn [makeFile {} io-75.7]
    set f [open $fn w+]
    fconfigure $f -encoding binary
    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\xA1\x1A

    removeFile io-75.8
} -result {41 1 {}}


test {io-75.8 {invalid before eof}} {
	invalid utf-8 encoding eof handling (-profile strict)
} -setup {

    set fn [makeFile {} io-75.8]
    set f [open $fn w+]
    # This also configures the channel encoding profile as strict.
    fconfigure $f -encoding binary
    # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later.
    puts -nonewline $f A\x81\x81\x1A
    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
	-translation lf -profile strict
} -body {
    set res [list [catch {read $f} cres] [eof $f]]


    chan configure $f -encoding iso8859-1
    lappend res [read $f 1]
    chan configure $f -encoding utf-8
    catch {read $f 1} cres
    lappend res $cres
    close $f
    set res

    set chan [file tempfile];
    fconfigure $chan -encoding binary
    puts -nonewline $chan \x81\x1A
    flush $chan
    seek $chan 0
    chan configure $chan -encoding utf-8 -profile strict
} -body {
    list [catch {read $chan 1} cres] $cres

} -cleanup {
    close $chan
    unset res
} -match glob -result {1 {error reading "*":\
    invalid or incomplete multibyte or wide character}}

    flush $f
    seek $f 0
    fconfigure $f -encoding shiftjis -blocking 0 -eofchar {} -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {set d [read $f]} msg] $msg

} -cleanup {
    close $f
    removeFile io-75.11
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

    flush $f
    seek $f 0
    fconfigure $f -encoding utf-8 -blocking 0 -eofchar {} -translation lf \
	-profile strict
} -body {
    set d [read $f]
    binary scan $d H* hd
    lappend hd [catch {read $f} msg] $msg

} -cleanup {
    close $f
    removeFile io-75.13
} -match glob -result {41 1 {error reading "file*":\
    invalid or incomplete multibyte or wide character}}

test io-75.14 {
	[gets] succesfully returns lines prior to error

	invalid utf-8 encoding [gets] continues in non-strict mode after error
} -setup {
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xC0\n is an invalid utf-8 sequence
    puts -nonewline $chan a\nb\nc\xC0\nd\n
    flush $chan
    seek $chan 0
    fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \
	-translation auto -profile strict
} -body {
    lappend res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} cres] $cres

    chan configure $chan -profile tcl8
    lappend res [gets $chan]
    lappend res [gets $chan]
    close $chan
    return $res
} -match glob -result {a b 1 {error reading "*":\
    invalid or incomplete multibyte or wide character} cÀ d}

test io-75.15 {
    invalid utf-8 encoding strict
    gets does not hang
    gets succeeds for the first two lines
} -setup {
    set res {}
    set chan [file tempfile]
    fconfigure $chan -encoding binary
    # \xC0\x40 is an invalid utf-8 sequence
    puts $chan hello\nAB\nCD\xC0\x40EF\nGHI
	seek $chan 0
} -body {
    #Now try to read it with [gets]
    fconfigure $chan -encoding utf-8 -profile strict
    lappend res [gets $chan]
    lappend res [gets $chan]
    lappend res [catch {gets $chan} cres] $cres

    lappend res [catch {gets $chan} cres] $cres

	chan configure $chan -translation binary
	set data [read $chan 4]
	foreach char [split $data {}] {
		scan $char %c ord
		lappend res [format %x $ord]
	}
    fconfigure $chan -encoding utf-8 -profile strict -translation auto

test iocmd-8.4 {fconfigure command} -setup {
    file delete $path(test1)
    set f1 [open $path(test1) w]
} -body {
    fconfigure $f1 froboz
} -returnCodes error -cleanup {
    close $f1
} -result [expectedOpts "froboz" -stat]
test iocmd-8.5 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -buffering froboz
} -result {bad value for -buffering: must be one of full, line, or none}
test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {

    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    removeFile $f
} -result 341234x6
test ioCmd-13.12 {open file produces something that has fconfigure -stat} -setup {
    set f [makeFile {} iocmd13_12]
    set result {}
} -body {
    set fd [open $f wb]
    set result [dict get [fconfigure $fd -stat] type]
    fconfigure $fd -buffering none
    puts -nonewline $fd abc
    # Three ways of getting the size; all should agree!
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd def
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    puts -nonewline $fd ghi
    lappend result [tell $fd] [file size $f] \
	[dict get [fconfigure $fd -stat] size]
    close $fd
    return $result
} -cleanup {
    removeFile $f
} -result {file 3 3 3 6 6 6 9 9 9}

test iocmd-14.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}

	    catch {unset lis}
	    catch {rename p ""}

	    test linsert-1.1-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 0 a
	    } {a 1 2 3 4 5}
	    test linsert-1.2-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 1 a
	    } {1 a 2 3 4 5}
	    test linsert-1.3-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 2 a
	    } {1 2 a 3 4 5}
	    test linsert-1.4-@mode@ {linsert command} {
		@linsert@ [newlist {1 2 3 4 5}] 3 a
	    } {1 2 3 a 4 5}

		    @linsert@ [newlist $list] 1 "x y"
		    return "a b c"
		}
		p
	    } "a b c"
	    test linsert-3.2-@mode@ {linsert won't modify shared argument objects} {
		catch {unset lis}
		puts boom
		set lis [format "a \"%s\" c" "b"]
		@linsert@ [newlist $lis] 0 [string length $lis]
	    } "7 a b c"

	    # cleanup
	    catch {unset lis}
	    catch {rename p ""}

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

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

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

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

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] 3 2 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] 3 2 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

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

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

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

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} 3 2 1]

test listrep-3.28 {
    Replacement of elements at back with same number of elements in unshared
    spanned list is in-place - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $end-1 $end 10 11]
    validate $l

    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()
} -constraints testlistrep -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 4]

test listrep-3.33 {
    Replacement of elements in the middle in an unshared spanned list with
    the same number of elements - lreplace version
} -constraints testlistrep -body {
    set l [lreplace [freeSpaceBoth] $two $four 10 11 12]
    validate $l

    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()
} -constraints testlistrep -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 5]

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

    -result {wrong # args: should be "lseq n ??op? n ??by? n??"}


test lseq-1.2 {step magnitude} {
    lseq 10 .. 1 by -2 ;# or this could be an error - or not
} {10 8 6 4 2}

test lseq-1.3 {synergy between int and double} -body {
    set rl [lseq 25. to 5. by -5]
    set il [lseq 25  to 5  by -5]
    lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} }
} -cleanup {
    unset rl il
} -result {1 1 1 1 1}

test lseq-1.4 {integer decreasing} {
    lseq 10 .. 1
} {10 9 8 7 6 5 4 3 2 1}

test lseq-1.5 {integer increasing} {
    lseq 1 .. 10

	[lseq -10 1 -3] \
	[lseq 10 -1 -4] \
	[lseq -10 -1 3] \
	[lseq 10 1 -5]

} {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}}

test lseq-3.1 {experiement} -body {
    set ans {}
    foreach factor [lseq 2.0 10.0] {
	set start 1
	set end 10
	for {set step 1} {$step < 1e8} {} {
	    set l [lseq $start to $end by $step]
	    if {[llength $l] != 10} {
		lappend ans $factor $step [llength $l] $l
	    }
	    set step [expr {$step * $factor}]
	    set end [expr {$end * $factor}]
	}
    }
    if {$ans eq {}} {
	set ans OK
    }


    set ans
} -cleanup {
    unset ans step end start factor l
} -result {OK}

test lseq-3.2 {error case} -body {
    lseq foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.3 {error case} -body {
    lseq 10 foo
} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by}

test lseq-3.4 {error case} -body {
    lseq 25 or 6
} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by}

test lseq-3.5 {simple count and step arguments} -body {
    set s [lseq 25 by 6]
    list $s length=[llength $s]
} -cleanup {
    unset s
} -result {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25}

test lseq-3.6 {error case} -body {
    lseq 1 7 or 3
} -returnCodes 1  -result {bad operation "or": must be .., to, count, or by}

test lseq-3.7 {lmap lseq} -body {
    lmap x [lseq 5] { expr {$x * $x} }
} -cleanup {unset x} -result {0 1 4 9 16}

test lseq-3.8 {lrange lseq} -body {
    set r [lrange [lseq 1 100] 10 20]
    set empty [lrange [lseq 1 100] 20 10]
    list $r $empty [lindex [tcl::unsupported::representation $r] 3]
} -cleanup {
    unset r empty
} -result {{11 12 13 14 15 16 17 18 19 20 21} {} arithseries}

test lseq-3.9 {lassign lseq} -constraints arithSeriesShimmer -body {
    set r [lseq 15]
    set r2 [lassign $r a b]
    list [lindex [tcl::unsupported::representation $r] 3] $a $b \
	[lindex [tcl::unsupported::representation $r2] 3]
} -cleanup {unset r r2 a b} -result {arithseries 0 1 arithseries}

test lseq-3.10 {lsearch lseq must shimmer?} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set a [lsearch $r 9]
    list [lindex [tcl::unsupported::representation $r] 3] $a
} -cleanup {unset r a} -result {arithseries 6}

test lseq-3.11 {lreverse lseq} -body {
    set r [lseq 15 0]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n
} -cleanup {unset r a} -result {arithseries
15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
arithseries
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15}

test lseq-3.12 {in operator} -body {
    set r [lseq 9]
    set i [expr {7 in $r}]
    set j [expr {10 ni $r}]
    set k [expr {-1 in $r}]
    set l [expr {4 ni $r}]
    list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3]
} -cleanup {
    unset r i j k l
} -result {1 1 0 0 arithseries}

test lseq-3.13 {lmap lseq shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set m [lmap i $r { expr {$i * 7} }]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    set rep-m [lindex [tcl::unsupported::representation $m] 3]
    list $r ${rep-before} ${rep-after} ${rep-m} $m
} -cleanup {
    unset r rep-before m rep-after rep-m
} -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}}

test lseq-3.14 {array for shimmer} -constraints arithSeriesShimmerOk -body {
    array set testarray {a Test for This great Function}
    set vars [lseq 2]
    set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
    after 1
    array for $vars testarray {
	lappend keys $0
	lappend vals $1
    }
    # Since hash order is not guaranteed, have to validate content ignoring order
    set valk [lmap k $keys {expr {$k in {a for great}}}]
    set valv [lmap v $vals {expr {$v in {Test This Function}}}]
    set vars-after [lindex [tcl::unsupported::representation $vars] 3]
    list ${vars-rep} $valk $valv ${vars-after}
} -cleanup {
    unset testarray vars vars-rep 0 valk k  valv v vars-after
} -result {arithseries {1 1 1} {1 1 1} arithseries}

test lseq-3.15 {join for shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 3]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set str [join $r :]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $str ${rep-after}
} -cleanup {
    unset r rep-before str rep-after
} -result {arithseries 0:1:2 arithseries}

test lseq-3.16 {error case} -body {
    lseq 16 to
} -returnCodes 1 -result {missing "to" value.}

test lseq-3.17 {error case} -body {
    lseq 17 to 13 by

    llength [lseq 1 to 1 1]
} {1}

test lseq-3.25 {edge case} {
    llength [lseq 1 to 1 by 1]
} {1}

test lseq-3.26 {lsort shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lsort $r]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}
} -cleanup {
    unset r rep-before lexical_sort rep-after
} -result {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries}

test lseq-3.27 {lreplace shimmer} -constraints arithSeriesShimmer -body {
    set r [lseq 15 0]
    set rep-before [lindex [tcl::unsupported::representation $r] 3]
    set lexical_sort [lreplace $r 3 5 A B C]
    set rep-after [lindex [tcl::unsupported::representation $r] 3]
    list ${rep-before} $lexical_sort ${rep-after}
} -cleanup {
    unset r
    unset rep-before
    unset lexical_sort
    unset rep-after
} -result {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries}

test lseq-3.28 {lreverse bug in ArithSeries} -body {
    set r [lseq -5 17 3]
    set rr [lreverse $r]
    list $r $rr [string equal $r [lreverse $rr]]
} -cleanup {
    unset r rr
} -result {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1}

test lseq-3.29 {edge case: negative count} {
    lseq -15
} {}

test lseq-3.30 {lreverse with double values} -constraints arithSeriesDouble -body {
    set r [lseq 3.5 18.5 1.5]
    set a [lreverse $r]
    join [list \
	      [lindex [tcl::unsupported::representation $r] 3] \
	      $r \
	      [lindex [tcl::unsupported::representation $a] 3] \
	      $a] \n
} -cleanup {
    unset r a
} -result {arithseries
3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5
arithseries
18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}

test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble has64BitLengths} {
    lreverse [lseq 1.1 29.9 0.3]
} {29.9 29.6 29.3 29.0 28.7 28.4 28.1 27.8 27.5 27.2 26.9 26.6 26.3 26.0 25.7 25.4 25.1 24.8 24.5 24.2 23.9 23.6 23.3 23.0 22.7 22.4 22.1 21.8 21.5 21.2 20.9 20.6 20.3 20.0 19.7 19.4 19.1 18.8 18.5 18.2 17.9 17.6 17.3 17.0 16.7 16.4 16.1 15.8 15.5 15.2 14.9 14.6 14.3 14.0 13.7 13.4 13.1 12.8 12.5 12.2 11.9 11.6 11.3 11.0 10.7 10.4 10.1 9.8 9.5 9.2 8.9 8.6 8.3 8.0 7.7 7.4 7.1 6.8 6.5 6.2 5.9 5.6 5.3 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7 1.4 1.1}

# lsearch -
#  -- should not shimmer lseq  list
#  -- should not leak lseq elements
test lseq-3.32 {lsearch nested lists of lseq} -constraints arithSeriesShimmer -body {
    set srchlist {}
    for {set i 5} {$i < 25} {incr i} {
	lappend srchlist [lseq $i count 7 by 3]
    }
    set a [lsearch -all -inline -index 1 $srchlist 23]
    set b [lmap i $a {lindex [tcl::unsupported::representation $i] 3}]
    list [lindex [tcl::unsupported::representation $a] 3] $a $b \
        [lindex [tcl::unsupported::representation [lindex $srchlist 15]] 3]
} -cleanup {
    unset srchlist i a b
} -result {list {{20 23 26 29 32 35 38}} arithseries arithseries}

test lseq-4.1 {end expressions} -body {
    set start 7
    lseq $start $start+11
} -cleanup {unset start} -result {7 8 9 10 11 12 13 14 15 16 17 18}

test lseq-4.2 {start expressions} -body {
    set base [clock seconds]
    set tl [lseq $base-60 $base 10]
    lmap t $tl {expr {$t - $base + 60}}
} -cleanup {unset base tl t} -result {0 10 20 30 40 50 60}

##	lseq 1 to 10 by -2
##	# -> lseq: invalid step = -2 with a = 1 and b = 10

test lseq-4.3 {TIP examples} -body {
    set examples {# Examples from TIP-629
	# --- Begin ---
	lseq 10 .. 1
	# -> 10 9 8 7 6 5 4 3 2 1
	lseq 1 .. 10
	# -> 1 2 3 4 5 6 7 8 9 10
	lseq 10 .. 1 by 2

	lseq 5 5
	# -> 5
	lseq 5 5 2
	# -> 5
	lseq 5 5 -2
	# -> 5
    }
    set res {}
    foreach {cmd expect} [split $examples \n] {
	if {[string trim $cmd] ne ""} {
	    set cmd [string trimleft $cmd]
	    if {[string match {\#*} $cmd]} continue
	    set status [catch $cmd ans]
	    lappend res $ans
	    if {[regexp {\# -> (.*)$} $expect -> expected]} {
		if {$expected ne $ans} {
		    lappend res [list Mismatch: $cmd -> $ans ne $expected]
		}
	    }
	}
    }
    set res
} -cleanup {
    unset res cmd status ans expect expected examples
} -result {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5}

#
# Ticket 9933cc4d88697f05976accebd31c1e3ba6efe9c6 - lseq corner case
test lseq-4.4 {lseq corner case} -constraints has64BitLengths -body {
    set tcmd {
	set res {}
	set s [catch {lindex [lseq 10 100] 0} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 9223372036854775000] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 9223372036854775000]} e]
	lappend res $s $e
	set s [catch {lindex [lseq 10 2147483647] 0} e]
	lappend res $s $e
	set s [catch {llength [lseq 10 2147483647]} e]
	lappend res $s $e
    }
    eval $tcmd
} -cleanup {
    unset res s e tcmd
} -result {0 10 0 10 0 9223372036854774991 0 10 0 2147483638}

# Ticket 99e834bf33 - lseq, lindex end off by one

test lseq-4.5 {lindex off by one} -body {
    lappend res [eval {lindex [lseq 1 4] end}]
    lappend res [eval {lindex [lseq 1 4] end-1}]

    set i 4
    set c [lindex $l $i]
    set d [$cmd $l $i]
    set e [lindex [lseq 2 10] $i]
    set f [$cmd [lseq 2 10] $i]
    list $c $d $e $f
} -cleanup {
    unset l cmd i c d e f

} -result [lrepeat 4 6]

test lseq-4.7 {empty list} {
    list [lseq 0] [join [lseq 0] {}] [join [lseq 1] {}]
} {{} {} 0}

test lseq-4.8 {error case lrange} -body {
    lrange [lseq 1 5] fred ginger
} -cleanup {
    unset -nocomplain fred ginger
} -returnCodes 1 -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}

test lseq-4.9 {lrange empty/partial sets} -body {
    set res {}
    foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} {
        lappend res [lrange [lseq 1 5] $fred $ginger]
    }
    set res
} -cleanup {unset res fred ginger} -result {{} 5 {1 2 3 4 5} {} {}}

# Panic when using variable value?
test lseq-4.10 {panic using variable index} -body {
    set i 0
    lindex [lseq 10] $i
} -cleanup {unset i} -result {0}

test lseq-4.11 {bug lseq / lindex discrepancies} -constraints has64BitLengths -body {
    lindex [lseq 0x7fffffff] 0x80000000
} -result {}

test lseq-4.12 {bug lseq} -constraints has64BitLengths -body {
    llength [lseq 0x100000000]
} -result {4294967296}

test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
    set l [lseq 0x7fffffffffffffff]
    list \
    [llength $l] \
    [lindex $l end] \
        [lindex $l 9223372036854775800]
} -cleanup {unset l} -result {9223372036854775807 9223372036854775806 9223372036854775800}


test lseq-4.14 {bug lseq - inconsistent rounding} has64BitLengths {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    lseq 4 40 0.1
} {4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}

test lseq-4.15 {bug lseq - inconsistent rounding} has64BitLengths {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    lseq 6 40 0.1
} {6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}

test lseq-4.16 {bug lseq - inconsistent rounding} {
    # using a non-integer increment, [lseq] rounding seems to be not consistent:
    set res {}
    lappend res [lseq 4.07 6 0.1]
    lappend res [lseq 4.03 4.208 0.013]
} {{4.07 4.17 4.27 4.37 4.47 4.57 4.67 4.77 4.87 4.97 5.07 5.17 5.27 5.37 5.47 5.57 5.67 5.77 5.87 5.97} {4.03 4.043 4.056 4.069 4.082 4.095 4.108 4.121 4.134 4.147 4.16 4.173 4.186 4.199}}

# Test abstract list in a concat
#  -- lseq list should not shimmer
#  -- lseq elements should not leak
test lseq-4.17 {concat shimmer} -body {
    set rng [lseq 8 15 2]
    set pre [list A b C]
    set pst [list x Y z]
    list [concat $pre $rng $pst] \
         [lindex [tcl::unsupported::representation $pre] 3] \
         [lindex [tcl::unsupported::representation $rng] 3] \
         [lindex [tcl::unsupported::representation $pst] 3]
} -cleanup {unset rng pre pst} -result  {{A b C 8 10 12 14 x Y z} list arithseries list}

test lseq-4.18 {concat shimmer} -body {
    set rng [lseq 8 15 2]
    set pre [list A b C]
    set pst [list x Y z]
    list [concat $rng $pre $pst] \
         [lindex [tcl::unsupported::representation $rng] 3] \
         [lindex [tcl::unsupported::representation $pre] 3] \
         [lindex [tcl::unsupported::representation $pst] 3]
} -cleanup {unset rng pre pst} -result {{8 10 12 14 A b C x Y z} arithseries list list}

# Test lseq elements as var names
test lseq-4.19 {varnames} -body {
    set plist {}
    foreach v {auto_execok auto_load auto_qualify} {
	lappend plist proc $v [info args $v] [info body $v]
    }
    set res {}
    set varlist [lseq 1 to 4]
    foreach $varlist $plist {
	lappend res $2 [llength $3]
    }
    lappend res [lindex [tcl::unsupported::representation $varlist] 3]
} -cleanup {
    unset {*}$varlist res varlist v plist
} -result {auto_execok 1 auto_load 2 auto_qualify 2 arithseries}

test lseq-convertToList {does not result in a memory error} -body {
	trace add variable var1 write [list ::apply [list args {
		error {this is an error}
	} [namespace current]]]
	list [catch {set var1 [lindex [lreplace [lseq 1 2] 1 1 hello] 0]} cres] $cres
} -cleanup {unset var1 cres} -result {1 {can't set "var1": this is an error}}

# cleanup
::tcltest::cleanupTests

return

# Local Variables:
# mode: tcl
# End:

} 10
test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} testobj {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj append 1 xyzq -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 15 abcdefxyzq}
test stringObj-4.4 {Tcl_SetObjLength procedure, "empty string", length 0} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj setlength 1 0
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}

    set result {}
    teststringobj append 1 1234567890123 -1
    lappend result [teststringobj length 1] [teststringobj length2 1]
    teststringobj setlength 1 10
    teststringobj append 1 abcdef -1
    lappend result [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {15 15 16 24 xy12345678abcdef}

test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj appendstrings 1 xyz { 1234 } foo
    teststringobj get 1
} {a bxyz 1234 foo}

    list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 123 abcdefg
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 15 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 10 ab34567890}
test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890x
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {11 17 ab34567890x}
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
    testobj freeallvars
    teststringobj set2 1 [string replace abc 1 1 d]
    teststringobj appendstrings 1 foo bar soom
    teststringobj get 1
} adcfoobarsoom

test stringObj-7.1 {SetStringFromAny procedure} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj append 1 x -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {4 6 {a bx}}
test stringObj-7.2 {SetStringFromAny procedure, null object} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {0 0 {}}

    teststringobj set 1 {}
    teststringobj append 1 abcde -1
    testobj duplicate 1 2
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj maxchars 1] [teststringobj get 1] \
	    [teststringobj length 2] [teststringobj length2 2] \
	    [teststringobj maxchars 2] [teststringobj get 2]
} {5 8 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\xEF\xBF\xAEghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"

}

##
## merge copyright listings
##
proc merge-copyrights {l1 l2} {
    set merge {}
    set re1 {^Copyright +(?:\(c\)|\\\(co|©|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
    set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
    set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
    set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
    foreach copyright [concat $l1 $l2] {
	if {[regexp -nocase -- $re1 $copyright -> info]} {
	    set info [string trimright $info ". "] ; # remove extra period
	    if {[regexp -- $re2 $info -> date who]} {