Tcl Source Code

*/config.cache
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
















unix/autoMkindex.tcl
unix/dltest.marker
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/pkgs/*
win/tcl.hpj

*/config.cache
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.pdf
libtommath/*.pl
libtommath/*.sh
libtommath/tombc/*
libtommath/pre_gen/*
libtommath/pics/*
libtommath/mtest/*
libtommath/logs/*
libtommath/etc/*
libtommath/demo/*
libtommath/*.out
libtommath/*.tex
unix/autoMkindex.tcl
unix/dltest.marker
unix/tcl.pc
unix/tclIndex
unix/pkgs/*
win/pkgs/*
win/tcl.hpj

void
closedir(
    register DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    ckfree((char *) dirp);
}

void
closedir(
    register DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    ckfree(dirp);
}

	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	ckfree((char *) waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait

	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	ckfree(waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait

third argument.  If all goes well, each of the procedures returns
\fBTCL_OK\fR.  If \fIsrc\fR does not have the proper syntax for the
desired type then \fBTCL_ERROR\fR is returned, an error message is left
in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
.PP
\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded by
white space.  If the first two characters of \fIsrc\fR
after the optional white space and sign are
.QW 0x
then \fIsrc\fR is expected to be in hexadecimal form.
If the first two such characters are
.QW 0o
then \fIsrc\fR
is expected to be in octal form.
If the first two such characters are
.QW 0b
then \fIsrc\fR
is expected to be in binary form;  otherwise, \fIsrc\fR is
expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is:  white space;  a sign; a sequence of digits;  a


decimal point;  a sequence of digits;  the letter
.QW e ;
a signed decimal exponent;  and more white space.
Any of the fields may be omitted, except that
the digits either before or after the decimal point must be present
and if the
.QW e
is present then it must be followed by the exponent number.







.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value.  If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
value at \fI*boolPtr\fR.
If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
then 1 is stored at \fI*boolPtr\fR.
Any of these values may be abbreviated, and upper-case spellings
are also acceptable.

.SH KEYWORDS
boolean, conversion, double, floating-point, integer

third argument.  If all goes well, each of the procedures returns
\fBTCL_OK\fR.  If \fIsrc\fR does not have the proper syntax for the
desired type then \fBTCL_ERROR\fR is returned, an error message is left
in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
.PP
\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded and
followed by white space.  If the first two characters of \fIsrc\fR
after the optional white space and sign are
.QW \fB0x\fR
then \fIsrc\fR is expected to be in hexadecimal form;  otherwise,
if the first such characters are
.QW \fB0o\fR

then \fIsrc\fR is expected to be in octal form;  otherwise,
if the first such characters are
.QW \fB0b\fR
then \fIsrc\fR
is expected to be in binary form;  otherwise, \fIsrc\fR is
expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is:  white space;  a sign; a sequence of digits;  a
decimal point
.QW \fB.\fR ;
a sequence of digits;  the letter
.QW \fBe\fR ;
a signed decimal exponent;  and more white space.
Any of the fields may be omitted, except that
the digits either before or after the decimal point must be present
and if the
.QW \fBe\fR
is present then it must be followed by the exponent number. If there
are no fields apart from the sign and initial sequence of digits
(i.e., no decimal point or exponent indicator), that
initial sequence of digits should take one of the forms that
\fBTcl_GetInt\fR supports, described above. The use of
.QW \fB,\fR
as a decimal point is not supported nor should any other sort of
inter-digit separator be present.
.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value.  If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
value at \fI*boolPtr\fR.
If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
then 1 is stored at \fI*boolPtr\fR.
Any of these values may be abbreviated, and upper-case spellings
are also acceptable.

.SH KEYWORDS
boolean, conversion, double, floating-point, integer

custom set of allocation routines might depend on, in order to avoid any
circular dependency.
.PP
The \fIhashKeyProc\fR member contains the address of a function called to
calculate a hash value for the key.
.PP
.CS
typedef unsigned int \fBTcl_HashKeyProc\fR(
        Tcl_HashTable *\fItablePtr\fR,
        void *\fIkeyPtr\fR);
.CE
.PP
If this is NULL then \fIkeyPtr\fR is used and
\fBTCL_HASH_KEY_RANDOMIZE_HASH\fR is assumed.
.PP

custom set of allocation routines might depend on, in order to avoid any
circular dependency.
.PP
The \fIhashKeyProc\fR member contains the address of a function called to
calculate a hash value for the key.
.PP
.CS
typedef TCL_HASH_TYPE \fBTcl_HashKeyProc\fR(
        Tcl_HashTable *\fItablePtr\fR,
        void *\fIkeyPtr\fR);
.CE
.PP
If this is NULL then \fIkeyPtr\fR is used and
\fBTCL_HASH_KEY_RANDOMIZE_HASH\fR is assumed.
.PP

been opened for writing. The \fBchan copy\fR command leverages the
buffering in the Tcl I/O system to avoid extra copies and to avoid
buffering too much data in main memory when copying large files to
slow destinations like network sockets.
.RS
.PP
The \fBchan copy\fR command transfers data from \fIinputChan\fR until
end of file or \fIsize\fR bytes have been transferred. If no


\fB\-size\fR argument is given, then the copy goes until end of file.
All the data read from \fIinputChan\fR is copied to \fIoutputChan\fR.
Without the \fB\-command\fR option, \fBchan copy\fR blocks until the
copy is complete and returns the number of bytes written to
\fIoutputChan\fR.
.PP
The \fB\-command\fR argument makes \fBchan copy\fR work in the
background.  In this case it returns immediately and the
\fIcallback\fR is invoked later when the copy completes.  The
\fIcallback\fR is called with one or two additional arguments that
indicates how many bytes were written to \fIoutputChan\fR.  If an
error occurred during the background copy, the second argument is the
................................................................................
returned as a 2-element list, the first element being the read side and
the second the write side. Can be useful e.g. to redirect
separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
this, spawn with "2>@" or
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
the read side once the child has exited or otherwise closed its output.












.VE 8.6
.TP
\fBchan pop \fIchannelId\fR
.VS 8.6
Removes the topmost transformation from the channel \fIchannelId\fR, if there
is any. If there are no transformations added to \fIchannelId\fR, this is
equivalent to \fBchan close\fR of that channel. The result is normally the

been opened for writing. The \fBchan copy\fR command leverages the
buffering in the Tcl I/O system to avoid extra copies and to avoid
buffering too much data in main memory when copying large files to
slow destinations like network sockets.
.RS
.PP
The \fBchan copy\fR command transfers data from \fIinputChan\fR until
end of file or \fIsize\fR bytes or characters have been transferred;
\fIsize\fR is in bytes if the two channels are using the same encoding,
and is in characters otherwise.  If no \fB\-size\fR argument is given,
then the copy goes until end of file. All the data read from
\fIinputChan\fR is copied to \fIoutputChan\fR.  Without the
\fB\-command\fR option, \fBchan copy\fR blocks until the copy is
complete and returns the number of bytes or characters (using the same
rules as for the \fB\-size\fR option) written to \fIoutputChan\fR.
.PP
The \fB\-command\fR argument makes \fBchan copy\fR work in the
background.  In this case it returns immediately and the
\fIcallback\fR is invoked later when the copy completes.  The
\fIcallback\fR is called with one or two additional arguments that
indicates how many bytes were written to \fIoutputChan\fR.  If an
error occurred during the background copy, the second argument is the
................................................................................
returned as a 2-element list, the first element being the read side and
the second the write side. Can be useful e.g. to redirect
separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
this, spawn with "2>@" or
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
the read side once the child has exited or otherwise closed its output.
.RS
.PP
Note that the pipe buffering semantics can vary at the operating system level
substantially; it is not safe to assume that a write performed on the output
side of the pipe will appear instantly to the input side. This is a
fundamental difference and Tcl cannot conceal it. The overall stream semantics
\fIare\fR compatible, so blocking reads and writes will not see most of the
differences, but the details of what exactly gets written when are not. This
is most likely to show up when using pipelines for testing; care should be
taken to ensure that deadlocks do not occur and that potential short reads are
allowed for.
.RE
.VE 8.6
.TP
\fBchan pop \fIchannelId\fR
.VS 8.6
Removes the topmost transformation from the channel \fIchannelId\fR, if there
is any. If there are no transformations added to \fIchannelId\fR, this is
equivalent to \fBchan close\fR of that channel. The result is normally the

.BE
.SH DESCRIPTION
.PP
This command joins each of its arguments together with spaces after
trimming leading and trailing white-space from each of them.  If all of the
arguments are lists, this has the same effect as concatenating them
into a single list.

It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
Although \fBconcat\fR will concatenate lists, flattening them in the process
(so giving the following interactive session):
.PP
.CS

.BE
.SH DESCRIPTION
.PP
This command joins each of its arguments together with spaces after
trimming leading and trailing white-space from each of them.  If all of the
arguments are lists, this has the same effect as concatenating them
into a single list.
Arguments that are empty (after trimming) are ignored entirely.
It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
Although \fBconcat\fR will concatenate lists, flattening them in the process
(so giving the following interactive session):
.PP
.CS

\fBexec\fR will not work well with TUI applications when a console is not
present, as is done when launching applications under wish.  It is desirable
to have console applications hidden and detached.  This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes.  The Expect
extension addresses this issue when communicating with a TUI application.
.PP
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and

\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name.  If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.

\fBexec\fR will not work well with TUI applications when a console is not
present, as is done when launching applications under wish.  It is desirable
to have console applications hidden and detached.  This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes.  The Expect
extension addresses this issue when communicating with a TUI application.
.PP
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified.  Then, in order,
\fB.com\fR, \fB.exe\fR, \fB.bat\fR and \fB.cmd\fR
are appended to the end of the specified name and it searches
for the longer name.  If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.IP \(bu 3
The directory from which the Tcl executable was loaded.
.IP \(bu 3
The current directory.

.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs (adding separator spaces between them),
evaluates the result as a Tcl expression, and returns the value.
The operators permitted in Tcl expressions include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
Expressions almost always yield numeric results
(integer or floating-point values).
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
Tcl expressions differ from C expressions in the way that
operands are specified.  Also, Tcl expressions support
non-numeric operands and string comparisons, as well as some
additional operators not found in C.





.SS OPERANDS
.PP
A Tcl expression consists of a combination of operands, operators,
parentheses and commas.
White space may be used between the operands and operators and
parentheses (or commas); it is ignored by the expression's instructions.
Where possible, operands are interpreted as integer values.


Integer values may be specified in decimal (the normal case), in binary
(if the first two characters of the operand are \fB0b\fR), in octal
(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
(if the first two characters of the operand are \fB0x\fR).
If an operand does not have one of the integer formats given
above, then it is treated as a floating-point number if that is
possible.  Floating-point numbers may be specified in any of several
common formats making use of the decimal digits, the decimal point \fB.\fR,
the characters \fBe\fR or \fBE\fR indicating scientific notation, and
the sign characters \fB+\fR or \fB\-\fR.  For example, all of the
following are valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
Also recognized as floating point values are the strings \fBInf\fR
and \fBNaN\fR making use of any case for each character.
If no numeric interpretation is possible (note that all literal
operands that are not numeric or boolean must be quoted with either
braces or with double quotes), then an operand is left as a string
(and only a limited set of operators may be applied to it).
.PP
Operands may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
\fBboolean\fR.
.IP [3]
As a Tcl variable, using standard \fB$\fR notation.
The variable's value will be used as the operand.
.IP [4]
As a string enclosed in double-quotes.
The expression parser will perform backslash, variable, and
command substitutions on the information between the quotes,
and use the resulting value as the operand
.IP [5]
As a string enclosed in braces.
The characters between the open brace and matching close brace
will be used as the operand without any substitutions.

.IP [6]
As a Tcl command enclosed in brackets.
The command will be executed and its result will be used as
the operand.

.IP [7]
As a mathematical function whose arguments have any of the above
forms for operands, such as \fBsin($x)\fR.  See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.PP
Where the above substitutions occur (e.g. inside quoted strings), they
are performed by the expression's instructions.
However, the command parser may already have performed one round of
substitution before the expression processor was called.

As discussed below, it is usually best to enclose expressions
in braces to prevent the command parser from performing substitutions
on the contents.


.PP
For some examples of simple expressions, suppose the variable
\fBa\fR has the value 3 and
the variable \fBb\fR has the value 6.
Then the command on the left side of each of the lines below
will produce the value on the right side of the line:
.PP
.CS
.ta 6c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.SS OPERATORS
.PP









The valid operators (most of which are also available as commands in
the \fBtcl::mathop\fR namespace; see the \fBmathop\fR(n) manual page
for details) are listed below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
.
Unary minus, unary plus, bit-wise NOT, logical NOT.  None of these operators
may be applied to string operands, and bit-wise NOT may be
applied only to integers.
.TP 20
\fB**\fR
.
Exponentiation.  Valid for any numeric operands.
.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply, divide, remainder.  None of these operators may be
applied to string operands, and remainder may be applied only
to integers.
The remainder will always have the same sign as the divisor and
an absolute value smaller than the absolute value of the divisor.
.RS
.PP
When applied to integers, the division and remainder operators can be
considered to partition the number line into a sequence of equal-sized
adjacent non-overlapping pieces where each piece is the size of the divisor;
the division result identifies which piece the divisor lay within, and the
remainder result identifies where within that piece the divisor lay. A
consequence of this is that the result of
.QW "-57 \fB/\fR 10"
is always -6, and the result of
.QW "-57 \fB%\fR 10"
is always 3.
.RE
.TP 20
\fB+\0\0\-\fR
.
Add and subtract.  Valid for any numeric operands.
.TP 20
\fB<<\0\0>>\fR
.
Left and right shift.  Valid for integer operands only.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
.
Boolean less, greater, less than or equal, and greater than or equal.
Each operator produces 1 if the condition is true, 0 otherwise.
These operators may be applied to strings as well as numeric operands,
in which case string comparison is used.
.TP 20
\fB==\0\0!=\fR
.
Boolean equal and not equal.  Each operator produces a zero/one result.
Valid for all operand types.
.TP 20
\fBeq\0\0ne\fR
.
Boolean string equal and string not equal.  Each operator produces a
zero/one result.  The operand types are interpreted only as strings.
.TP 20
\fBin\0\0ni\fR
.
List containment and negated list containment.  Each operator produces
a zero/one result and treats its first argument as a string and its
second argument as a Tcl list.  The \fBin\fR operator indicates
whether the first argument is a member of the second argument list;
the \fBni\fR operator inverts the sense of the result.
.TP 20
\fB&\fR
.
Bit-wise AND.  Valid for integer operands only.
.TP 20
\fB^\fR
.
Bit-wise exclusive OR.  Valid for integer operands only.
.TP 20
\fB|\fR
.
Bit-wise OR.  Valid for integer operands only.
.TP 20
\fB&&\fR
.
Logical AND.  Produces a 1 result if both operands are non-zero,
0 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.

.TP 20
\fB||\fR
.
Logical OR.  Produces a 0 result if both operands are zero, 1 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
.TP 20
\fIx\fB?\fIy\fB:\fIz\fR
.
If-then-else, as in C.  If \fIx\fR
evaluates to non-zero, then the result is the value of \fIy\fR.
Otherwise the result is the value of \fIz\fR.
The \fIx\fR operand must have a boolean or numeric value.
.PP
See the C manual for more details on the results
produced by each operator.
The exponentiation operator promotes types like the multiply and
divide operators, and produces a result that is the same as the output
of the \fBpow\fR function (after any type conversions.)
All of the binary operators but exponentiation group left-to-right


within the same precedence level; exponentiation groups right-to-left.  For example, the command

.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
returns 0, while
.PP
.CS
\fBexpr\fR {2**3**2}
.CE
.PP
returns 512.
.PP
The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
.QW "lazy evaluation" ,
just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in the command
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of
.QW \fB[a]\fR
or
.QW \fB[b]\fR
will actually be evaluated,
depending on the value of \fB$v\fR.  Note, however, that this is
only true if the entire expression is enclosed in braces;  otherwise
the Tcl parser will evaluate both
.QW \fB[a]\fR
and
.QW \fB[b]\fR
before invoking the \fBexpr\fR command.
.SS "MATH FUNCTIONS"
.PP
When the expression parser encounters a mathematical function
such as \fBsin($x)\fR, it replaces it with a call to an ordinary
Tcl function in the \fBtcl::mathfunc\fR namespace.  The processing
of an expression such as:
.PP
.CS
\fBexpr\fR {sin($x+$y)}
.CE
.PP
is the same in every way as the processing of:
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
which in turn is the same as the processing of:
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
rules for resolving functions in namespaces. Either
\fB::tcl::mathfunc::sin\fR or \fB[namespace
current]::tcl::mathfunc::sin\fR will satisfy the request, and others
may as well (depending on the current \fBnamespace path\fR setting).
.PP
Some mathematical functions have several arguments, separated by commas like in C. Thus:
.PP
.CS
\fBexpr\fR {hypot($x,$y)}
.CE
.PP
ends up as
.PP
.CS
tcl::mathfunc::hypot $x $y
.CE
.PP
See the \fBmathfunc\fR(n) manual page for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
All internal computations involving integers are done calling on the
LibTomMath multiple precision integer library as required so that all
integer calculations are performed exactly.  Note that in Tcl releases
prior to 8.5, integer calculations were performed with one of the C types
\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
in those calculations where values overflowed the range of those types.
Any code that relied on these implicit truncations will need to explicitly
add \fBint()\fR or \fBwide()\fR function calls to expressions at the points
where such truncation is required to take place.
.PP
All internal computations involving floating-point are
done with the C type \fIdouble\fR.


When converting a string to floating-point, exponent overflow is
detected and results in the \fIdouble\fR value of \fBInf\fR or
\fB\-Inf\fR as appropriate.  Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
pretty reliable.
.PP
Conversion among internal representations for integer, floating-point,
and string operands is done automatically as needed.
For arithmetic computations, integers are used until some
floating-point number is introduced, after which floating-point is used.
For example,
.PP
.CS
\fBexpr\fR {5 / 4}
.CE
.PP
returns 1, while
.PP
.CS
\fBexpr\fR {5 / 4.0}
\fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )}
.CE
.PP
both return 1.25.
Floating-point values are always returned with a

.QW \fB.\fR
or an
.QW \fBe\fR
so that they will not look like integer values.  For example,


.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
String values may be used as operands of the comparison operators,
although the expression evaluator tries to do comparisons as integer
or floating-point when it can,
i.e., when all arguments to the operator allow numeric interpretations,
except in the case of the \fBeq\fR and \fBne\fR operators.
If one of the operands of a comparison is a string and the other
has a numeric value, a canonical string representation of the numeric
operand value is generated to compare with the string operand.
Canonical string representation for integer values is a decimal string
format.  Canonical string representation for floating-point values
is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.  For example, the commands
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
both return 1.  The first comparison is done using integer
comparison, and the second is done using string comparison.
Because of Tcl's tendency to treat values as numbers whenever
possible, it is not generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
operands could be arbitrary;  it is better in these cases to use
the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
Enclose expressions in braces for the best speed and the smallest



storage requirements.
This allows the Tcl bytecode compiler to generate the best code.


.PP
As mentioned above, expressions are substituted twice:
once by the Tcl parser and once by the \fBexpr\fR command.
For example, the commands
.PP



.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP
return 11, not a multiple of 4.
This is because the Tcl parser will first substitute \fB$a + 2\fR for
the variable \fBb\fR,
then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
.PP
Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
their variable and command substitutions yield numbers or strings
that do not themselves require substitutions.
However, because a few unbraced expressions
need two rounds of substitutions,
the bytecode compiler must emit
additional instructions to handle this situation.
The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
When the expression is unbraced to allow the substitution of a function or
operator, consider using the commands documented in the \fBmathfunc\fR(n) or
\fBmathop\fR(n) manual pages directly instead.
.SH EXAMPLES



.PP
Define a procedure that computes an
.QW interesting
mathematical function:
.PP
.CS
proc tcl::mathfunc::calc {x y} {
................................................................................
Print a message describing the relationship of two string values to
each other:
.PP
.CS
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable to whether an environment variable is both defined at
all and also set to a true boolean value:
.PP
.CS
set isTrue [\fBexpr\fR {
    [info exists ::env(SOME_ENV_VAR)] &&
    [string is true -strict $::env(SOME_ENV_VAR)]
}]
.CE

.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and




commas, possibly with whitespace between any of these elements, which is
ignored.
An integer operand may be specified in decimal, binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form.


A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR.  The
following are all valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR

and \fBNaN\fR, in any combination of case, are also recognized as floating point
values.  An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.

.PP
An operand may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
\fBboolean\fR.
.IP [3]
As a variable, using standard \fB$\fR notation.
The value of the variable is then the value of the operand.
.IP [4]
As a string enclosed in double-quotes.
Backslash, variable, and command substitution are performed as described in
\fBTcl\fR.

.IP [5]
As a string enclosed in braces.


The operand is treated as a braced value as described in \fBTcl\fR.
.IP [6]
As a Tcl command enclosed in brackets.


Command substitution is performed as described in \fBTcl\fR.
.IP [7]
As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
forms for operands.  See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.PP




Because \fBexpr\fR parses and performs substitutions on values that have
already been parsed and substituted by \fBTcl\fR, it is usually best to enclose


expressions in braces to avoid the first round of substitutions by
\fBTcl\fR.
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3


and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
.PP
.CS
.ta 6c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
chosen when all operands have a numeric interpretation.  The integer
interpretation of an operand is preferred over the floating-point
interpretation.  To ensure string operations on arbitrary values it is generally a
good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of
more versatile operators such as \fB==\fR.
.PP
Unless otherwise specified, operators accept non-numeric operands.  The value
of a boolean operation is 1 if true, 0 otherwise.  See also \fBstring is\fR
\fBboolean\fR.  The valid operators, most of which are also available as
commands in the \fBtcl::mathop\fR namespace (see \fBmathop\fR(n)), are listed
below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
.
Unary minus, unary plus, bit-wise NOT, logical NOT.  These operators
may only be applied to numeric operands, and bit-wise NOT may only be
applied to integers.
.TP 20
\fB**\fR
.
Exponentiation.  Valid for numeric operands.
.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply and divide, which are valid for numeric operands, and remainder, which
is valid for integers.  The remainder, an absolute value smaller than the


absolute value of the divisor, has the same sign as the divisor.
.RS
.PP
When applied to integers, division and remainder can be
considered to partition the number line into a sequence of
adjacent non-overlapping pieces, where each piece is the size of the divisor;
the quotient identifies which piece the dividend lies within, and the
remainder identifies where within that piece the dividend lies. A
consequence of this is that the result of
.QW "-57 \fB/\fR 10"
is always -6, and the result of
.QW "-57 \fB%\fR 10"
is always 3.
.RE
.TP 20
\fB+\0\0\-\fR
.
Add and subtract.  Valid for numeric operands.
.TP 20
\fB<<\0\0>>\fR
.
Left and right shift.  Valid for integers.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
.
Boolean less than, greater than, less than or equal, and greater than or equal.



.TP 20
\fB==\0\0!=\fR
.
Boolean equal and not equal.

.TP 20
\fBeq\0\0ne\fR
.
Boolean string equal and string not equal.

.TP 20
\fBin\0\0ni\fR
.
List containment and negated list containment.  The first argument is
interpreted as a string, the second as a list.  \fBin\fR tests for membership
in the list, and \fBni\fR is the inverse.


.TP 20
\fB&\fR
.
Bit-wise AND.  Valid for integer operands.
.TP 20
\fB^\fR
.
Bit-wise exclusive OR.  Valid for integer operands.
.TP 20
\fB|\fR
.
Bit-wise OR.  Valid for integer operands.
.TP 20
\fB&&\fR
.
Logical AND.  If both operands are true, the result is 1, or 0 otherwise.



.TP 20
\fB||\fR
.
Logical OR.  If both operands are false, the result is 0, or 1 otherwise.

.TP 20
\fIx\fB?\fIy\fB:\fIz\fR
.
If-then-else, as in C.  If \fIx\fR is false , the result is the value of

\fIy\fR.  Otherwise the result is the value of \fIz\fR.

.PP


The exponentiation operator promotes types in the same way that the multiply



and divide operators do, and the result is is the same as the result of
\fBpow\fR.
Exponentiation groups right-to-left within a precedence level. Other binary
operators group left-to-right.  For example, the value of
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
is 0, while the value of
.PP
.CS
\fBexpr\fR {2**3**2}
.CE
.PP
is 512.
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of \fB[a]\fR or \fB[b]\fR is evaluated,
depending on the value of \fB$v\fR.  This is not true of the normal Tcl parser,
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
.PP
For more details on the results
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
Tcl command in the \fBtcl::mathfunc\fR namespace.  The evaluation
of an expression such as




.PP
.CS
\fBexpr\fR {sin($x+$y)}
.CE
.PP
is the same in every way as the evaluation of
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
which in turn is the same as the evaluation of
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
\fBtcl::mathfunc::sin\fR is resolved as described in
\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation.   Given the
default value of \fBnamespace path\fR, \fB[namespace
current]::tcl::mathfunc::sin\fR or \fB::tcl::mathfunc::sin\fR are the typical
resolutions.
.PP
As in C, a mathematical function may accept multiple arguments separated by commas. Thus,
.PP
.CS
\fBexpr\fR {hypot($x,$y)}
.CE
.PP
becomes
.PP
.CS
tcl::mathfunc::hypot $x $y
.CE
.PP
See the \fBmathfunc\fR(n) documentation for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
When needed to guarantee exact performance, internal computations involving
integers use the LibTomMath multiple precision integer library.  In Tcl releases

prior to 8.5, integer calculations were performed using one of the C types
\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
in those calculations where values overflowed the range of those types.
Any code that relied on these implicit truncations should instead call
\fBint()\fR or \fBwide()\fR, which do truncate.

.PP


Internal floating-point computations are
performed using the \fIdouble\fR C type.
When converting a string to floating-point value, exponent overflow is
detected and results in the \fIdouble\fR value of \fBInf\fR or
\fB\-Inf\fR as appropriate.  Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
fairly reliable.
.PP
Conversion among internal representations for integer, floating-point, and
string operands is done automatically as needed.  For arithmetic computations,

integers are used until some floating-point number is introduced, after which
floating-point values are used.  For example,
.PP
.CS
\fBexpr\fR {5 / 4}
.CE
.PP
returns 1, while
.PP
.CS
\fBexpr\fR {5 / 4.0}
\fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )}
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
presence of either
.QW \fB.\fR
or
.QW \fBe\fR

.PP
. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.



























.SH "PERFORMANCE CONSIDERATIONS"
.PP

Where an expression contains syntax that Tcl would otherwise perform
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.

This also avoids issues that can arise if Tcl is allowed to perform
substitution on the value before \fBexpr\fR is called.
.PP




In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR.  Enclosing the
expression in braces would result in a syntax error.
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP

When an expression is generated at runtime, like the one above is, the bytcode
compiler must ensure that new code is generated each time the expression
is evaluated.  This is the most costly kind of expression from a performance
perspective.  In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.

Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:
.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
Define a procedure that computes an
.QW interesting
mathematical function:
.PP
.CS
proc tcl::mathfunc::calc {x y} {
................................................................................
Print a message describing the relationship of two string values to
each other:
.PP
.CS
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable indicating whether an environment variable is defined and has
value of true:
.PP
.CS
set isTrue [\fBexpr\fR {
    [info exists ::env(SOME_ENV_VAR)] &&
    [string is true -strict $::env(SOME_ENV_VAR)]
}]
.CE

The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
or \fIsize\fR bytes have been


transferred. If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
and returns the number of bytes written to \fIoutchan\fR.

.PP
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
The \fIcallback\fR is called with
one or two additional
arguments that indicates how many bytes were written to \fIoutchan\fR.
................................................................................
\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
vwait done
.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation

The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
or \fIsize\fR bytes or characters have been
transferred; \fIsize\fR is in bytes if the two channels are using the
same encoding, and is in characters otherwise.
If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
and returns the number of bytes or characters (using the same rules as
for the \fB\-size\fR option) written to \fIoutchan\fR.
.PP
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
The \fIcallback\fR is called with
one or two additional
arguments that indicates how many bytes were written to \fIoutchan\fR.
................................................................................
\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
vwait done
.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation
'\" Local Variables:
'\" mode: nroff
'\" End:

.PP
returns \fB/home\fR (or something similar).
.RE
.TP
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
\fB0\fR otherwise.


.TP
\fBfile exists \fIname\fR
.
Returns \fB1\fR if file \fIname\fR exists and the current user has
search privileges for the directories leading to it, \fB0\fR otherwise.
.TP
\fBfile extension \fIname\fR
................................................................................
returns
.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat  \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.
\fIVarName\fR is treated as an array variable, and the following elements
of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
................................................................................
\fBUnix\fR\0\0\0\0\0\0\0
.
These commands always operate using the real user and group identifiers,
not the effective ones.
.TP
\fBWindows\fR\0\0\0\0
.
The \fBfile owned\fR subcommand currently always reports that the current user
is the owner of the file, without regard for what the operating system
believes to be true, making an ownership test useless. This issue (#3613671)
may be fixed in a future release of Tcl.
.SH EXAMPLES
.PP
This procedure shows how to search for C files in a given directory
that have a correspondingly-named object file in the current
directory:
.PP
.CS

.PP
returns \fB/home\fR (or something similar).
.RE
.TP
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
\fB0\fR otherwise. On Windows, which does not have an executable attribute,
the command treats all directories and any files with extensions
\fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable.
.TP
\fBfile exists \fIname\fR
.
Returns \fB1\fR if file \fIname\fR exists and the current user has
search privileges for the directories leading to it, \fB0\fR otherwise.
.TP
\fBfile extension \fIname\fR
................................................................................
returns
.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.
\fIVarName\fR is treated as an array variable, and the following elements
of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
................................................................................
\fBUnix\fR\0\0\0\0\0\0\0
.
These commands always operate using the real user and group identifiers,
not the effective ones.
.TP
\fBWindows\fR\0\0\0\0
.
The \fBfile owned\fR subcommand uses the user identifier (SID) of
the process token, not the thread token which may be impersonating
some other user.

.SH EXAMPLES
.PP
This procedure shows how to search for C files in a given directory
that have a correspondingly-named object file in the current
directory:
.PP
.CS

set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR.



.SH ERRORS
The \fB::http::geturl\fR procedure will raise errors in the following cases:
invalid command line options,
an invalid URL,
a URL on a non-existent host,
or a URL at a bad port on an existing host.
These errors mean that it

set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
there was no such handler.
.SH ERRORS
The \fB::http::geturl\fR procedure will raise errors in the following cases:
invalid command line options,
an invalid URL,
a URL on a non-existent host,
or a URL at a bad port on an existing host.
These errors mean that it

range is computed and stored in the variable as a decimal string.
The conversion makes no sense without reference to a truncation range,
so the size modifier \fBll\fR is not permitted in combination
with conversion character \fBu\fR.
.TP
\fBi\fR
.
The input substring must be an integer.  The base (i.e. decimal, binary,
octal, or hexadecimal) is determined in the same fashion as described in
\fBexpr\fR.  The integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
\fBc\fR
.
A single character is read in and its Unicode value is stored in
the variable as an integer value.
Initial white space is not skipped in this case, so the input

range is computed and stored in the variable as a decimal string.
The conversion makes no sense without reference to a truncation range,
so the size modifier \fBll\fR is not permitted in combination
with conversion character \fBu\fR.
.TP
\fBi\fR
.
The input substring must be an integer.  The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal).  The integer value is stored in the variable,


truncated as required by the size modifier value.
.TP
\fBc\fR
.
A single character is read in and its Unicode value is stored in
the variable as an integer value.
Initial white space is not skipped in this case, so the input

While \fIcommandPrefix\fR is executing during a read or write trace, traces
on the variable are temporarily disabled.  This means that reads and
writes invoked by \fIcommandPrefix\fR will occur directly, without invoking
\fIcommandPrefix\fR (or any other traces) again.  However, if
\fIcommandPrefix\fR unsets the variable then unset traces will be invoked.
.PP
When an unset trace is invoked, the variable has already been deleted:
it will appear to be undefined with no traces.  If an unset occurs
because of a procedure return, then the trace will be invoked in the
variable context of the procedure being returned to:  the stack frame
of the returning procedure will no longer exist.  Traces are not
disabled during unset traces, so if an unset trace command creates a
new trace and accesses the variable, the trace will be invoked.  Any
errors in unset traces are ignored.
.PP
If there are multiple traces on a variable they are invoked in order
of creation, most-recent first.  If one trace returns an error, then
no further traces are invoked for the variable.  If an array element

While \fIcommandPrefix\fR is executing during a read or write trace, traces
on the variable are temporarily disabled.  This means that reads and
writes invoked by \fIcommandPrefix\fR will occur directly, without invoking
\fIcommandPrefix\fR (or any other traces) again.  However, if
\fIcommandPrefix\fR unsets the variable then unset traces will be invoked.
.PP
When an unset trace is invoked, the variable has already been deleted:
it will appear to be undefined with no traces.  Traces are not



disabled during unset traces, so if an unset trace command creates a
new trace and accesses the variable, the trace will be invoked.  Any
errors in unset traces are ignored.
.PP
If there are multiple traces on a variable they are invoked in order
of creation, most-recent first.  If one trace returns an error, then
no further traces are invoked for the variable.  If an array element

.PP
If the \fBvariable\fR command is executed inside a Tcl procedure,
it creates local variables
linked to the corresponding namespace variables (and therefore these
variables are listed by \fBinfo vars\fR.)
In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
although the \fBglobal\fR command
only links to variables in the global namespace.

If any \fIvalue\fRs are given,
they are used to modify the values of the associated namespace variables.
If a namespace variable does not exist,
it is created and optionally initialized.
.PP
A \fIname\fR argument cannot reference an element within an array.
Instead, \fIname\fR should reference the entire array,
................................................................................
    }
}
.CE
.SH "SEE ALSO"
global(n), namespace(n), upvar(n)
.SH KEYWORDS
global, namespace, procedure, variable

.PP
If the \fBvariable\fR command is executed inside a Tcl procedure,
it creates local variables
linked to the corresponding namespace variables (and therefore these
variables are listed by \fBinfo vars\fR.)
In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
although the \fBglobal\fR command
resolves variable names with respect to the global namespace instead
of the current namespace of the procedure.
If any \fIvalue\fRs are given,
they are used to modify the values of the associated namespace variables.
If a namespace variable does not exist,
it is created and optionally initialized.
.PP
A \fIname\fR argument cannot reference an element within an array.
Instead, \fIname\fR should reference the entire array,
................................................................................
    }
}
.CE
.SH "SEE ALSO"
global(n), namespace(n), upvar(n)
.SH KEYWORDS
global, namespace, procedure, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

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





typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
	void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);

/*
 * Structure definition for an entry in a hash table. No-one outside Tcl
................................................................................
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
#else
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * http://c2.com/cgi/wiki?TrivialDoWhileLoop
     *
     * Decrement refCount AFTER checking it for 0 or 1 (<2), because
     * we cannot assume anymore that refCount is a signed type; In
     * Tcl8 it was but in Tcl9 it is subject to change.
     */
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if ((_objPtr)->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
................................................................................
		   : (h)->key.string))

/*
 * Macros to use for clients to use to invoke find and create functions for
 * hash tables:
 */

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

/*
 *----------------------------------------------------------------------------
 * Macros that eliminate the overhead of the thread synchronization functions
 * when compiling without thread support.

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

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE unsigned
#endif

typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
	void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);

/*
 * Structure definition for an entry in a hash table. No-one outside Tcl
................................................................................
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
#else
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * http://c2.com/cgi/wiki?TrivialDoWhileLoop




     */
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if ((_objPtr)->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
................................................................................
		   : (h)->key.string))

/*
 * Macros to use for clients to use to invoke find and create functions for
 * hash tables:
 */


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

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

/*
 *----------------------------------------------------------------------------
 * Macros that eliminate the overhead of the thread synchronization functions
 * when compiling without thread support.

	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
	    goto cleanup;
................................................................................
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);

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

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    BBEmitOpcode(assemEnvPtr, tblIdx, 0);
................................................................................
    const char* varNameStr;
    int varNameLen;
    int localVar;		/* Index of the variable in the LVT */

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

	depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
	if (depth == 0) {
	    /*
	     * Emit a 'push' of the empty literal.
	     */

	    litIndex = TclRegisterNewLiteral(envPtr, "", 0);

	    /*
	     * Assumes that 'push' is at slot 0 in TalInstructionTable.
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    ++depth;

	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
	    goto cleanup;
................................................................................
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

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

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    BBEmitOpcode(assemEnvPtr, tblIdx, 0);
................................................................................
    const char* varNameStr;
    int varNameLen;
    int localVar;		/* Index of the variable in the LVT */

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

	depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
	if (depth == 0) {
	    /*
	     * Emit a 'push' of the empty literal.
	     */

	    litIndex = TclRegisterLiteral(envPtr, "", 0, 0);

	    /*
	     * Assumes that 'push' is at slot 0 in TalInstructionTable.
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    ++depth;

static Tcl_ObjCmdProc	ExprSrandFunc;
static Tcl_ObjCmdProc	ExprUnaryFunc;
static Tcl_ObjCmdProc	ExprWideFunc;
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);

static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);
static void		TEOV_SwitchVarFrame(Tcl_Interp *interp);
static void		TEOV_PushExceptionHandlers(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int flags);
................................................................................
			    Tcl_Obj *namePtr, Namespace *lookupNsPtr);
static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_NRPostProc	RewindCoroutineCallback;
static Tcl_NRPostProc	TailcallCleanup;
static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
static Tcl_NRPostProc	TEOEx_ListCallback;
static Tcl_NRPostProc	TEOV_Error;
static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
................................................................................
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

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

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

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }

    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

................................................................................
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    ckfree((char *) iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */
................................................................................
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    TclInvalidateNsPath(nsPtr);
    if (!isNew) {
	cmdPtr = Tcl_GetHashValue(hPtr);

	/* Command already exists. */

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

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
	    cmdPtr->objClientData = clientData;
	    return (Tcl_Command) cmdPtr;
	}

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

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
................................................................................
{
    Command *cmdPtr = clientData;
    int i, result;
    const char **argv =
	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));

    for (i = 0; i < objc; i++) {
	argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command's string-based Tcl_CmdProc.
     */

................................................................................
    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	TclDStringAppendLiteral(&newFullName, "::");
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

    /*
     * The new command name is okay, so remove the command from its current
     * namespace. This is like deleting the command, so bump the cmdEpoch to
     * invalidate any cached references to the command.
................................................................................

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

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

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
................................................................................
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
................................................................................
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

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

................................................................................
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
     */
................................................................................
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    int length;
    const char *command = Tcl_GetStringFromObj(commandPtr, &length);

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

	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

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

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
................................................................................
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    int numSrcBytes;

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

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */
................................................................................
static void
MathFuncWrongNumArgs(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int expected,		/* Formal parameter count. */
    int found,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    const char *name = Tcl_GetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;
................................................................................

    if (result != TCL_OK) {
        /*
         * Tailcall execution was preempted, eg by an intervening catch or by
         * a now-gone namespace: cleanup and return.
         */

        TailcallCleanup(data, interp, result);
        return result;
    }

    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
    iPtr->lookupNsPtr = (Namespace *) nsPtr;
    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}

static int
TailcallCleanup(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{



    Tcl_DecrRefCount((Tcl_Obj *) data[0]);





    return result;
}

 
void
Tcl_NRAddCallback(
    Tcl_Interp *interp,
................................................................................
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "coroutine \"%s\" is already running",
                Tcl_GetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine

static Tcl_ObjCmdProc	ExprSrandFunc;
static Tcl_ObjCmdProc	ExprUnaryFunc;
static Tcl_ObjCmdProc	ExprWideFunc;
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);
static void		TEOV_SwitchVarFrame(Tcl_Interp *interp);
static void		TEOV_PushExceptionHandlers(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int flags);
................................................................................
			    Tcl_Obj *namePtr, Namespace *lookupNsPtr);
static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_NRPostProc	RewindCoroutineCallback;

static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
static Tcl_NRPostProc	TEOEx_ListCallback;
static Tcl_NRPostProc	TEOV_Error;
static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
................................................................................
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

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

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

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }

    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

................................................................................
	 * are no arguments, so this table has to be empty.
	 */

	Tcl_Panic("Argument location tracking table not empty");
    }

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    ckfree(iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */
................................................................................
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    TclInvalidateNsPath(nsPtr);
    if (!isNew) {
	cmdPtr = Tcl_GetHashValue(hPtr);



	/*

















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

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
................................................................................
{
    Command *cmdPtr = clientData;
    int i, result;
    const char **argv =
	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));

    for (i = 0; i < objc; i++) {
	argv[i] = TclGetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command's string-based Tcl_CmdProc.
     */

................................................................................
    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	TclDStringAppendLiteral(&newFullName, "::");
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

    /*
     * The new command name is okay, so remove the command from its current
     * namespace. This is like deleting the command, so bump the cmdEpoch to
     * invalidate any cached references to the command.
................................................................................

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

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

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
................................................................................
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
................................................................................
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

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

................................................................................
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
    int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int length, traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
     */
................................................................................
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

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

	assert(invoker == NULL);

	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	Tcl_IncrRefCount(objPtr);

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

	TclDecrRefCount(objPtr);

	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
................................................................................
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    const char *script;
	    int numSrcBytes;

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

	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */
................................................................................
static void
MathFuncWrongNumArgs(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int expected,		/* Formal parameter count. */
    int found,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    const char *name = TclGetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;
................................................................................

    if (result != TCL_OK) {
        /*
         * Tailcall execution was preempted, eg by an intervening catch or by
         * a now-gone namespace: cleanup and return.
         */

	Tcl_DecrRefCount(listPtr);
        return result;
    }

    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    iPtr->lookupNsPtr = (Namespace *) nsPtr;
    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}

int
TclNRReleaseValues(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    int i = 0;
    while (i < 4) {
	if (data[i]) {
	    Tcl_DecrRefCount((Tcl_Obj *) data[i]);
	} else {
	    break;
	}
	i++;
    }
    return result;
}

 
void
Tcl_NRAddCallback(
    Tcl_Interp *interp,
................................................................................
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "coroutine \"%s\" is already running",
                TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine

			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = TclGetStringFromObj(objv[i+1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */


    ym1o4 = ym1 / 4;











    if (ym1 % 4 < 0) {
	ym1o4--;
    }
    ym1o100 = ym1 / 100;
    if (ym1 % 100 < 0) {
	ym1o100--;
    }

	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
    ym1o4 = ym1 / 4;
#else
    /*
     * Have to make sure quotient is truncated towards 0 when negative.
     * See above bug for details. The casts are necessary.
     */
    if (ym1 >= 0)
        ym1o4 = ym1 / 4;
    else {
        ym1o4 = - (int) (((unsigned int) -ym1) / 4);
    }
#endif
    if (ym1 % 4 < 0) {
	ym1o4--;
    }
    ym1o100 = ym1 / 100;
    if (ym1 % 100 < 0) {
	ym1o100--;
    }

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"



#include <locale.h>

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */
................................................................................
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }










    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
................................................................................
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }









    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
................................................................................
static int
FileAttrIsOwnedCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{




    Tcl_StatBuf buf;

    int value = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	/*
	 * For Windows, there are no user ids associated with a file, so we
	 * always return 1.
	 *
	 * TODO: use GetSecurityInfo to get the real owner of the file and
	 * test for equivalence to the current user.
	 */

#if defined(_WIN32) || defined(__CYGWIN__)
	value = 1;
#else

	value = (geteuid() == buf.st_uid);
#endif
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#endif
#include <locale.h>

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */
................................................................................
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (buf.st_atime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif

    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
................................................................................
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (buf.st_mtime == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	long newTime;
................................................................................
static int
FileAttrIsOwnedCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
#ifdef __CYGWIN__
#define geteuid() (short)(geteuid)()
#endif
#if !defined(_WIN32)
    Tcl_StatBuf buf;
#endif
    int value = 0;

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









#if defined(_WIN32)
    value = TclWinFileOwned(objv[1]);
#else
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = (geteuid() == buf.st_uid);

    }
#endif
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

#define SORTIDX_END	-2	/* Indexed from end. */

/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static int		IfConditionCallback(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
................................................................................
int
Tcl_JoinObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int listLen, i;
    Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
................................................................................
     * pointer to its array of element pointers.
     */

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











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







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








	    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	}
	Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
    }

    Tcl_DecrRefCount(joinObjPtr);

    Tcl_SetObjResult(interp, resObjPtr);
    return TCL_OK;


}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LassignObjCmd --
 *

#define SORTIDX_END	-2	/* Indexed from end. */

/*
 * Forward declarations for procedures defined in this file:
 */

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;

static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
................................................................................
int
Tcl_JoinObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
................................................................................
     * pointer to its array of element pointers.
     */

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

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

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

    if (Tcl_GetCharLength(joinObjPtr) == 0) {
	TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
		&resObjPtr);
    } else {
	int i;

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

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
		 * Accessing elemPtrs would crash.
		 */

		Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	    }
	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
	}
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LassignObjCmd --
 *

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

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static int		SwitchPostProc(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		TryPostBody(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		TryPostFinal(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		TryPostHandler(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */
................................................................................
static int
StringFirstCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *needleStr, *haystackStr;
    int match, start, needleLen, haystackLen;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching haystackStr for the sequence needleStr.
     */

    match = -1;
    start = 0;
    haystackLen = -1;

    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

    if (objc == 4) {
	/*
	 * If a startIndex is specified, we will need to fast forward to that
	 * point in the string before we think about a match.
	 */


	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
		&start) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Reread to prevent shimmering problems.
	 */

	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

	if (start >= haystackLen) {
	    goto str_first_done;
	} else if (start > 0) {
	    haystackStr += start;
	    haystackLen -= start;
	} else if (start < 0) {
	    /*
	     * Invalid start index mapped to string start; Bug #423581
	     */

	    start = 0;
	}



    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (needleLen > 0 && needleLen <= haystackLen) {
	register Tcl_UniChar *p, *end;

	end = haystackStr + haystackLen - needleLen + 1;
	for (p = haystackStr;  p < end;  p++) {
	    /*
	     * Scan forward to find the first character.
	     */

	    if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
		    (unsigned long) needleLen) == 0)) {
		match = p - haystackStr;
		break;
	    }
	}
    }

    /*
     * Compute the character index of the matching string by counting the
     * number of characters before the match.
     */

    if ((match != -1) && (objc == 4)) {
	match += start;
    }

  str_first_done:
    Tcl_SetObjResult(interp, Tcl_NewLongObj(match));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringLastCmd --
................................................................................
static int
StringLastCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *needleStr, *haystackStr, *p;
    int match, start, needleLen, haystackLen;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching haystackString for the sequence needleString.
     */

    match = -1;
    start = 0;
    haystackLen = -1;

    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

    if (objc == 4) {
	/*
	 * If a startIndex is specified, we will need to restrict the string
	 * range to that char index in the string
	 */


	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
		&start) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Reread to prevent shimmering problems.
	 */

	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);

	if (start < 0) {
	    goto str_last_done;
	} else if (start < haystackLen) {
	    p = haystackStr + start + 1 - needleLen;
	} else {
	    p = haystackStr + haystackLen - needleLen;


	}
    } else {
	p = haystackStr + haystackLen - needleLen;


    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (needleLen > 0 && needleLen <= haystackLen) {
	for (; p >= haystackStr; p--) {
	    /*
	     * Scan backwards to find the first character.
	     */

	    if ((*p == *needleStr) && !memcmp(needleStr, p,
		    sizeof(Tcl_UniChar) * (size_t)needleLen)) {
		match = p - haystackStr;
		break;
	    }
	}
    }

  str_last_done:
    Tcl_SetObjResult(interp, Tcl_NewLongObj(match));

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringIndexCmd --
................................................................................
		    string, NULL);
	    return TCL_ERROR;
	}
    }

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

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

	/*
................................................................................
static int
StringCatCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i;
    Tcl_Obj *objResultPtr;

    if (objc < 2) {
	/*
	 * If there are no args, the result is an empty object.
	 * Just leave the preset empty interp result.
	 */
................................................................................
    if (objc == 2) {
	/*
	 * Other trivial case, single arg, just return it.
	 */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }
    objResultPtr = objv[1];
    if (Tcl_IsShared(objResultPtr)) {
	objResultPtr = Tcl_DuplicateObj(objResultPtr);
    }
    for(i = 2;i < objc;i++) {
	Tcl_AppendObjToObj(objResultPtr, objv[i]);
    }
    Tcl_SetObjResult(interp, objResultPtr);

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringBytesCmd --
 *

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

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




static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */
................................................................................
static int
StringFirstCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int start = 0;


    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }












    if (objc == 4) {




	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {

	    return TCL_ERROR;
	}













	if (start < 0) {




	    start = 0;
	}
	if (start >= size) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    return TCL_OK;
	}
    }
































    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
	    objv[2], start)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringLastCmd --
................................................................................
static int
StringLastCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int last = INT_MAX - 1;


    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }












    if (objc == 4) {




	int size = Tcl_GetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {

	    return TCL_ERROR;
	}








	if (last < 0) {





	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    return TCL_OK;
	}


	if (last >= size) {
	    last = size - 1;
	}
    }




















    Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
	    objv[2], last)));
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringIndexCmd --
................................................................................
		    string, NULL);
	    return TCL_ERROR;
	}
    }

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

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

	/*
................................................................................
static int
StringCatCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int code;
    Tcl_Obj *objResultPtr;

    if (objc < 2) {
	/*
	 * If there are no args, the result is an empty object.
	 * Just leave the preset empty interp result.
	 */
................................................................................
    if (objc == 2) {
	/*
	 * Other trivial case, single arg, just return it.
	 */
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
	    &objResultPtr);

    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, objResultPtr);
	return TCL_OK;
    }

    return code;
}
 
/*
 *----------------------------------------------------------------------
 *
 * StringBytesCmd --
 *

	Tcl_Obj **objs;
	const char *bytes;
	int len;

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

    /*
     * General case: runtime concat.
................................................................................
	Tcl_DecrRefCount(valueObj);
    }

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

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

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

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int numBytes, varIndex;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
	    varIndex = LocalScalar(bytes, numBytes, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
................................................................................
    }

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

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

  checkForStringConcatCase:
    /*
     * See if we can generate a sequence of things to concatenate. This
................................................................................
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
		char *b = Tcl_GetStringFromObj(tmpObj, &len);

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

		if (len > 0) {
................................................................................
    }

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

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

    if (i > 1) {
	/*
	 * Do the concatenation, which produces the result.
	 */

	TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
    } else {
	/*
	 * EVIL HACK! Force there to be a string representation in the case
	 * where there's just a "%s" in the format; case covered by the test
	 * format-20.1 (and it is horrible...)
	 */

	TclEmitOpcode(INST_DUP, envPtr);
	PushStringLiteral(envPtr, "");
	TclEmitOpcode(INST_STR_EQ, envPtr);
	TclEmitOpcode(INST_POP, envPtr);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *

	Tcl_Obj **objs;
	const char *bytes;
	int len;

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

    /*
     * General case: runtime concat.
................................................................................
	Tcl_DecrRefCount(valueObj);
    }

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

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

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

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    const char *bytes;
	    int numBytes, varIndex;

	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &numBytes);
	    varIndex = LocalScalar(bytes, numBytes, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
................................................................................
    }

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

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

  checkForStringConcatCase:
    /*
     * See if we can generate a sequence of things to concatenate. This
................................................................................
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
		char *b = TclGetStringFromObj(tmpObj, &len);

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

		if (len > 0) {
................................................................................
    }

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

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

    if (i > 1) {
	/*
	 * Do the concatenation, which produces the result.
	 */

	TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);











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

    }

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

    bytes = Tcl_GetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;
................................................................................
    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

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

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
................................................................................
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}
 
/*
 *----------------------------------------------------------------------

    }

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

    bytes = TclGetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;
................................................................................
    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

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

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
................................................................................
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}
 
/*
 *----------------------------------------------------------------------

	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		int len;
		const char *bytes = Tcl_GetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
................................................................................
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	int len;
	const char *bytes = Tcl_GetStringFromObj(folded, &len);

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

    /*
     * Now issue the opcodes. Note that in the case that we know that the
     * first word is an empty word, we don't issue the map at all. That is the
     * correct semantics for mapping.
     */

    bytes = Tcl_GetStringFromObj(objv[0], &len);
    if (len == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, len);
	bytes = Tcl_GetStringFromObj(objv[1], &len);
	PushLiteral(envPtr, bytes, len);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}
................................................................................
	int length, literal, catchRange, breakJump;
	char buf[TCL_UTF_MAX];
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    literal = TclRegisterNewLiteral(envPtr,
		    tokenPtr->start, tokenPtr->size);
	    TclEmitPush(literal, envPtr);
	    TclAdvanceLines(&bline, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    count++;
	    continue;
	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buf);
	    literal = TclRegisterNewLiteral(envPtr, buf, length);
	    TclEmitPush(literal, envPtr);
	    count++;
	    continue;
	case TCL_TOKEN_VARIABLE:
	    /*
	     * Check for simple variable access; see if we can only generate
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
................................................................................
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree((char *) bodyToken);
	    ckfree((char *) bodyTokenArray);
	    ckfree((char *) bodyLines);
	    ckfree((char *) bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
................................................................................
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		int len;
		const char *varname = Tcl_GetStringFromObj(objv[0], &len);

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

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

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1; /* LINT */
	}
	OP(				POP);
................................................................................
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1; /* LINT */
	}
	OP(				POP);
................................................................................
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    int len;

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

	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		int len;
		const char *bytes = TclGetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
................................................................................
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	int len;
	const char *bytes = TclGetStringFromObj(folded, &len);

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

    /*
     * Now issue the opcodes. Note that in the case that we know that the
     * first word is an empty word, we don't issue the map at all. That is the
     * correct semantics for mapping.
     */

    bytes = TclGetStringFromObj(objv[0], &len);
    if (len == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, len);
	bytes = TclGetStringFromObj(objv[1], &len);
	PushLiteral(envPtr, bytes, len);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}
................................................................................
	int length, literal, catchRange, breakJump;
	char buf[TCL_UTF_MAX];
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    literal = TclRegisterLiteral(envPtr,
		    tokenPtr->start, tokenPtr->size, 0);
	    TclEmitPush(literal, envPtr);
	    TclAdvanceLines(&bline, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    count++;
	    continue;
	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buf);
	    literal = TclRegisterLiteral(envPtr, buf, length, 0);
	    TclEmitPush(literal, envPtr);
	    count++;
	    continue;
	case TCL_TOKEN_VARIABLE:
	    /*
	     * Check for simple variable access; see if we can only generate
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
................................................................................
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree(bodyToken);
	    ckfree(bodyTokenArray);
	    ckfree(bodyLines);
	    ckfree(bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
................................................................................
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		int len;
		const char *varname = TclGetStringFromObj(objv[0], &len);

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

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

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1; /* LINT */
	}
	OP(				POP);
................................................................................
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &len);
	    PushLiteral(envPtr, p, len);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1; /* LINT */
	}
	OP(				POP);
................................................................................
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    int len;

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

		int length;

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

		/*
		 * Start a count of the number of words in this function
		 * command invocation. In case there's already a count in
		 * progress (nested functions), save it in our unused "left"
		 * field for restoring later.
................................................................................
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		pc1 = CurrentOffset(envPtr);
		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
			: INST_JUMP_TRUE1, 0, envPtr);
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		pc2 = CurrentOffset(envPtr);
		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
		TclAdjustStackDepth(-1, envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
			envPtr->codeStart + pc1 + 1);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    pc2 += 3;
		}
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
			envPtr->codeStart + pc2 + 1);
		convert = 0;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
................................................................................
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterNewLiteral(envPtr, bytes, length);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
................................................................................
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
				objPtr->length);
			tableValue = TclFetchLiteral(envPtr, index);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

		int length;

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

		/*
		 * Start a count of the number of words in this function
		 * command invocation. In case there's already a count in
		 * progress (nested functions), save it in our unused "left"
		 * field for restoring later.
................................................................................
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		pc1 = CurrentOffset(envPtr);
		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
			: INST_JUMP_TRUE1, 0, envPtr);
		TclEmitPush(TclRegisterLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
		pc2 = CurrentOffset(envPtr);
		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
		TclAdjustStackDepth(-1, envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
			envPtr->codeStart + pc1 + 1);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    pc2 += 3;
		}
		TclEmitPush(TclRegisterLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
			envPtr->codeStart + pc2 + 1);
		convert = 0;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
................................................................................
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);

		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
................................................................................
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

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

		iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;
	int numBytes;
	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

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

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

	TclEmitOpcode(INST_DONE, &compEnv);
................................................................................
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	ckfree((char *) eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	ckfree((char *) eclPtr->loc);
    }

    ckfree((char *) eclPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
................................................................................
static void
CompileCmdLiteral(
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    int numBytes;
    const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
    int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes);


    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);







    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

................................................................................
	SetLineInformation(wordIdx);

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
	    continue;
	}

	objIdx = TclRegisterNewLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

................................................................................
	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		TclEmitInstInt4(INST_EXPAND_STKTOP,
			envPtr->currStackDepth, envPtr);
	    }
	    continue;
	}

	objIdx = TclRegisterNewLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

................................................................................
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

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

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
................................................................................
	if (!cachePtr || !name) {
	    return -1;
	}

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

		iPtr->varFramePtr->localCachePtr)) {
	    TclFreeIntRep(objPtr);
	}
    }
    if (objPtr->typePtr != &substCodeType) {
	CompileEnv compEnv;
	int numBytes;
	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);

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

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

	TclEmitOpcode(INST_DONE, &compEnv);
................................................................................
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	ckfree(eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	ckfree(eclPtr->loc);
    }

    ckfree(eclPtr);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
................................................................................
static void
CompileCmdLiteral(
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    int numBytes;
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;

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

    bytes = TclGetStringFromObj(cmdObj, &numBytes);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);

    if (cmdPtr) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

................................................................................
	SetLineInformation(wordIdx);

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
	    continue;
	}

	objIdx = TclRegisterLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size, 0);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

................................................................................
	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		TclEmitInstInt4(INST_EXPAND_STKTOP,
			envPtr->currStackDepth, envPtr);
	    }
	    continue;
	}

	objIdx = TclRegisterLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size, 0);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

................................................................................
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    int numBytes;
	    const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

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

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
................................................................................
	if (!cachePtr || !name) {
	    return -1;
	}

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

MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, char *bytes,
			    size_t length, unsigned int hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
................................................................................
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02

/*
 * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
 * cast away constness, and it is cleanest to do that here, all in one place.
 *
 * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
 *			     int length);
 */

#define TclRegisterNewLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)

/*
 * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
 * is safe to cast away constness, and it is cleanest to do that here, all in
 * one place.
 *
 * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
 *			       int length);
 */

#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)


/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *
 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
................................................................................
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, int length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
#define PushStringLiteral(envPtr, string) \
    PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, TCL_HASH_TYPE hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
................................................................................
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02























#define LITERAL_UNSHARED	0x04

/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *
 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
................................................................................
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, int length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
    PushLiteral(envPtr, string, (int) (sizeof(string "") - 1))

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		Tcl_GetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
................................................................................
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    Tcl_GetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	if (cdPtr->encoding) {
	    venc = Tcl_GetEncoding(interp, cdPtr->encoding);
	    if (!venc) {
		return TCL_ERROR;
................................................................................
    QCCD *cdPtr = clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree((char *)cdPtr->encoding);
    }
    ckfree((char *)cdPtr);
}
 
/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *

	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		TclGetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
................................................................................
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	if (cdPtr->encoding) {
	    venc = Tcl_GetEncoding(interp, cdPtr->encoding);
	    if (!venc) {
		return TCL_ERROR;
................................................................................
    QCCD *cdPtr = clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree(cdPtr->encoding);
    }
    ckfree(cdPtr);
}
 
/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *

static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
static inline void	InitChainTable(struct Dict *dict);
static inline void	DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
			    Tcl_Obj *keyPtr, int *newPtr);
static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
static int		FinalizeDictUpdate(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeDictWith(ClientData data[],

			    Tcl_Interp *interp, int result);
static int		DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictForLoopCallback(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		DictMapLoopCallback(ClientData data[],
			    Tcl_Interp *interp, int result);

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
................................................................................
DictAppendCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int i, allocatedDict = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
................................................................................
    if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
	if (allocatedDict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

















    if (valuePtr == NULL) {
	TclNewObj(valuePtr);






    } else if (Tcl_IsShared(valuePtr)) {
	valuePtr = Tcl_DuplicateObj(valuePtr);
    }

    for (i=3 ; i<objc ; i++) {
	Tcl_AppendObjToObj(valuePtr, objv[i]);
    }

    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);







    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);

static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
static inline void	InitChainTable(struct Dict *dict);
static inline void	DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
			    Tcl_Obj *keyPtr, int *newPtr);
static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
static Tcl_NRPostProc	FinalizeDictUpdate;

static Tcl_NRPostProc	FinalizeDictWith;
static Tcl_ObjCmdProc	DictForNRCmd;
static Tcl_ObjCmdProc	DictMapNRCmd;




static Tcl_NRPostProc	DictForLoopCallback;

static Tcl_NRPostProc	DictMapLoopCallback;


/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
................................................................................
DictAppendCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int allocatedDict = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
................................................................................
    if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
	if (allocatedDict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

    if ((objc > 3) || (valuePtr == NULL)) {
	/* Only go through append activites when something will change. */
	Tcl_Obj *appendObjPtr = NULL;

	if (objc > 3) {
	    /* Something to append */

	    if (objc == 4) {
		appendObjPtr = objv[3];
	    } else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		    objc-3, objv+3, &appendObjPtr)) {
		return TCL_ERROR;
	    }
	}

	if (appendObjPtr == NULL) {
	    /* => (objc == 3) => (valuePtr == NULL) */
	    TclNewObj(valuePtr);
	} else if (valuePtr == NULL) {
	    valuePtr = appendObjPtr;
	    appendObjPtr = NULL;
	}

	if (appendObjPtr) {
	    if (Tcl_IsShared(valuePtr)) {
		valuePtr = Tcl_DuplicateObj(valuePtr);
	    }


	    Tcl_AppendObjToObj(valuePtr, appendObjPtr);
	}

	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
    }

    /*
     * Even if nothing changed, we still overwrite so that variable
     * trace expectations are met.
     */

    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);

    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    int maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    int length;

    bytes = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
................................................................................
	}
    }
    if (suffixObj) {
	const char *bytes;
	int length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }

    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    int maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    int length;

    bytes = TclGetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
................................................................................
	}
    }
    if (suffixObj) {
	const char *bytes;
	int length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }

int
Tcl_GetEncodingFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *name = Tcl_GetString(objPtr);

    if (objPtr->typePtr != &encodingType) {
	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);

	if (encoding == NULL) {
	    return TCL_ERROR;
	}
................................................................................
 *	to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR
 *	is returned, an error message is left in interp's result object,
 *	unless interp was NULL.
 *
 * Side effects:
 *	The reference count of the new system encoding is incremented. The
 *	reference count of the old system encoding is decremented and it may
 *	be freed.
 *
 *------------------------------------------------------------------------
 */

int
Tcl_SetSystemEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
................................................................................
	}
    }

    Tcl_MutexLock(&encodingMutex);
    FreeEncoding(systemEncoding);
    systemEncoding = encoding;
    Tcl_MutexUnlock(&encodingMutex);


    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................

	for (i=0; i<numDirs && !verified; i++) {
	    if (dir[i] == directory) {
		verified = 1;
	    }
	}
	if (!verified) {
	    const char *dirString = Tcl_GetString(directory);

	    for (i=0; i<numDirs && !verified; i++) {
		if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
		    verified = 1;
		}
	    }
	}
	if (!verified) {
	    /*
	     * Directory no longer on the search path. Remove from cache.
................................................................................
    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;

	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
	p = Tcl_GetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
	p += 2;
	for (lo = 0; lo < 256; lo++) {
	    if ((lo & 0x0f) == 0) {
		p++;
	    }
................................................................................
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;
    size_t numBytes;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();
................................................................................

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = Tcl_GetString(searchPathObj);
    numBytes = searchPathObj->length;

    *lengthPtr = numBytes;
    *valuePtr = ckalloc(numBytes + 1);
    memcpy(*valuePtr, bytes, numBytes + 1);
    Tcl_DecrRefCount(searchPathObj);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

int
Tcl_GetEncodingFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *name = TclGetString(objPtr);

    if (objPtr->typePtr != &encodingType) {
	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);

	if (encoding == NULL) {
	    return TCL_ERROR;
	}
................................................................................
 *	to the encoding specified by name, TCL_ERROR otherwise. If TCL_ERROR
 *	is returned, an error message is left in interp's result object,
 *	unless interp was NULL.
 *
 * Side effects:
 *	The reference count of the new system encoding is incremented. The
 *	reference count of the old system encoding is decremented and it may
 *	be freed. All VFS cached information is invalidated.
 *
 *------------------------------------------------------------------------
 */

int
Tcl_SetSystemEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
................................................................................
	}
    }

    Tcl_MutexLock(&encodingMutex);
    FreeEncoding(systemEncoding);
    systemEncoding = encoding;
    Tcl_MutexUnlock(&encodingMutex);
    Tcl_FSMountsChanged(NULL);

    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................

	for (i=0; i<numDirs && !verified; i++) {
	    if (dir[i] == directory) {
		verified = 1;
	    }
	}
	if (!verified) {
	    const char *dirString = TclGetString(directory);

	    for (i=0; i<numDirs && !verified; i++) {
		if (strcmp(dirString, TclGetString(dir[i])) == 0) {
		    verified = 1;
		}
	    }
	}
	if (!verified) {
	    /*
	     * Directory no longer on the search path. Remove from cache.
................................................................................
    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;

	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
	p = TclGetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
	p += 2;
	for (lo = 0; lo < 256; lo++) {
	    if ((lo & 0x0f) == 0) {
		p++;
	    }
................................................................................
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;

    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();
................................................................................

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);


    *lengthPtr = searchPathObj->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

static void		CompileToInvokedCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
			    Command *cmdPtr, CompileEnv *envPtr);
static int		CompileBasicNArgCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr);

static Tcl_NRPostProc	FreeObj;
static Tcl_NRPostProc	FreeER;

/*
 * The lists of subcommands and options for the [namespace ensemble] command.
 */

static const char *const ensembleSubcommands[] = {
................................................................................
 * spell corrections.
 */

typedef struct {
    int epoch;                  /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Tcl_Command token;          /* Reference to the comamnd for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand
                                 * hash table. */
} EnsembleCmdRep;

 
................................................................................
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	ckfree((char *) nameParts);
    }
    return ensemble;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	 * part where we do the invocation of the subcommand.
	 */

	if (subObj->typePtr==&ensembleCmdType){
	    EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;

	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == ensemblePtr->token) {
		prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
		Tcl_IncrRefCount(prefixObj);
		if (ensembleCmd->fix) {
		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
		}
		goto runResultingSubcommand;
	    }
................................................................................
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	int stringLength, i;
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
................................................................................
     * but we don't do that (the cacheing of the command object used should
     * help with that.)
     */

    {
	Tcl_Obj *copyPtr;	/* The actual list of words to dispatch to.
				 * Will be freed by the dispatch engine. */

	int prefixObjc;

	Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = prefixObj;
	    Tcl_IncrRefCount(copyPtr);
	    TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
	} else {
	    int copyObjc = objc - 2 + prefixObjc;

	    copyPtr = Tcl_NewListObj(copyObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv+1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,
		    objv + 2 + ensemblePtr->numParameters);
	}


	TclDecrRefCount(prefixObj);

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */
................................................................................
	}

	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);

    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered
     * for dealing with this situation. Will only call (at most) once for any
................................................................................
    Tcl_Obj **tmp = (Tcl_Obj **)data[0];

    ckfree(tmp[2]);
    ckfree(tmp);
    return result;
}

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

    Tcl_DecrRefCount(objPtr);
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int badIdx,
    Tcl_Obj *bad,
................................................................................
	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
	store = (Tcl_Obj **)tmp[2];
    }

    store[idx] = fix;
    Tcl_IncrRefCount(fix);
    TclNRAddCallback(interp, FreeObj, fix, NULL, NULL, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFetchEnsembleRoot --
 *
................................................................................
    Tcl_HashEntry *hPtr,
    Tcl_Obj *fix)
{
    register EnsembleCmdRep *ensembleCmd;

    if (objPtr->typePtr == &ensembleCmdType) {
	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;

	if (ensembleCmd->fix) {
	    Tcl_DecrRefCount(ensembleCmd->fix);
	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
................................................................................
    }

    /*
     * Populate the internal rep.
     */

    ensembleCmd->epoch = ensemblePtr->epoch;

    ensembleCmd->token = ensemblePtr->token;
    if (fix) {
	Tcl_IncrRefCount(fix);
    }
    ensembleCmd->fix = fix;
    ensembleCmd->hPtr = hPtr;
}
 
................................................................................

static void
FreeEnsembleCmdRep(
    Tcl_Obj *objPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;


    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    ckfree(ensembleCmd);
    objPtr->typePtr = NULL;
}
 
................................................................................
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));

    copyPtr->typePtr = &ensembleCmdType;
    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;

    ensembleCopy->fix = ensembleCmd->fix;
    if (ensembleCopy->fix) {
	Tcl_IncrRefCount(ensembleCopy->fix);
    }
    ensembleCopy->hPtr = ensembleCmd->hPtr;
}
 
................................................................................
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {
	    str = Tcl_GetStringFromObj(elems[i], &sclen);
	    if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
................................................................................
	    }
	}
	/*
	 * The length of the "replaced" list must be depth-1.  Trim back
	 * any extra elements that might have been appended by failing
	 * pathways above.
	 */
	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, INT_MAX, 0, NULL);

	/*
	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
	 * when depth==1.  In that case we are choosing to emit the
	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
	 * to be done.  It would be equally functional and presumably more
	 * performant to fall through to cleanup below, return TCL_ERROR,
................................................................................
    Tcl_Obj *replacements,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    char *bytes;
    int length, i, numWords, cmdLit;
    DefineLineInformation;

    /*
     * Push the words of the command. Take care; the command words may be
     * scripts that have backslashes in them, and [info frame 0] can see the
     * difference. Hence the call to TclContinuationsEnterDerived...
     */

    Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
	    i++, tokPtr = TokenAfter(tokPtr)) {
	if (i > 0 && i < numWords+1) {
	    bytes = Tcl_GetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterNewLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			TclFetchLiteral(envPtr, literal),
			tokPtr[1].start - envPtr->source,
			envPtr->clNext);
	    }
................................................................................
     * Push the name of the command we're actually dispatching to as part of
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);



    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

static void		CompileToInvokedCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
			    Command *cmdPtr, CompileEnv *envPtr);
static int		CompileBasicNArgCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr);


static Tcl_NRPostProc	FreeER;

/*
 * The lists of subcommands and options for the [namespace ensemble] command.
 */

static const char *const ensembleSubcommands[] = {
................................................................................
 * spell corrections.
 */

typedef struct {
    int epoch;                  /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Command *token;             /* Reference to the command for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand
                                 * hash table. */
} EnsembleCmdRep;

 
................................................................................
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	ckfree(nameParts);
    }
    return ensemble;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	 * part where we do the invocation of the subcommand.
	 */

	if (subObj->typePtr==&ensembleCmdType){
	    EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;

	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == (Command *)ensemblePtr->token) {
		prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
		Tcl_IncrRefCount(prefixObj);
		if (ensembleCmd->fix) {
		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
		}
		goto runResultingSubcommand;
	    }
................................................................................
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	int stringLength, i;
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
................................................................................
     * but we don't do that (the cacheing of the command object used should
     * help with that.)
     */

    {
	Tcl_Obj *copyPtr;	/* The actual list of words to dispatch to.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	int copyObjc, prefixObjc;

	Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclListObjCopy(NULL, prefixObj);


	} else {


	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv + 1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,
		    objv + 2 + ensemblePtr->numParameters);
	}
	Tcl_IncrRefCount(copyPtr);
	TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
	TclDecrRefCount(prefixObj);

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */
................................................................................
	}

	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered
     * for dealing with this situation. Will only call (at most) once for any
................................................................................
    Tcl_Obj **tmp = (Tcl_Obj **)data[0];

    ckfree(tmp[2]);
    ckfree(tmp);
    return result;
}













void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int badIdx,
    Tcl_Obj *bad,
................................................................................
	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
	TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
	store = (Tcl_Obj **)tmp[2];
    }

    store[idx] = fix;
    Tcl_IncrRefCount(fix);
    TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFetchEnsembleRoot --
 *
................................................................................
    Tcl_HashEntry *hPtr,
    Tcl_Obj *fix)
{
    register EnsembleCmdRep *ensembleCmd;

    if (objPtr->typePtr == &ensembleCmdType) {
	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
	TclCleanupCommandMacro(ensembleCmd->token);
	if (ensembleCmd->fix) {
	    Tcl_DecrRefCount(ensembleCmd->fix);
	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
................................................................................
    }

    /*
     * Populate the internal rep.
     */

    ensembleCmd->epoch = ensemblePtr->epoch;
    ensembleCmd->token = (Command *) ensemblePtr->token;
    ensembleCmd->token->refCount++;
    if (fix) {
	Tcl_IncrRefCount(fix);
    }
    ensembleCmd->fix = fix;
    ensembleCmd->hPtr = hPtr;
}
 
................................................................................

static void
FreeEnsembleCmdRep(
    Tcl_Obj *objPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;

    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    ckfree(ensembleCmd);
    objPtr->typePtr = NULL;
}
 
................................................................................
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));

    copyPtr->typePtr = &ensembleCmdType;
    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;
    ensembleCopy->fix = ensembleCmd->fix;
    if (ensembleCopy->fix) {
	Tcl_IncrRefCount(ensembleCopy->fix);
    }
    ensembleCopy->hPtr = ensembleCmd->hPtr;
}
 
................................................................................
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {
	    str = TclGetStringFromObj(elems[i], &sclen);
	    if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
................................................................................
	    }
	}
	/*
	 * The length of the "replaced" list must be depth-1.  Trim back
	 * any extra elements that might have been appended by failing
	 * pathways above.
	 */
	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);

	/*
	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
	 * when depth==1.  In that case we are choosing to emit the
	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
	 * to be done.  It would be equally functional and presumably more
	 * performant to fall through to cleanup below, return TCL_ERROR,
................................................................................
    Tcl_Obj *replacements,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    char *bytes;
    int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
    DefineLineInformation;

    /*
     * Push the words of the command. Take care; the command words may be
     * scripts that have backslashes in them, and [info frame 0] can see the
     * difference. Hence the call to TclContinuationsEnterDerived...
     */

    Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
	    i++, tokPtr = TokenAfter(tokPtr)) {
	if (i > 0 && i < numWords+1) {
	    bytes = TclGetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size, 0);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			TclFetchLiteral(envPtr, literal),
			tokPtr[1].start - envPtr->source,
			envPtr->clNext);
	    }
................................................................................
     * Push the name of the command we're actually dispatching to as part of
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }
    cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"
#include "tclStringRep.h"
#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
................................................................................
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	ckfree((char *) freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.
................................................................................

	/*
	 * Successful compilation. If the expression yielded no instructions,
	 * push an zero object as the expression's result.
	 */

	if (compEnv.codeNext == compEnv.codeStart) {
	    TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
		    &compEnv);
	}

	/*
	 * Add a "done" instruction as the last instruction and change the
	 * object into a ByteCode object. Ownership of the literal objects and
	 * aux data items is given to the ByteCode object.
................................................................................
    bcFramePtr->cmd = NULL;
    bcFramePtr->len = 0;

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numExecutions++;
#endif








    /*
     * Push the callback for bytecode execution
     */

    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
	    /* cleanup */ INT2PTR(0), NULL);
    return TCL_OK;
................................................................................
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
			Tcl_GetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	/*
	 * Install a tailcall record in the caller and continue with the
................................................................................
	    *b = tmpPtr;
	    a++; b--;
	}
	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_STR_CONCAT1: {
	int appendLen = 0;
	char *bytes, *p;
	Tcl_Obj **currPtr;
	int onlyb = 1;

	opnd = TclGetUInt1AtPtr(pc+1);

	/*
	 * Detect only-bytearray-or-null case.
	 */

	for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
	    if (((*currPtr)->typePtr != &tclByteArrayType)
		    && ((*currPtr)->bytes != tclEmptyStringRep)) {
		onlyb = 0;
		break;
	    } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
		    ((*currPtr)->bytes != NULL)) {
		onlyb = 0;
		break;
	    }
	}

	/*
	 * Compute the length to be appended.
	 */

	if (onlyb) {

	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
		if ((*currPtr)->bytes != tclEmptyStringRep) {
		    Tcl_GetByteArrayFromObj(*currPtr, &length);
		    appendLen += length;


		}
	    }
	} else {
	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
		bytes = TclGetStringFromObj(*currPtr, &length);
		if (bytes != NULL) {
		    appendLen += length;
		}
	    }
	}

	if (appendLen < 0) {
	    /* TODO: convert panic to error ? */
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	/*
	 * If nothing is to be appended, just return the first object by
	 * dropping all the others from the stack; this saves both the
	 * computation and copy of the string rep of the first object,
	 * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
	 */

	if (appendLen == 0) {
	    TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	    NEXT_INST_V(2, (opnd-1), 0);
	}

	/*
	 * If the first object is shared, we need a new obj for the result;
	 * otherwise, we can reuse the first object. In any case, make sure it
	 * has enough room to accomodate all the concatenated bytes. Note that
	 * if it is unshared its bytes are copied by ckrealloc, so that we set
	 * the loop parameters to avoid copying them again: p points to the
	 * end of the already copied bytes, currPtr to the second object.
	 */

	objResultPtr = OBJ_AT_DEPTH(opnd-1);
	if (!onlyb) {
	    bytes = TclGetStringFromObj(objResultPtr, &length);
	    if (length + appendLen < 0) {
		/* TODO: convert panic to error ? */
		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
			INT_MAX);
	    }
#ifndef TCL_COMPILE_DEBUG
	    if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
		TclFreeIntRep(objResultPtr);
		objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
		objResultPtr->length = length + appendLen;
		p = TclGetString(objResultPtr) + length;
		currPtr = &OBJ_AT_DEPTH(opnd - 2);
	    } else
#endif
	    {
		p = ckalloc(length + appendLen + 1);
		TclNewObj(objResultPtr);
		objResultPtr->bytes = p;
		objResultPtr->length = length + appendLen;
		currPtr = &OBJ_AT_DEPTH(opnd - 1);
	    }

	    /*
	     * Append the remaining characters.
	     */

	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
		bytes = TclGetStringFromObj(*currPtr, &length);
		if (bytes != NULL) {
		    memcpy(p, bytes, (size_t) length);
		    p += length;
		}
	    }
	    *p = '\0';
	} else {
	    bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
	    if (length + appendLen < 0) {
		/* TODO: convert panic to error ? */
		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
			INT_MAX);
	    }
#ifndef TCL_COMPILE_DEBUG
	    if (!Tcl_IsShared(objResultPtr)) {
		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
			length + appendLen);
		p = bytes + length;
		currPtr = &OBJ_AT_DEPTH(opnd - 2);
	    } else
#endif
	    {
		TclNewObj(objResultPtr);
		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
			length + appendLen);
		p = bytes;
		currPtr = &OBJ_AT_DEPTH(opnd - 1);
	    }

	    /*
	     * Append the remaining characters.
	     */

	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
		if ((*currPtr)->bytes != tclEmptyStringRep) {
		    bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
		    memcpy(p, bytes, (size_t) length);
		    p += length;
		}
	    }
	}

	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
	NEXT_INST_V(2, opnd, 1);
    }

    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
	 * and then decrement their ref counts.
	 */

................................................................................
		}
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);
	}
#endif /*TCL_COMPILE_DEBUG*/
	{
	    Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
	    register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
	    Tcl_Obj **copyObjv = &listRepPtr->elements;
	    int i;

	    listRepPtr->elemCount = objc - opnd + 1;
	    copyObjv[0] = objPtr;
	    memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
	    for (i=1 ; i<objc-opnd+1 ; i++) {
		Tcl_IncrRefCount(copyObjv[i]);
	    }
	    objPtr = copyPtr;
	}
	bcFramePtr->data.tebc.pc = (char *) pc;
	iPtr->cmdFramePtr = bcFramePtr;
	if (iPtr->flags & INTERP_DEBUG_FRAME) {
	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
	}

	TclInitRewriteEnsemble(interp, opnd, 1, objv);











	DECACHE_STACK_INFO();
	pc += 6;
	TEBC_YIELD();

	TclMarkTailcall(interp);
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);



    /*
     * -----------------------------------------------------------------
     *	   Start of INST_LOAD instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to some
................................................................................
	/*
	 * Locate the other variable.
	 */

	savedNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
		/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
	iPtr->varFramePtr->nsPtr = savedNsPtr;
	if (!otherPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	goto doLinkVars;

................................................................................
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	    if (toIdx >= objc) {
		toIdx = objc-1;
	    }
	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
		/*

		 * BEWARE! This is looking inside the implementation of the
		 * list type.
		 */

		List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;

		if (listPtr->refCount == 1) {
		    for (index=toIdx+1; index<objc ; index++) {
			TclDecrRefCount(objv[index]);
		    }
		    listPtr->elemCount = toIdx+1;
		    listPtr->canonicalFlag = 1;
		    TclInvalidateStringRep(valuePtr);
		    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
		    NEXT_INST_F(9, 0, 0);
		}
	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
................................................................................
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	length3 = Tcl_GetCharLength(value3Ptr);

	/*
	 * Remove substring. In-place.
	 */

	if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) {
	    TclDecrRefCount(value3Ptr);
	    Tcl_SetObjLength(valuePtr, fromIdx);
	    TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}

	/*
	 * See if we can splice in place. This happens when the number of
	 * characters being replaced is the same as the number of characters
	 * in the string to be inserted.
	 */

	if (length3 - 1 == toIdx - fromIdx) {
	    unsigned char *bytes1, *bytes2;

	    /*
	     * Flush the info in the string internal rep that refers to the
	     * about-to-be-invalidated UTF-8 rep. This indicates that a new
	     * buffer needs to be allocated, and assumes that the value is
	     * already of tclStringTypePtr type, which should be true provided
	     * we call it after Tcl_GetUnicodeFromObj.
	     */
#define MarkStringInternalRepForFlush(objPtr) \
	    (GET_STRING(objPtr)->allocated = 0)

	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_DuplicateObj(valuePtr);



		if (TclIsPureByteArray(objResultPtr)
			&& TclIsPureByteArray(value3Ptr)) {
		    bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));
		    MarkStringInternalRepForFlush(objResultPtr);
		}
		Tcl_InvalidateStringRep(objResultPtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));

		NEXT_INST_F(1, 1, 1);
	    } else {
		if (TclIsPureByteArray(valuePtr)
			&& TclIsPureByteArray(value3Ptr)) {
		    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL);
		    bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		    memcpy(bytes1 + fromIdx, bytes2, length3);
		} else {
		    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL);
		    ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		    memcpy(ustring1 + fromIdx, ustring2,
			    length3 * sizeof(Tcl_UniChar));
		    MarkStringInternalRepForFlush(valuePtr);
		}
		Tcl_InvalidateStringRep(valuePtr);
		TclDecrRefCount(value3Ptr);
		TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
		NEXT_INST_F(1, 0, 0);
	    }
	}

	/*
	 * Get the unicode representation; this is where we guarantee to lose
	 * bytearrays.
	 */
................................................................................
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	length--;

	/*
	 * Remove substring using copying.
	 */

	if (length3 == 0) {
	    if (fromIdx > 0) {
		objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
		if (toIdx < length) {
		    Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			    length - toIdx);
		}





	    } else {
		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
			length - toIdx);
	    }
	    TclDecrRefCount(value3Ptr);
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    NEXT_INST_F(1, 1, 1);
	}

	/*
	 * Splice string pieces by full copying.
	 */

	if (fromIdx > 0) {
	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
	    Tcl_AppendObjToObj(objResultPtr, value3Ptr);
	    if (toIdx < length) {

		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else if (Tcl_IsShared(value3Ptr)) {

	    objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);
	    }
	} else {
	    /*
	     * Be careful with splicing the stack in this case; we have a
	     * refCount:1 object in value3Ptr and we want to append to it and
	     * make it be the refCount:1 object at the top of the stack
	     * afterwards. [Bug 82e7f67325]
	     */

	    if (toIdx < length) {
		Tcl_AppendUnicodeToObj(value3Ptr, ustring1 + toIdx + 1,
			length - toIdx);




	    }
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));


	    TclDecrRefCount(valuePtr);
	    OBJ_AT_TOS = value3Ptr;	/* Tricky! */

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

    case INST_STR_MAP:
................................................................................
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */

	match = -1;
	if (length2 > 0 && length2 <= length) {
	    end = ustring1 + length - length2 + 1;
	    for (p=ustring1 ; p<end ; p++) {
		if ((*p == *ustring2) &&
			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
		    match = p - ustring1;
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length);	/* Haystack */
	ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */

	match = -1;
	if (length2 > 0 && length2 <= length) {
	    for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
		if ((*p == *ustring2) &&
			memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
		    match = p - ustring1;
		    break;
		}
	    }
	}

	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
................................................................................
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d(&big1, big2.dp[0], &bigResult);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
................................................................................
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "\n executing ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
	    fprintf(stderr,"%s\n", Tcl_GetString(message));
	    Tcl_DecrRefCount(message);
	} else {
	    fprintf(stderr, "\n");
	}
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
    }
}
................................................................................
	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
	}
    } else {
	Tcl_Obj *objPtr = Tcl_ObjPrintf(
		"unknown floating-point error, errno = %d", errno);

	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
		Tcl_GetString(objPtr), NULL);
	Tcl_SetObjResult(interp, objPtr);
    }
}
 
#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
................................................................................
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
		numByteCodeLits++;
	    }
	    (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {
................................................................................
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = Tcl_GetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {

 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tommath.h"

#include <math.h>
#include <assert.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
................................................................................
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	ckfree(freePtr);
	return;
    }

    /*
     * Rewind the stack to the previous marker position. The current marker,
     * as set in the last call to GrowEvaluationStack, contains a pointer to
     * the previous marker.
................................................................................

	/*
	 * Successful compilation. If the expression yielded no instructions,
	 * push an zero object as the expression's result.
	 */

	if (compEnv.codeNext == compEnv.codeStart) {
	    TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, 0),
		    &compEnv);
	}

	/*
	 * Add a "done" instruction as the last instruction and change the
	 * object into a ByteCode object. Ownership of the literal objects and
	 * aux data items is given to the ByteCode object.
................................................................................
    bcFramePtr->cmd = NULL;
    bcFramePtr->len = 0;

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numExecutions++;
#endif

    /*
     * Test namespace-50.9 demonstrates the need for this call.
     * Use a --enable-symbols=mem bug to see.
     */

    TclResetRewriteEnsemble(interp, 1);

    /*
     * Push the callback for bytecode execution
     */

    TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
	    /* cleanup */ INT2PTR(0), NULL);
    return TCL_OK;
................................................................................
	if (tclTraceExec >= 2) {
	    if (traceInstructions) {
		TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
	    } else {
		/* FIXME: What is the right thing to trace? */
		fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
			iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
			TclGetString(valuePtr));
	    }
	    fflush(stdout);
	}
#endif

	/*
	 * Install a tailcall record in the caller and continue with the
................................................................................
	    *b = tmpPtr;
	    a++; b--;
	}
	TRACE(("%u => OK\n", opnd));
	NEXT_INST_F(5, 0, 0);
    }

    case INST_STR_CONCAT1:





	opnd = TclGetUInt1AtPtr(pc+1);






















	if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
		opnd, &OBJ_AT_DEPTH(opnd-1), &objResultPtr)) {




	    TRACE_ERROR(interp);
	    goto gotError;
	}
























	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);






















































































	NEXT_INST_V(2, opnd, 1);


    case INST_CONCAT_STK:
	/*
	 * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj,
	 * and then decrement their ref counts.
	 */

................................................................................
		}
		fprintf(stdout, " ");
	    }
	    fprintf(stdout, "\n");
	    fflush(stdout);
	}
#endif /*TCL_COMPILE_DEBUG*/














	bcFramePtr->data.tebc.pc = (char *) pc;
	iPtr->cmdFramePtr = bcFramePtr;
	if (iPtr->flags & INTERP_DEBUG_FRAME) {
	    ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
	}

	TclInitRewriteEnsemble(interp, opnd, 1, objv);

	{
	    Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);

	    Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - opnd, objv + opnd);
	    Tcl_DecrRefCount(objPtr);
	    objPtr = copyPtr;
	}

	DECACHE_STACK_INFO();
	pc += 6;
	TEBC_YIELD();

	TclMarkTailcall(interp);
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
	Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
	TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
	return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);

    /*
     * -----------------------------------------------------------------
     *	   Start of INST_LOAD instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to some
................................................................................
	/*
	 * Locate the other variable.
	 */

	savedNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
		(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
		"access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
	iPtr->varFramePtr->nsPtr = savedNsPtr;
	if (!otherPtr) {
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	goto doLinkVars;

................................................................................
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	    if (toIdx >= objc) {
		toIdx = objc-1;
	    }
	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {

		Tcl_ListObjReplace(interp, valuePtr,
			toIdx + 1, LIST_MAX, 0, NULL);












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

	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
................................................................................
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}

	length3 = Tcl_GetCharLength(value3Ptr);












	/*
	 * See if we can splice in place. This happens when the number of
	 * characters being replaced is the same as the number of characters
	 * in the string to be inserted.
	 */

	if (length3 - 1 == toIdx - fromIdx) {
	    unsigned char *bytes1, *bytes2;











	    if (Tcl_IsShared(valuePtr)) {
		objResultPtr = Tcl_DuplicateObj(valuePtr);
	    } else {
		objResultPtr = valuePtr;
	    }
	    if (TclIsPureByteArray(objResultPtr)
		    && TclIsPureByteArray(value3Ptr)) {
		bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
		bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
		memcpy(bytes1 + fromIdx, bytes2, length3);
	    } else {
		ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
		ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
		memcpy(ustring1 + fromIdx, ustring2,
			length3 * sizeof(Tcl_UniChar));

	    }
	    Tcl_InvalidateStringRep(objResultPtr);
	    TclDecrRefCount(value3Ptr);
	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	    if (objResultPtr == valuePtr) {
		NEXT_INST_F(1, 0, 0);
	    } else {















		NEXT_INST_F(1, 1, 1);
	    }
	}

	/*
	 * Get the unicode representation; this is where we guarantee to lose
	 * bytearrays.
	 */
................................................................................
	ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
	length--;

	/*
	 * Remove substring using copying.
	 */

	objResultPtr = NULL;
	if (fromIdx > 0) {
	    objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);



	}
	if (length3 > 0) {
	    if (objResultPtr) {
		Tcl_AppendObjToObj(objResultPtr, value3Ptr);
	    } else if (Tcl_IsShared(value3Ptr)) {
		objResultPtr = Tcl_DuplicateObj(value3Ptr);
	    } else {
		objResultPtr = value3Ptr;

	    }



	}








	if (toIdx < length) {
	    if (objResultPtr) {
		Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
			length - toIdx);


	    } else {
		objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,


			length - toIdx);
	    }







	}



	if (objResultPtr == NULL) {
	    /* This has to be the case [string replace $s 0 end {}] */
	    /* which has result {} which is same as value3Ptr. */
	    objResultPtr = value3Ptr;
	}

	if (objResultPtr == value3Ptr) {
	    /* See [Bug 82e7f67325] */
	    TclDecrRefCount(OBJ_AT_TOS);
	    OBJ_AT_TOS = value3Ptr;
	    TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
	    NEXT_INST_F(1, 0, 0);
	}
	TclDecrRefCount(value3Ptr);
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_MAP:
................................................................................
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:
	match = TclStringFind(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);














	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_FIND_LAST:
	match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);













	TRACE(("%.20s %.20s => %d\n",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));

	TclNewLongObj(objResultPtr, match);
	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
................................................................................
	    mp_clear(&big2);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
	mp_clear(&big1);
	mp_clear(&big2);
	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
................................................................................
		stackTop, relativePc, stackUpperBound);
	if (cmd != NULL) {
	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "\n executing ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
	    fprintf(stderr,"%s\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	} else {
	    fprintf(stderr, "\n");
	}
	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
    }
}
................................................................................
	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
	}
    } else {
	Tcl_Obj *objPtr = Tcl_ObjPrintf(
		"unknown floating-point error, errno = %d", errno);

	Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
		TclGetString(objPtr), NULL);
	Tcl_SetObjResult(interp, objPtr);
    }
}
 
#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
................................................................................
    strBytesSharedOnce = 0.0;
    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
		entryPtr = entryPtr->nextPtr) {
	    if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
		numByteCodeLits++;
	    }
	    (void) TclGetStringFromObj(entryPtr->objPtr, &length);
	    refCountSum += entryPtr->refCount;
	    objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
	    strBytesIfUnshared += (entryPtr->refCount * (length+1));
	    if (entryPtr->refCount > 1) {
		numSharedMultX++;
		strBytesSharedMultX += (length+1);
	    } else {
................................................................................
#endif
    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");

    if (objc == 1) {
	Tcl_SetObjResult(interp, objPtr);
    } else {
	Tcl_Channel outChan;
	char *str = TclGetStringFromObj(objv[1], &length);

	if (length) {
	    if (strcmp(str, "stdout") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDOUT);
	    } else if (strcmp(str, "stderr") == 0) {
		outChan = Tcl_GetStdChannel(TCL_STDERR);
	    } else {

		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings,
		sizeof(char *), "option", 0, &index) != TCL_OK) {
	    goto end;
	}
	if (attributeStringsAllocated != NULL) {
	    TclFreeIntRep(objv[0]);
	}
	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
		&objPtr) != TCL_OK) {
	    goto end;
	}
	Tcl_SetObjResult(interp, objPtr);
    } else {
	/*
................................................................................
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings,
		    sizeof(char *), "option", 0, &index) != TCL_OK) {

		goto end;
	    }
	    if (attributeStringsAllocated != NULL) {
		TclFreeIntRep(objv[i]);
	    }
	    if (i + 1 == objc) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"value for \"%s\" missing", TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", NULL);
		goto end;
	    }

		    "bad option \"%s\", there are no file attributes in this"
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings,
		sizeof(char *), "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
	    goto end;
	}



	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
		&objPtr) != TCL_OK) {
	    goto end;
	}
	Tcl_SetObjResult(interp, objPtr);
    } else {
	/*
................................................................................
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings,
		    sizeof(char *), "option", INDEX_TEMP_TABLE, &index)
		    != TCL_OK) {
		goto end;
	    }



	    if (i + 1 == objc) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"value for \"%s\" missing", TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", NULL);
		goto end;
	    }

    Tcl_Obj *pathPtr,		/* Native path of interest */
    int *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
				 * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    int pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    if (path[0] == '~') {
	/*
	 * This case is common to all platforms. Paths that begin with ~ are
	 * absolute.
	 */

................................................................................
    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	Tcl_GetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */
................................................................................
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = Tcl_GetStringFromObj(eltPtr, &len);
	memcpy(p, str, (size_t) len+1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */
................................................................................
    const char *joining)
{
    int length, needsSep;
    char *dest;
    const char *p;
    const char *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;
................................................................................
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

................................................................................
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

................................................................................
    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = Tcl_GetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */

................................................................................
    globFlags = 0;
    join = 0;
    dir = PATH_NONE;
    typePtr = NULL;
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
		sizeof(char *), "option", 0, &index) != TCL_OK) {
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    if (string[0] == '-') {
		/*
		 * It looks like the command contains an option so signal an
		 * error.
		 */

		return TCL_ERROR;
................................................................................
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	int pathlength;
	const char *last;
	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; last--) {
................................................................................
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    int len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':
................................................................................
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */
................................................................................
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    int len;
	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {
................................................................................
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
................................................................................
	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
................................................................................
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		int len;
		const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

		if (strchr(separators, joined[len-1]) == NULL) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
................................................................................
	     * volume-relative path. In particular globbing in Windows shares,
	     * when not using -dir or -path, e.g. 'glob [file join
	     * //machine/share/subdir *]' requires adding a separator here.
	     * This behaviour is not currently tested for in the test suite.
	     */

	    int len;
	    const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

	    if (strchr(separators, joined[len-1]) == NULL) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}

    Tcl_Obj *pathPtr,		/* Native path of interest */
    int *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
				 * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    int pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);

    if (path[0] == '~') {
	/*
	 * This case is common to all platforms. Paths that begin with ~ are
	 * absolute.
	 */

................................................................................
    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	TclGetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */
................................................................................
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = TclGetStringFromObj(eltPtr, &len);
	memcpy(p, str, (size_t) len+1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */
................................................................................
    const char *joining)
{
    int length, needsSep;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;
................................................................................
    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

................................................................................
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    TclGetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

................................................................................
    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = TclGetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */

................................................................................
    globFlags = 0;
    join = 0;
    dir = PATH_NONE;
    typePtr = NULL;
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
		sizeof(char *), "option", 0, &index) != TCL_OK) {
	    string = TclGetStringFromObj(objv[i], &length);
	    if (string[0] == '-') {
		/*
		 * It looks like the command contains an option so signal an
		 * error.
		 */

		return TCL_ERROR;
................................................................................
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	int pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; last--) {
................................................................................
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    int len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = TclGetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':
................................................................................
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = TclGetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */
................................................................................
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    int len;
	    const char *oldStr = TclGetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {
................................................................................
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = TclGetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
................................................................................
	 * approach).
	 */

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) TclGetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
................................................................................
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		int len;
		const char *joined = TclGetStringFromObj(joinedPtr,&len);

		if (strchr(separators, joined[len-1]) == NULL) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
................................................................................
	     * volume-relative path. In particular globbing in Windows shares,
	     * when not using -dir or -path, e.g. 'glob [file join
	     * //machine/share/subdir *]' requires adding a separator here.
	     * This behaviour is not currently tested for in the test suite.
	     */

	    int len;
	    const char *joined = TclGetStringFromObj(joinedPtr,&len);

	    if (strchr(separators, joined[len-1]) == NULL) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Prototypes for the one word hash key methods. Not actually declared because
 * this is a critical path that is implemented in the core hash table access
 * function.
 */

................................................................................
/*
 * Prototypes for the string hash key methods.
 */

static Tcl_HashEntry *	AllocStringEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Function prototypes for static functions in this file:
 */

static Tcl_HashEntry *	BogusFind(Tcl_HashTable *tablePtr, const char *key);
static Tcl_HashEntry *	BogusCreate(Tcl_HashTable *tablePtr, const char *key,
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned int
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const int *array = (const int *) keyPtr;
    register unsigned int result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
	result += *array;
    }
    return result;
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const char *string = keyPtr;
    register unsigned int result;
    register char c;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static TCL_HASH_TYPE	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Prototypes for the one word hash key methods. Not actually declared because
 * this is a critical path that is implemented in the core hash table access
 * function.
 */

................................................................................
/*
 * Prototypes for the string hash key methods.
 */

static Tcl_HashEntry *	AllocStringEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static TCL_HASH_TYPE	HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Function prototypes for static functions in this file:
 */

static Tcl_HashEntry *	BogusFind(Tcl_HashTable *tablePtr, const char *key);
static Tcl_HashEntry *	BogusCreate(Tcl_HashTable *tablePtr, const char *key,
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const int *array = (const int *) keyPtr;
    register TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
	result += *array;
    }
    return result;
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    register const char *string = keyPtr;
    register TCL_HASH_TYPE result;
    register char c;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the

 */

#define HaveOpt(minLength, nameString) \
	((len > (minLength)) && (optionName[1] == (nameString)[1]) \
		&& (strncmp(optionName, (nameString), len) == 0))

/*
 * The ChannelObjType type.  We actually store the ChannelState structure
 * as that lives longest and we want to return the bottomChanPtr when
 * requested (consistent with Tcl_GetChannel).  The setFromAny and
 * updateString can be NULL as they should not be called.
 */









static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static int		SetChannelFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		FreeChannelIntRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelIntRep,		/* freeIntRepProc */
    DupChannelIntRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc SetChannelFromAny */
};

#define GET_CHANNELSTATE(objPtr) \
    ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_CHANNELSTATE(objPtr, storePtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
#define GET_CHANNELINTERP(objPtr) \
    ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
#define SET_CHANNELINTERP(objPtr, storePtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))

#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
 
/*
................................................................................
	 * Cannot call Tcl_UnregisterChannel because that procedure calls
	 * Tcl_GetAssocData to get the channel table, which might already be
	 * inaccessible from the interpreter structure. Instead, we emulate
	 * the behavior of Tcl_UnregisterChannel directly here.
	 */

	Tcl_DeleteHashEntry(hPtr);
	SetFlag(statePtr, CHANNEL_TAINTED);
	if (statePtr->refCount-- <= 1) {
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
................................................................................
	if (hPtr == NULL) {
	    return TCL_ERROR;
	}
	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
	SetFlag(statePtr, CHANNEL_TAINTED);

	/*
	 * Remove channel handlers that refer to this interpreter, so that
	 * they will not be present if the actual close is delayed and more
	 * events happen on the channel. This may occur if the channel is
	 * shared between several interpreters, or if the channel has async
	 * flushing active.
................................................................................
    int *modePtr,		/* Where to store the mode in which the
				 * channel was opened? Will contain an ORed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    int flags)
{
    ChannelState *statePtr;



    if (SetChannelFromAny(interp, objPtr) != TCL_OK) {

	return TCL_ERROR;
    }

    statePtr = GET_CHANNELSTATE(objPtr);












































    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;

    if (modePtr != NULL) {
	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
    }

    return TCL_OK;
................................................................................

    /*
     * TIP #219, Tcl Channel Reflection API
     */

    statePtr->chanMsg		= NULL;
    statePtr->unreportedMsg	= NULL;



    /*
     * Link the channel into the list of all channels; create an on-exit
     * handler if there is not one already, to close off all the channels in
     * the list on exit.
     *
     * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
................................................................................
static void
DupChannelIntRep(
    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
				 * an internal rep of type "Channel". */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    ChannelState *statePtr  = GET_CHANNELSTATE(srcPtr);

    SET_CHANNELSTATE(copyPtr, statePtr);
    SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
    Tcl_Preserve(statePtr);
    copyPtr->typePtr = srcPtr->typePtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetChannelFromAny --
 *
 *	Create an internal representation of type "Channel" for an object.
 *
 * Results:
 *	This operation always succeeds and returns TCL_OK.
 *
 * Side effects:
 *	Any old internal reputation for objPtr is freed and the internal
 *	representation is set to "Channel".
 *
 *----------------------------------------------------------------------
 */

static int
SetChannelFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    ChannelState *statePtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    if (objPtr->typePtr == &chanObjType) {
	/*
	 * TODO: TAINT Flag and dup'd channel values?
	 * The channel is valid until any call to DetachChannel occurs.
	 * Ensure consistency checks are done.
	 */

	statePtr = GET_CHANNELSTATE(objPtr);
	if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
	    ResetFlag(statePtr, CHANNEL_TAINTED);
	    Tcl_Release(statePtr);
	    objPtr->typePtr = NULL;
	} else if (interp != GET_CHANNELINTERP(objPtr)) {
	    Tcl_Release(statePtr);
	    objPtr->typePtr = NULL;
	}
    }
    if (objPtr->typePtr != &chanObjType) {
	Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);

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

	TclFreeIntRep(objPtr);
	statePtr = ((Channel *) chan)->state;
	Tcl_Preserve(statePtr);
	SET_CHANNELSTATE(objPtr, statePtr);
	SET_CHANNELINTERP(objPtr, interp);
	objPtr->typePtr = &chanObjType;
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * FreeChannelIntRep --
 *
 *	Release statePtr storage.
................................................................................
 *----------------------------------------------------------------------
 */

static void
FreeChannelIntRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Release(GET_CHANNELSTATE(objPtr));

    objPtr->typePtr = NULL;





}
 
#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */

 */

#define HaveOpt(minLength, nameString) \
	((len > (minLength)) && (optionName[1] == (nameString)[1]) \
		&& (strncmp(optionName, (nameString), len) == 0))

/*
 * The ChannelObjType type.  Used to store the result of looking up
 * a channel name in the context of an interp.  Saves the lookup
 * result and values needed to check its continued validity.

 */

typedef struct ResolvedChanName {
    ChannelState *statePtr;	/* The saved lookup result */
    Tcl_Interp *interp;		/* The interp in which the lookup was done. */
    int epoch;			/* The epoch of the channel when the lookup
				 * was done. Use to verify validity. */
    int refCount;		/* Share this struct among many Tcl_Obj. */
} ResolvedChanName;

static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);


static void		FreeChannelIntRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelIntRep,		/* freeIntRepProc */
    DupChannelIntRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};










#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
 
/*
................................................................................
	 * Cannot call Tcl_UnregisterChannel because that procedure calls
	 * Tcl_GetAssocData to get the channel table, which might already be
	 * inaccessible from the interpreter structure. Instead, we emulate
	 * the behavior of Tcl_UnregisterChannel directly here.
	 */

	Tcl_DeleteHashEntry(hPtr);
	statePtr->epoch++;
	if (statePtr->refCount-- <= 1) {
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
................................................................................
	if (hPtr == NULL) {
	    return TCL_ERROR;
	}
	if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
	    return TCL_ERROR;
	}
	Tcl_DeleteHashEntry(hPtr);
	statePtr->epoch++;

	/*
	 * Remove channel handlers that refer to this interpreter, so that
	 * they will not be present if the actual close is delayed and more
	 * events happen on the channel. This may occur if the channel is
	 * shared between several interpreters, or if the channel has async
	 * flushing active.
................................................................................
    int *modePtr,		/* Where to store the mode in which the
				 * channel was opened? Will contain an ORed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    int flags)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;


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


    if (objPtr->typePtr == &chanObjType) {
	/*
 	 * Confirm validity of saved lookup results.
 	 */

	resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
	statePtr = resPtr->statePtr;
	if ((resPtr->interp == interp)		/* Same interp context */
			/* No epoch change in channel since lookup */
		&& (resPtr->epoch == statePtr->epoch)) {

	    /* Have a valid saved lookup. Jump to end to return it. */
	    goto valid;
	}
    }

    chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);

    if (chan == NULL) {
	if (resPtr) {
	    FreeChannelIntRep(objPtr);
	}
	return TCL_ERROR;
    }

    if (resPtr && resPtr->refCount == 1) {
	/* Re-use the ResolvedCmdName struct */
	Tcl_Release((ClientData) resPtr->statePtr);

    } else {
	TclFreeIntRep(objPtr);

	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
	resPtr->refCount = 1;
	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
	objPtr->typePtr = &chanObjType;
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve((ClientData) statePtr);
    resPtr->interp = interp;
    resPtr->epoch = statePtr->epoch;

  valid:
    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;

    if (modePtr != NULL) {
	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
    }

    return TCL_OK;
................................................................................

    /*
     * TIP #219, Tcl Channel Reflection API
     */

    statePtr->chanMsg		= NULL;
    statePtr->unreportedMsg	= NULL;

    statePtr->epoch		= 0;

    /*
     * Link the channel into the list of all channels; create an on-exit
     * handler if there is not one already, to close off all the channels in
     * the list on exit.
     *
     * JH: Could call Tcl_SpliceChannel, but need to avoid NULL check.
................................................................................
static void
DupChannelIntRep(
    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
				 * an internal rep of type "Channel". */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    resPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;

    copyPtr->typePtr = srcPtr->typePtr;
}





























































 
/*
 *----------------------------------------------------------------------
 *
 * FreeChannelIntRep --
 *
 *	Release statePtr storage.
................................................................................
 *----------------------------------------------------------------------
 */

static void
FreeChannelIntRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

    objPtr->typePtr = NULL;
    if (--resPtr->refCount) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    ckfree(resPtr);
}
 
#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */

     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */


} ChannelState;

/*
 * Values for the flags field in Channel. Any ORed combination of the
 * following flags can be stored in the field. These flags record various
 * options and state bits about the channel. In addition to the flags below,
 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
................................................................................
					 * being used. */

#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_TAINTED		(1<<20)	/* Channel stack structure has changed.
					 * Used by Channel Tcl_Obj type to
					 * determine if we have to revalidate
					 * the channel. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on
					 * the channel is allowed. */

/*
 * The length of time to wait between synthetic timer events. Must be zero or
 * bad things tend to happen.

     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */
    int epoch;			/* Used to test validity of stored channelname
				 * lookup results. */
} ChannelState;

/*
 * Values for the flags field in Channel. Any ORed combination of the
 * following flags can be stored in the field. These flags record various
 * options and state bits about the channel. In addition to the flags below,
 * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set.
................................................................................
					 * being used. */

#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */




#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on
					 * the channel is allowed. */

/*
 * The length of time to wait between synthetic timer events. Must be zero or
 * bad things tend to happen.

     *   Check for non-optionals through the mask.
     *   Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
................................................................................
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"read\" method",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"write\" method",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
................................................................................
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %d element%s instead", listc,
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	int len;
	const char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }
................................................................................
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */

	    if (result != TCL_ERROR) {
		int cmdLen;
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
................................................................................
    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
    UnmarshallErrorResult(rcPtr->interp, resObj);

    resObj = Tcl_GetObjResult(rcPtr->interp);

    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
	    || (code >= 0))) {
	if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
	    code = -EAGAIN;
	} else {
	    code = 0;
	}
    }

    Tcl_RestoreInterpState(rcPtr->interp, sr);
................................................................................
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
................................................................................
 
static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
 

     *   Check for non-optionals through the mask.
     *   Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                TclGetString(cmdObj), TclGetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
................................................................................
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                TclGetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"read\" method",
                TclGetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" lacks a \"write\" method",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
                TclGetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
................................................................................
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %d element%s instead", listc,
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	int len;
	const char *str = TclGetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }
................................................................................
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */

	    if (result != TCL_ERROR) {
		int cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
................................................................................
    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
    UnmarshallErrorResult(rcPtr->interp, resObj);

    resObj = Tcl_GetObjResult(rcPtr->interp);

    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
	    || (code >= 0))) {
	if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
	    code = -EAGAIN;
	} else {
	    code = 0;
	}
    }

    Tcl_RestoreInterpState(rcPtr->interp, sr);
................................................................................
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
		const char *str = TclGetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
................................................................................
 
static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif
 

    }

    /*
     * First argument is a channel handle.
     */

    chanObj = objv[CHAN];
    parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
    if (parentChan == NULL) {
	return TCL_ERROR;
    }
    parentChan = Tcl_GetTopChannel(parentChan);

    /*
     * Second argument is command prefix, i.e. list of words, first word is
................................................................................
     * - List, of method names. Convert to mask. Check for non-optionals
     *   through the mask. Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames,
		sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "chan handler \"%s initialize\" returned %s",
		    Tcl_GetString(cmdObj),
		    Tcl_GetString(Tcl_GetObjResult(interp))));
	    Tcl_DecrRefCount(resObj);
	    goto error;
	}

	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the
................................................................................
    if (!HAS(methods, METH_WRITE)) {
	mode &= ~TCL_WRITABLE;
    }

    if (!mode) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" makes the channel inaccessible",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    /*
     * The mode and support for it is ok, now check the internal constraints.
     */

    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"drain\" but not \"read\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"flush\" but not \"write\"",
                Tcl_GetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
................................................................................

    /*
     * Register the transform in our our map for proper handling of deleted
     * interpreters and/or threads.
     */

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#ifdef TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
     */

................................................................................
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#ifdef TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }

    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
................................................................................
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		int cmdLen;
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);
................................................................................
	/*
	 * Remove the channel from the map before releasing the memory, to
	 * prevent future accesses (like by 'postevent') from finding and
	 * dereferencing a dangling pointer.
	 */

	rtmPtr = GetReflectedTransformMap(interp);
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * In a threaded interpreter we manage a per-thread map as well, to
	 * allow us to survive if the script level pulls the rug out under a
	 * channel by deleting the owning thread.
	 */

	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	FreeReflectedTransformArgs(rtPtr);
	break;

    case ForwardedInput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
................................................................................
 
static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif /* TCL_THREADS */
 
................................................................................
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    ckfree((char *) rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}
 
/*
 *----------------------------------------------------------------------
 *

    }

    /*
     * First argument is a channel handle.
     */

    chanObj = objv[CHAN];
    parentChan = Tcl_GetChannel(interp, TclGetString(chanObj), &mode);
    if (parentChan == NULL) {
	return TCL_ERROR;
    }
    parentChan = Tcl_GetTopChannel(parentChan);

    /*
     * Second argument is command prefix, i.e. list of words, first word is
................................................................................
     * - List, of method names. Convert to mask. Check for non-optionals
     *   through the mask. Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                TclGetString(cmdObj), TclGetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames,
		sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "chan handler \"%s initialize\" returned %s",
		    TclGetString(cmdObj),
		    Tcl_GetString(Tcl_GetObjResult(interp))));
	    Tcl_DecrRefCount(resObj);
	    goto error;
	}

	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the
................................................................................
    if (!HAS(methods, METH_WRITE)) {
	mode &= ~TCL_WRITABLE;
    }

    if (!mode) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" makes the channel inaccessible",
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * The mode and support for it is ok, now check the internal constraints.
     */

    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"drain\" but not \"read\"",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"flush\" but not \"write\"",
                TclGetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
................................................................................

    /*
     * Register the transform in our our map for proper handling of deleted
     * interpreters and/or threads.
     */

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#ifdef TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
     */

................................................................................
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#ifdef TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }

    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
................................................................................
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		int cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);
................................................................................
	/*
	 * Remove the channel from the map before releasing the memory, to
	 * prevent future accesses (like by 'postevent') from finding and
	 * dereferencing a dangling pointer.
	 */

	rtmPtr = GetReflectedTransformMap(interp);
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * In a threaded interpreter we manage a per-thread map as well, to
	 * allow us to survive if the script level pulls the rug out under a
	 * channel by deleting the owning thread.
	 */

	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	FreeReflectedTransformArgs(rtPtr);
	break;

    case ForwardedInput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
................................................................................
 
static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    int len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, ckalloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif /* TCL_THREADS */
 
................................................................................
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    ckfree(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}
 
/*
 *----------------------------------------------------------------------
 *

    size_t claims;
} ThreadSpecificData;

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

static int		EvalFileCallback(ClientData data[],
			    Tcl_Interp *interp, int result);
static FilesystemRecord*FsGetFirstFilesystem(void);
static void		FsThrExitProc(ClientData cd);
static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
................................................................................

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	int len1, len2;
	const char *str1, *str2;

	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * They are equal, but different objects. Update so they will be
	     * the same object in the future.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);
................................................................................
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();
    }
    return tsdPtr->filesystemList;
}
 
/*
 * The epoch can be changed both by filesystems being added or removed and by
 * env(HOME) changing.
 */

int
TclFSEpochOk(
    size_t filesystemEpoch)
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
................................................................................
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
................................................................................
	     * i.e. the representation which is relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = Tcl_GetStringFromObj(mElt, &mlen);
		path = Tcl_GetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}
................................................................................
	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);
    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280 Force the evaluator to open a frame for a sourced file.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
................................................................................
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information telling where the error occurred.
	 */

	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information telling where the error occurred.
	 */

	int length;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	const int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................
	     * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop
	     * bug when trying to normalize tsdPtr->cwdPathPtr.
	     */

	    int len1, len2;
	    const char *str1, *str2;

	    str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = Tcl_GetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * If the paths were equal, we can be more efficient and
		 * retain the old path object which will probably already be
		 * shared. In this case we can simply free the normalized path
		 * we just calculated.
		 */
................................................................................
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
				 * non-NULL, then set to the name of the
				 * drive, network-volume which contains the
				 * path, already with a refCount for the
				 * caller. */
{
    int pathLen;
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
................................................................................
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    int len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = Tcl_GetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, (size_t) len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
................................................................................

	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    int cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			(size_t) normLen) == 0)) {
		    /*
		     * The cwd is inside the directory, so we perform a 'cd
		     * [file dirname $path]'.
		     */

    size_t claims;
} ThreadSpecificData;

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

static Tcl_NRPostProc	EvalFileCallback;

static FilesystemRecord*FsGetFirstFilesystem(void);
static void		FsThrExitProc(ClientData cd);
static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);
................................................................................

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	int len1, len2;
	const char *str1, *str2;

	str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	    /*
	     * They are equal, but different objects. Update so they will be
	     * the same object in the future.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);
................................................................................
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();
    }
    return tsdPtr->filesystemList;
}
 
/*
 * The epoch can be changed by filesystems being added or removed, by changing
 * the "system encoding" and by env(HOME) changing.
 */

int
TclFSEpochOk(
    size_t filesystemEpoch)
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
................................................................................
    ClientData clientData)
{
    int len;
    const char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
................................................................................
	     * i.e. the representation which is relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = TclGetStringFromObj(mElt, &mlen);
		path = TclGetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}
................................................................................
	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);
    string = TclGetStringFromObj(objPtr, &length);

    /*
     * TIP #280 Force the evaluator to open a frame for a sourced file.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
................................................................................
    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information telling where the error occurred.
	 */

	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information telling where the error occurred.
	 */

	int length;
	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	const int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................
	     * 'Tcl_FSEqualPaths', and in addition avoid a nasty infinite loop
	     * bug when trying to normalize tsdPtr->cwdPathPtr.
	     */

	    int len1, len2;
	    const char *str1, *str2;

	    str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = TclGetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * If the paths were equal, we can be more efficient and
		 * retain the old path object which will probably already be
		 * shared. In this case we can simply free the normalized path
		 * we just calculated.
		 */
................................................................................
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
				 * non-NULL, then set to the name of the
				 * drive, network-volume which contains the
				 * path, already with a refCount for the
				 * caller. */
{
    int pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    Tcl_PathType type;

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
................................................................................
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    int len;
		    const char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, (size_t) len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
................................................................................

	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    int cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = TclGetStringFromObj(normPath, &normLen);
		cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			(size_t) normLen) == 0)) {
		    /*
		     * The cwd is inside the directory, so we perform a 'cd
		     * [file dirname $path]'.
		     */

	}

	tablePtr[t] = Tcl_GetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags, indexPtr);

    /*
     * The internal rep must be cleared since tablePtr will go away.
     */

    TclFreeIntRep(objPtr);
    ckfree(tablePtr);

    return result;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    if (offset < (int)sizeof(char *)) {
	offset = (int)sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (objPtr->typePtr == &indexType) {
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}
    }

................................................................................
  done:
    /*
     * Cache the found representation. Note that we want to avoid allocating a
     * new internal-rep if at all possible since that is potentially a slow
     * operation.
     */


    if (objPtr->typePtr == &indexType) {
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    } else {
	TclFreeIntRep(objPtr);
	indexRep = ckalloc(sizeof(IndexRep));
	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
	objPtr->typePtr = &indexType;
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;


    *indexPtr = index;
    return TCL_OK;

  error:
    if (interp != NULL) {
	/*
................................................................................
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = Tcl_GetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
................................................................................
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = Tcl_GetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||
................................................................................
    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = Tcl_GetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*

	}

	tablePtr[t] = Tcl_GetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
	    sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr);






    ckfree(tablePtr);

    return result;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    if (offset < (int)sizeof(char *)) {
	offset = (int)sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}
    }

................................................................................
  done:
    /*
     * Cache the found representation. Note that we want to avoid allocating a
     * new internal-rep if at all possible since that is potentially a slow
     * operation.
     */

    if (!(flags & INDEX_TEMP_TABLE)) {
	if (objPtr->typePtr == &indexType) {
	    indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	} else {
	    TclFreeIntRep(objPtr);
	    indexRep = ckalloc(sizeof(IndexRep));
	    objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
	    objPtr->typePtr = &indexType;
	}
	indexRep->tablePtr = (void *) tablePtr;
	indexRep->offset = offset;
	indexRep->index = index;
    }

    *indexPtr = index;
    return TCL_OK;

  error:
    if (interp != NULL) {
	/*
................................................................................
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = TclGetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
................................................................................
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = TclGetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||
................................................................................
    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = TclGetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*

declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    char *bytes, size_t length, int flags)
}
 
##############################################################################

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

................................................................................
	    Tcl_GlobTypeData *types)
}
declare 19 macosx {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

declare 29 {win unix} {
    int TclWinCPUID(unsigned int index, unsigned int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}


 
# Local Variables:
# mode: tcl
# End:

declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, size_t length, int flags)
}
 
##############################################################################

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

................................................................................
	    Tcl_GlobTypeData *types)
}
declare 19 macosx {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}

declare 29 {win unix} {
    int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}


 
# Local Variables:
# mode: tcl
# End:

				 * for variables that can only be handled at
				 * runtime. */
    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* Procedure handling variable name resolution
				 * at compile time. */
} Tcl_ResolverInfo;
















/*
 *----------------------------------------------------------------
 * Data structures related to namespaces.
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
................................................................................
 * TCL_TRACE_RENAME -		A rename trace is in progress. Further
 *				recursive renames will not be traced.
 * TCL_TRACE_DELETE -		A delete trace is in progress. Further
 *				recursive deletes will not be traced.
 * (these last two flags are defined in tcl.h)
 */

#define CMD_IS_DELETED		    0x1
#define CMD_TRACE_ACTIVE	    0x2
#define CMD_HAS_EXEC_TRACES	    0x4
#define CMD_COMPILES_EXPANDED	    0x8
#define CMD_REDEF_IN_PROGRESS	    0x10



/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */

................................................................................
	Tcl_Obj *fileName, Tcl_Obj *attrObjPtr);

typedef struct TclFileAttrProcs {
    TclGetFileAttrProc *getProc;/* The procedure for getting attrs. */
    TclSetFileAttrProc *setProc;/* The procedure for setting attrs. */
} TclFileAttrProcs;










/*
 * Opaque handle used in pipeline routines to encapsulate platform-dependent
 * state.
 */

typedef struct TclFile_ *TclFile;

................................................................................
 * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
 * the value, and the master is kept as a counted string, with epoch and mutex
 * control. Each ProcessGlobalValue struct should be a static variable in some
 * file.
 */

typedef struct ProcessGlobalValue {
    size_t epoch;		/* Epoch counter to detect changes in the
				 * master value. */
    size_t numBytes;		/* Length of the master string. */
    char *value;		/* The master string value. */
    Tcl_Encoding encoding;	/* system encoding when master string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the master string
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;


MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);

/* These two can be considered for the public api */
MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);
................................................................................
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE int	TclClearRootEnsemble(ClientData data[],
			    Tcl_Interp *interp, int result);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
................................................................................
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);







MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
................................................................................

/*
 * So tclObj.c and tclDictObj.c can share these implementations.
 */

MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
................................................................................
/*
 * Invalidate the string rep first so we can use the bytes value for our
 * pointer chain, and signal an obj deletion (as opposed to shimmering) with
 * 'length == -1'.
 *
 * Use do/while0 idiom for optimum correctness without compiler warnings.
 * http://c2.com/cgi/wiki?TrivialDoWhileLoop
 *
 * Decrement refCount AFTER checking it for 0 or 1 (<2), because
 * we cannot assume anymore that refCount is a signed type; In
 * Tcl8 it was but in Tcl9 it is subject to change.
 */

# define TclDecrRefCount(objPtr) \
    do { \
	Tcl_Obj *_objPtr = (objPtr); \
	if (_objPtr->refCount-- <= 1) { \
	    if (!_objPtr->typePtr || !_objPtr->typePtr->freeIntRepProc) { \
		TCL_DTRACE_OBJ_FREE(_objPtr); \
		if (_objPtr->bytes \
			&& (_objPtr->bytes != tclEmptyStringRep)) { \
		    ckfree((char *) _objPtr->bytes); \
		} \
		_objPtr->length = -1; \
		TclFreeObjStorage(_objPtr); \
		TclIncrObjsFreed(); \
	    } else { \
		TclFreeObj(_objPtr); \
	    } \
................................................................................
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree((char *) (objPtr))

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
................................................................................
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))

#define TclGetStringFromObj(objPtr, lenPtr) \
    ((objPtr)->bytes \
	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\
	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))

/*
................................................................................
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    if (objPtr->bytes != NULL) { \
	if (objPtr->bytes != tclEmptyStringRep) { \
	    ckfree((char *) objPtr->bytes); \
	} \
	objPtr->bytes = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
................................................................................
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    if ((cmdPtr)->refCount-- <= 1) { \
	ckfree((char *) (cmdPtr));\
    }

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to

				 * for variables that can only be handled at
				 * runtime. */
    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* Procedure handling variable name resolution
				 * at compile time. */
} Tcl_ResolverInfo;

/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
 * lookup is performed for upvar (or similar) purposes, with slightly
 * different rules:
 *    - Bug #696893 - variable is either proc-local or in the current
 *	namespace; never follow the second (global) resolution path
 *    - Bug #631741 - do not use special namespace or interp resolvers
 *
 * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
 * (Bug #835020)
 */

#define TCL_AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------
 * Data structures related to namespaces.
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
................................................................................
 * TCL_TRACE_RENAME -		A rename trace is in progress. Further
 *				recursive renames will not be traced.
 * TCL_TRACE_DELETE -		A delete trace is in progress. Further
 *				recursive deletes will not be traced.
 * (these last two flags are defined in tcl.h)
 */

#define CMD_IS_DELETED		    0x01
#define CMD_TRACE_ACTIVE	    0x02
#define CMD_HAS_EXEC_TRACES	    0x04
#define CMD_COMPILES_EXPANDED	    0x08
#define CMD_REDEF_IN_PROGRESS	    0x10
#define CMD_VIA_RESOLVER	    0x20


/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */

................................................................................
	Tcl_Obj *fileName, Tcl_Obj *attrObjPtr);

typedef struct TclFileAttrProcs {
    TclGetFileAttrProc *getProc;/* The procedure for getting attrs. */
    TclSetFileAttrProc *setProc;/* The procedure for setting attrs. */
} TclFileAttrProcs;

/*
 * Private flag value which controls Tcl_GetIndexFromObj*() routines
 * to instruct them not to cache lookups because the table will not
 * live long enough to make it worthwhile.  Must not clash with public
 * flag value TCL_EXACT.
 */

#define INDEX_TEMP_TABLE 2

/*
 * Opaque handle used in pipeline routines to encapsulate platform-dependent
 * state.
 */

typedef struct TclFile_ *TclFile;

................................................................................
 * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
 * the value, and the master is kept as a counted string, with epoch and mutex
 * control. Each ProcessGlobalValue struct should be a static variable in some
 * file.
 */

typedef struct ProcessGlobalValue {
    size_t epoch;			/* Epoch counter to detect changes in the
				 * master value. */
    size_t numBytes;		/* Length of the master string. */
    char *value;		/* The master string value. */
    Tcl_Encoding encoding;	/* system encoding when master string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the master string
................................................................................
MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;

MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);

/* These two can be considered for the public api */
MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);
................................................................................
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;

MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
................................................................................
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int start);
MODULE_SCOPE int	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    int last);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,
................................................................................

/*
 * So tclObj.c and tclDictObj.c can share these implementations.
 */

MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
................................................................................
/*
 * Invalidate the string rep first so we can use the bytes value for our
 * pointer chain, and signal an obj deletion (as opposed to shimmering) with
 * 'length == -1'.
 *
 * Use do/while0 idiom for optimum correctness without compiler warnings.
 * http://c2.com/cgi/wiki?TrivialDoWhileLoop




 */

# define TclDecrRefCount(objPtr) \
    do { \
	Tcl_Obj *_objPtr = (objPtr); \
	if (_objPtr->refCount-- <= 1) { \
	    if (!_objPtr->typePtr || !_objPtr->typePtr->freeIntRepProc) { \
		TCL_DTRACE_OBJ_FREE(_objPtr); \
		if (_objPtr->bytes \
			&& (_objPtr->bytes != tclEmptyStringRep)) { \
		    ckfree(_objPtr->bytes); \
		} \
		_objPtr->length = -1; \
		TclFreeObjStorage(_objPtr); \
		TclIncrObjsFreed(); \
	    } else { \
		TclFreeObj(_objPtr); \
	    } \
................................................................................
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
................................................................................
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))

#define TclGetStringFromObj(objPtr, lenPtr) \
    ((objPtr)->bytes \
	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\
	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))

/*
................................................................................
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    if ((objPtr)->bytes != NULL) { \
	if ((objPtr)->bytes != tclEmptyStringRep) { \
	    ckfree((objPtr)->bytes); \
	} \
	(objPtr)->bytes = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
................................................................................
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr) \
    if ((cmdPtr)->refCount-- <= 1) { \
	ckfree(cmdPtr);\
    }

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to

/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, char *bytes,
				size_t length, int flags);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
................................................................................
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, char *bytes, size_t length, int flags); /* 251 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif

/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, const char *bytes,
				size_t length, int flags);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
................................................................................
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif

/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
................................................................................
/* 26 */
TCLAPI void		TclWinSetInterfaces(int wide);
/* 27 */
TCLAPI void		TclWinFlushDirtyChannels(void);
/* 28 */
TCLAPI void		TclWinResetInterfaces(void);
/* 29 */
TCLAPI int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
................................................................................
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
................................................................................
    void (*reserved22)(void);
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*tclWinConvertError) (DWORD errCode); /* 0 */
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
................................................................................
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
................................................................................
    void (*reserved22)(void);
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus

/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int		TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
/* 0 */
................................................................................
/* 26 */
TCLAPI void		TclWinSetInterfaces(int wide);
/* 27 */
TCLAPI void		TclWinFlushDirtyChannels(void);
/* 28 */
TCLAPI void		TclWinResetInterfaces(void);
/* 29 */
TCLAPI int		TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
................................................................................
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
TCLAPI int		TclWinCPUID(int index, int *regs);
/* 30 */
TCLAPI int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
................................................................................
    void (*reserved22)(void);
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*tclWinConvertError) (DWORD errCode); /* 0 */
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*reserved3)(void);
................................................................................
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
................................................................................
    void (*reserved22)(void);
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus

	    return AliasDelete(interp, slaveInterp, objv[3]);
	}
	if (objc > 5) {
	    masterInterp = GetInterp(interp, objv[4]);
	    if (masterInterp == NULL) {
		return TCL_ERROR;
	    }
	    if (TclGetString(objv[5])[0] == '\0') {
		if (objc == 6) {
		    return AliasDelete(interp, slaveInterp, objv[3]);
		}
	    } else {
		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
			objv[5], objc - 6, objv + 6);
	    }
	}
	goto aliasArgs;
    }
    case OPT_ALIASES:
	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
................................................................................
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
................................................................................
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
................................................................................
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
................................................................................
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
................................................................................
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {

	    return AliasDelete(interp, slaveInterp, objv[3]);
	}
	if (objc > 5) {
	    masterInterp = GetInterp(interp, objv[4]);
	    if (masterInterp == NULL) {
		return TCL_ERROR;
	    }





	    return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
		    objv[5], objc - 6, objv + 6);

	}
	goto aliasArgs;
    }
    case OPT_ALIASES:
	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
................................................................................
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(scriptObj, &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
................................................................................
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
................................................................................
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
................................................................................
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
................................................................................
			    "BADVALUE", NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {

	    return (char *) "variable must have float value";
	}
	linkPtr->lastValue.f = (float)valueDouble;
	LinkedVar(float) = linkPtr->lastValue.f;
	break;

    case TCL_LINK_STRING:
	value = Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, (unsigned) valueLength);
	break;

	    return (char *) "variable must have float value";
	}
	linkPtr->lastValue.f = (float)valueDouble;
	LinkedVar(float) = linkPtr->lastValue.f;
	break;

    case TCL_LINK_STRING:
	value = TclGetStringFromObj(valueObj, &valueLength);
	valueLength++;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, (unsigned) valueLength);
	break;

	first = 0;
    }
    if (first >= numElems) {
	first = numElems;	/* So we'll insert after last element. */
    }
    if (count < 0) {
	count = 0;

    } else if (numElems < first+count || first+count < 0) {
	/*
	 * The 'first+count < 0' condition here guards agains integer
	 * overflow in determining 'first+count'.
	 */

	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));


	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */
    needGrow = numRequired > listRepPtr->maxElemCount;

    for (i = 0;  i < objc;  i++) {
................................................................................
	    int elemSize, literal;

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

	    /* TODO: replace panic with error on alloc failure? */

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





	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	}
	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */
    needGrow = numRequired > listRepPtr->maxElemCount;

    for (i = 0;  i < objc;  i++) {
................................................................................
	    int elemSize, literal;

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

	    /* TODO: replace panic with error on alloc failure? */

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

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,			/* Number of bytes in the string. */
    unsigned hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (unsigned) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
		&& (objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    /*
	     * A literal was found: return it
	     */

	    if (newPtr) {
		*newPtr = 0;
	    }
	    if (globalPtrPtr) {
		*globalPtrPtr = globalPtr;
	    }
	    if (flags & LITERAL_ON_HEAP) {
		ckfree(bytes);
	    }
	    globalPtr->refCount++;
	    return objPtr;
	}
    }
    if (!newPtr) {
	if (flags & LITERAL_ON_HEAP) {
	    ckfree(bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter. Add it to the global literal
     * table.
     */

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    if (flags & LITERAL_ON_HEAP) {
	objPtr->bytes = bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

















#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;

    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;

    /*
................................................................................
 *----------------------------------------------------------------------
 */

int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
................................................................................
    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if (flags & LITERAL_ON_HEAP) {
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
................................................................................
    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     */

    if (flags & LITERAL_CMD_NAME) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;
	} else {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	}
    } else {
	nsPtr = NULL;
    }

    /*
     * Is it in the interpreter's global literal table? If not, create it.
     */


    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
................................................................................
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = Tcl_GetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
................................................................................
				 * command literal. */
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (literalObjPtr->typePtr == &tclCmdNameType) {
	    TclFreeIntRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
................................................................................

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
		    localPtr->objPtr) == NULL) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" is not global",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }
    if (count != localTablePtr->numEntries) {
................................................................................

    count = 0;
    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");

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

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,			/* Number of bytes in the string. */
    TCL_HASH_TYPE hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    TCL_HASH_TYPE globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (TCL_HASH_TYPE) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
		&& ((size_t)objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    /*
	     * A literal was found: return it
	     */

	    if (newPtr) {
		*newPtr = 0;
	    }
	    if (globalPtrPtr) {
		*globalPtrPtr = globalPtr;
	    }
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree((char *)bytes);
	    }
	    globalPtr->refCount++;
	    return objPtr;
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    ckfree((char *)bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.

     */

    TclNewObj(objPtr);

    if ((flags & LITERAL_ON_HEAP)) {
	objPtr->bytes = (char *) bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

    /* Should the new literal be shared globally? */

    if ((flags & LITERAL_UNSHARED)) {
	/*
	 * No, do *not* add it the global literal table
	 * Make clear, that no global value is returned
	 */
	if (globalPtrPtr != NULL) {
	    *globalPtrPtr = NULL;
	}
	return objPtr;
    }

    /*
     * Yes, add it to the global literal table.
     */
#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;

    /*
................................................................................
 *----------------------------------------------------------------------
 */

int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
................................................................................
    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree((char *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
................................................................................
    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     */

    if ((flags & LITERAL_CMD_NAME)) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;
	} else {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	}
    } else {
	nsPtr = NULL;
    }

    /*
     * Is it in the interpreter's global literal table? If not, create it.
     */

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
................................................................................
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
................................................................................
				 * command literal. */
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (literalObjPtr->typePtr == &tclCmdNameType) {
	    TclFreeIntRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
................................................................................

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }







	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }
    if (count != localTablePtr->numEntries) {
................................................................................

    count = 0;
    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");

	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    Tcl_GetStringFromObj(is.commandPtr, &length);
	    Tcl_SetObjLength(is.commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
		    TCL_EVAL_GLOBAL);
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    Tcl_DecrRefCount(is.commandPtr);
	    is.commandPtr = Tcl_NewObj();
	    Tcl_IncrRefCount(is.commandPtr);
................................................................................
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		Tcl_GetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
................................................................................
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    Tcl_GetStringFromObj(commandPtr, &length);
    Tcl_SetObjLength(commandPtr, --length);

    /*
     * Disable the stdin channel handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might process
     * commands from stdin before the current command is finished. Among other
     * things, this will trash the text of the command being evaluated.
................................................................................
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	Tcl_GetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }

	    is.prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     */

	    TclGetStringFromObj(is.commandPtr, &length);
	    Tcl_SetObjLength(is.commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
		    TCL_EVAL_GLOBAL);
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    Tcl_DecrRefCount(is.commandPtr);
	    is.commandPtr = Tcl_NewObj();
	    Tcl_IncrRefCount(is.commandPtr);
................................................................................
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		}
	    } else if (is.tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		TclGetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
................................................................................
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    TclGetStringFromObj(commandPtr, &length);
    Tcl_SetObjLength(commandPtr, --length);

    /*
     * Disable the stdin channel handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might process
     * commands from stdin before the current command is finished. Among other
     * things, this will trash the text of the command being evaluated.
................................................................................
	    Tcl_WriteChars(chan, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }

Tcl_PopCallFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    register Interp *iPtr = (Interp *) interp;
    register CallFrame *framePtr = iPtr->framePtr;
    Namespace *nsPtr;

    /*
     * It's important to remove the call frame from the interpreter's stack of
     * call frames before deleting local variables, so that traces invoked by
     * the variable deletion don't see the partially-deleted frame.
     */

    if (framePtr->callerPtr) {
	iPtr->framePtr = framePtr->callerPtr;
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	ckfree(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
................................................................................
    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;








    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
}
 
/*
................................................................................
		result = resPtr->cmdResProc(interp, name,
			(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {

	    return cmd;

	} else if (result != TCL_CONTINUE) {
	    return NULL;
	}
    }

    /*
     * Find the namespace(s) that contain the command.
................................................................................
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    }

    if (cmdPtr != NULL) {

	return (Tcl_Command) cmdPtr;
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown command \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
................................................................................
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
		(!refNsPtr || ((interp == refNsPtr->interp) &&
		(refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
................................................................................
	/*
	 * Locate the other variable.
	 */

	savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
	if (otherPtr == NULL) {
	    return TCL_ERROR;
	}

	/*
	 * Create the new variable and link it to otherPtr.
................................................................................

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}

Tcl_PopCallFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    register Interp *iPtr = (Interp *) interp;
    register CallFrame *framePtr = iPtr->framePtr;
    Namespace *nsPtr;














    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	ckfree(framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
................................................................................
    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->callerPtr) {
	iPtr->framePtr = framePtr->callerPtr;
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
}
 
/*
................................................................................
		result = resPtr->cmdResProc(interp, name,
			(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    ((Command *)cmd)->flags |= CMD_VIA_RESOLVER;
	    return cmd;

	} else if (result != TCL_CONTINUE) {
	    return NULL;
	}
    }

    /*
     * Find the namespace(s) that contain the command.
................................................................................
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    }

    if (cmdPtr != NULL) {
	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
	return (Tcl_Command) cmdPtr;
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown command \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
................................................................................
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
		&& (!refNsPtr || (refNsPtr ==
		(Namespace *) TclGetCurrentNamespace(interp)))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
................................................................................
	/*
	 * Locate the other variable.
	 */

	savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
		(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
		"access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
	if (otherPtr == NULL) {
	    return TCL_ERROR;
	}

	/*
	 * Create the new variable and link it to otherPtr.
................................................................................

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}

			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
static void		DeletedHelpersNamespace(ClientData clientData);
static int		FinalizeAlloc(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeNext(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeObjectCall(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		InitFoundation(Tcl_Interp *interp);
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,

			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
static void		DeletedHelpersNamespace(ClientData clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;


static Tcl_NRPostProc	FinalizeObjectCall;

static int		InitFoundation(Tcl_Interp *interp);
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,

static void		AddSimpleClassChainToCallContext(Class *classPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		CmpStr(const void *ptr1, const void *ptr2);
static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static int		FinalizeMethodRefs(ClientData data[],
			    Tcl_Interp *interp, int result);
static void		FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
			    int flags, int reuseMask);
static int		ResetFilterFlags(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		SetFilterFlags(ClientData data[],
			    Tcl_Interp *interp, int result);
static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);

/*
 * Object type used to manage type caches attached to method names.
 */

static const Tcl_ObjType methodNameType = {
................................................................................

static inline void
StashCallChain(
    Tcl_Obj *objPtr,
    CallChain *callPtr)
{
    callPtr->refCount++;

    TclFreeIntRep(objPtr);
    objPtr->typePtr = &methodNameType;
    objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
}

void
TclOOStashContext(

static void		AddSimpleClassChainToCallContext(Class *classPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		CmpStr(const void *ptr1, const void *ptr2);
static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static Tcl_NRPostProc	FinalizeMethodRefs;

static void		FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
			    int flags, int reuseMask);
static Tcl_NRPostProc	ResetFilterFlags;

static Tcl_NRPostProc	SetFilterFlags;

static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);

/*
 * Object type used to manage type caches attached to method names.
 */

static const Tcl_ObjType methodNameType = {
................................................................................

static inline void
StashCallChain(
    Tcl_Obj *objPtr,
    CallChain *callPtr)
{
    callPtr->refCount++;
    TclGetString(objPtr);
    TclFreeIntRep(objPtr);
    objPtr->typePtr = &methodNameType;
    objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
}

void
TclOOStashContext(

	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
    if (soughtLen == 0) {
	goto noMatch;
    }
    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    while (hPtr != NULL) {
	const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

................................................................................
static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    int length;
    const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
    register Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.
     */
................................................................................
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    int length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    Tcl_GetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
................................................................................

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    Tcl_GetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
................................................................................
		}
	    }
	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		ckfree((char *) superclasses);
		return TCL_ERROR;
	    }
	}
    }

    /*
     * Install the list of superclasses into the class. Note that this also
................................................................................
     * subclass list.
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	}
	ckfree((char *) oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);
................................................................................
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
................................................................................
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->classPtr->variables.list);
	} else if (i) {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->classPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);
................................................................................
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
................................................................................
    }

    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->variables.list);
	} else if (i) {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);

	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = TclGetStringFromObj(objv[1], &soughtLen);
    if (soughtLen == 0) {
	goto noMatch;
    }
    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    while (hPtr != NULL) {
	const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

................................................................................
static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    int length;
    const char *nameStr, *string = TclGetStringFromObj(stringObj, &length);
    register Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.
     */
................................................................................
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    int length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = TclGetStringFromObj(realNameObj, &length);
    int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
................................................................................

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    TclGetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
................................................................................

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
................................................................................
		}
	    }
	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		ckfree(superclasses);
		return TCL_ERROR;
	    }
	}
    }

    /*
     * Install the list of superclasses into the class. Note that this also
................................................................................
     * subclass list.
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	}
	ckfree(oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);
................................................................................
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
................................................................................
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(oPtr->classPtr->variables.list);
	} else if (i) {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->classPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);
................................................................................
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
................................................................................
    }

    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(oPtr->variables.list);
	} else if (i) {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do {			\
	if ((ptr)->refCount-- <= 1) {		\
	    ckfree((char *) (ptr));		\
	}					\
    } while(0)

#endif /* TCL_OO_INTERNAL_H */
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)
#define DelRef(ptr) do {			\
	if ((ptr)->refCount-- <= 1) {		\
	    ckfree(ptr);			\
	}					\
    } while(0)

#endif /* TCL_OO_INTERNAL_H */
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

static Tcl_Obj **	InitEnsembleRewrite(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv, int toRewrite,
			    int rewriteLength, Tcl_Obj *const *rewriteObjs,
			    int *lengthPtr);
static int		InvokeProcedureMethod(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		FinalizePMCall(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		PushMethodCallFrame(Tcl_Interp *interp,
			    CallContext *contextPtr, ProcedureMethod *pmPtr,
			    int objc, Tcl_Obj *const *objv,
			    PMFrameData *fdPtr);
static void		DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
static void		DeleteProcedureMethod(ClientData clientData);
static int		CloneProcedureMethod(Tcl_Interp *interp,
................................................................................
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    int nameLen, objectNameLen;
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {

static Tcl_Obj **	InitEnsembleRewrite(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv, int toRewrite,
			    int rewriteLength, Tcl_Obj *const *rewriteObjs,
			    int *lengthPtr);
static int		InvokeProcedureMethod(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static Tcl_NRPostProc	FinalizeForwardCall;
static Tcl_NRPostProc	FinalizePMCall;


static int		PushMethodCallFrame(Tcl_Interp *interp,
			    CallContext *contextPtr, ProcedureMethod *pmPtr,
			    int objc, Tcl_Obj *const *objv,
			    PMFrameData *fdPtr);
static void		DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
static void		DeleteProcedureMethod(ClientData clientData);
static int		CloneProcedureMethod(Tcl_Interp *interp,
................................................................................
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    int nameLen, objectNameLen;
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    TclGetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {

     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    Tcl_GetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
................................................................................
    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	int length;
	const char *str = Tcl_GetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
................................................................................
    char *stringVal;

    UNPACK_BIGNUM(objPtr, bignumVal);
    status = mp_radix_size(&bignumVal, 10, &size);
    if (status != MP_OKAY) {
	Tcl_Panic("radix size failure in UpdateStringOfBignum");
    }
    if (size == 3) {
	/*
	 * mp_radix_size() returns 3 when more than INT_MAX bytes would be
	 * needed to hold the string rep (because mp_radix_size ignores
	 * integer overflow issues). When we know the string rep will be more
	 * than 3, we can conclude the string rep would overflow our string
	 * length limits.
	 *
	 * Note that so long as we enforce our bignums to the size that fits
	 * in a packed bignum, this branch will never be taken.
	 */

	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
    }
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

unsigned int
TclHashObjKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = keyPtr;
    int length;
    const char *string = TclGetStringFromObj(objPtr, &length);
    unsigned int result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
................................................................................
     * is not deleted.
     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
        register Command *cmdPtr = resPtr->cmdPtr;

        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                && !(cmdPtr->flags & CMD_IS_DELETED)
                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
            register Namespace *refNsPtr = (Namespace *)
                    TclGetCurrentNamespace(interp);

            if ((resPtr->refNsPtr == NULL)
                || ((refNsPtr == resPtr->refNsPtr)
................................................................................
 *	The object's old internal rep is freed. It's string rep is not
 *	changed. The refcount in the Command structure is incremented to keep
 *	it from being freed if the command is later deleted until
 *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */






















































void
TclSetCmdNameObj(
    Tcl_Interp *interp,		/* Points to interpreter containing command
				 * that should be cached in objPtr. */
    register Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
				 * CmdName object. */
    Command *cmdPtr)		/* Points to Command structure that the
				 * CmdName object should refer to. */
{
    Interp *iPtr = (Interp *) interp;
    register ResolvedCmdName *resPtr;
    register Namespace *currNsPtr;
    const char *name;

    if (objPtr->typePtr == &tclCmdNameType) {


	return;
    }

    cmdPtr->refCount++;
    resPtr = ckalloc(sizeof(ResolvedCmdName));
    resPtr->cmdPtr = cmdPtr;
    resPtr->cmdEpoch = cmdPtr->cmdEpoch;
    resPtr->refCount = 1;

    name = TclGetString(objPtr);
    if ((*name++ == ':') && (*name == ':')) {
	/*
	 * The name is fully qualified: set the referring namespace to
	 * NULL.
	 */

	resPtr->refNsPtr = NULL;
    } else {
	/*
	 * Get the current namespace.
	 */

	currNsPtr = iPtr->varFramePtr->nsPtr;

	resPtr->refNsPtr = currNsPtr;
	resPtr->refNsId = currNsPtr->nsId;
	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
    }

    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    objPtr->typePtr = &tclCmdNameType;

}
 
/*
 *----------------------------------------------------------------------
 *
 * FreeCmdNameInternalRep --
 *
................................................................................
static void
FreeCmdNameInternalRep(
    register Tcl_Obj *objPtr)	/* CmdName object with internal
				 * representation to free. */
{
    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;

    if (resPtr != NULL) {
	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
	 */

	if (resPtr->refCount-- == 1) {
	    /*
................................................................................
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    ckfree(resPtr);
	}
    }
    objPtr->typePtr = NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupCmdNameInternalRep --
................................................................................
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    if (resPtr != NULL) {
	resPtr->refCount++;
    }
    copyPtr->typePtr = &tclCmdNameType;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetCmdNameFromAny --
................................................................................
 */

static int
SetCmdNameFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name;
    register Command *cmdPtr;
    Namespace *currNsPtr;
    register ResolvedCmdName *resPtr;

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

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

    name = TclGetString(objPtr);
    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);

    /*
     * Free the old internalRep before setting the new one. Do this after
     * getting the string rep to allow the conversion code (in particular,
     * Tcl_GetStringFromObj) to use that old internalRep.
     */

    if (cmdPtr) {
	cmdPtr->refCount++;



	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
	if ((objPtr->typePtr == &tclCmdNameType)
		&& resPtr && (resPtr->refCount == 1)) {
	    /*
	     * Reuse the old ResolvedCmdName struct instead of freeing it

	     */

	    Command *oldCmdPtr = resPtr->cmdPtr;

	    if (--oldCmdPtr->refCount == 0) {
		TclCleanupCommandMacro(oldCmdPtr);
	    }
	} else {
	    TclFreeIntRep(objPtr);
	    resPtr = ckalloc(sizeof(ResolvedCmdName));
	    resPtr->refCount = 1;
	    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	    objPtr->typePtr = &tclCmdNameType;
	}
	resPtr->cmdPtr = cmdPtr;
	resPtr->cmdEpoch = cmdPtr->cmdEpoch;
	if ((*name++ == ':') && (*name == ':')) {
	    /*
	     * The name is fully qualified: set the referring namespace to
	     * NULL.
	     */

	    resPtr->refNsPtr = NULL;
	} else {
	    /*
	     * Get the current namespace.
	     */

	    currNsPtr = iPtr->varFramePtr->nsPtr;

	    resPtr->refNsPtr = currNsPtr;
	    resPtr->refNsId = currNsPtr->nsId;
	    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
	}
    } else {
	TclFreeIntRep(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclCmdNameType;
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_RepresentationCmd --

     */

    /*
     * First compute the range of the word within the script. (Is there a
     * better way which doesn't shimmer?)
     */

    TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
................................................................................
    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	int length;
	const char *str = TclGetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
................................................................................
    char *stringVal;

    UNPACK_BIGNUM(objPtr, bignumVal);
    status = mp_radix_size(&bignumVal, 10, &size);
    if (status != MP_OKAY) {
	Tcl_Panic("radix size failure in UpdateStringOfBignum");
    }
    if (size < 2) {
	/*
	 * mp_radix_size() returns < 2 when more than INT_MAX bytes would be
	 * needed to hold the string rep (because mp_radix_size ignores
	 * integer overflow issues).


	 *
	 * Note that so long as we enforce our bignums to the size that fits
	 * in a packed bignum, this branch will never be taken.
	 */

	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
    }
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_HASH_TYPE
TclHashObjKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = keyPtr;
    const char *string = TclGetString(objPtr);
    size_t length = objPtr->length;
    TCL_HASH_TYPE result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
................................................................................
     * is not deleted.
     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    if (objPtr->typePtr == &tclCmdNameType) {
        register Command *cmdPtr = resPtr->cmdPtr;

        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)

                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
            register Namespace *refNsPtr = (Namespace *)
                    TclGetCurrentNamespace(interp);

            if ((resPtr->refNsPtr == NULL)
                || ((refNsPtr == resPtr->refNsPtr)
................................................................................
 *	The object's old internal rep is freed. It's string rep is not
 *	changed. The refcount in the Command structure is incremented to keep
 *	it from being freed if the command is later deleted until
 *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */

static void
SetCmdNameObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Command *cmdPtr,
    ResolvedCmdName *resPtr)
{
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = ckalloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;

    /* NOTE: relying on NULL termination here. */
    if ((name[0] == ':') && (name[1] == ':')) {
	/*
	 * Fully qualified names always resolve to same thing. No need
	 * to record resolution context information.
	 */

	fillPtr->refNsPtr = NULL;
	fillPtr->refNsId = 0;		/* Will not be read */
	fillPtr->refNsCmdEpoch = 0;	/* Will not be read */
    } else {
	/*
	 * Record current state of current namespace as the resolution
	 * context of this command name lookup.
	 */
	Namespace *currNsPtr = iPtr->varFramePtr->nsPtr;

	fillPtr->refNsPtr = currNsPtr;
	fillPtr->refNsId = currNsPtr->nsId;
	fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
    }

    if (resPtr == NULL) {
	TclFreeIntRep(objPtr);

	objPtr->internalRep.twoPtrValue.ptr1 = fillPtr;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclCmdNameType;
    }
}

void
TclSetCmdNameObj(
    Tcl_Interp *interp,		/* Points to interpreter containing command
				 * that should be cached in objPtr. */
    register Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
				 * CmdName object. */
    Command *cmdPtr)		/* Points to Command structure that the
				 * CmdName object should refer to. */
{

    register ResolvedCmdName *resPtr;



    if (objPtr->typePtr == &tclCmdNameType) {
	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
	if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
	    return;
	}
    }






























    SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
}
 
/*
 *----------------------------------------------------------------------
 *
 * FreeCmdNameInternalRep --
 *
................................................................................
static void
FreeCmdNameInternalRep(
    register Tcl_Obj *objPtr)	/* CmdName object with internal
				 * representation to free. */
{
    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;


	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
	 */

	if (resPtr->refCount-- == 1) {
	    /*
................................................................................
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    ckfree(resPtr);
	}

    objPtr->typePtr = NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * DupCmdNameInternalRep --
................................................................................
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;

	resPtr->refCount++;

    copyPtr->typePtr = &tclCmdNameType;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetCmdNameFromAny --
................................................................................
 */

static int
SetCmdNameFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{

    const char *name;
    register Command *cmdPtr;

    register ResolvedCmdName *resPtr;

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

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

    name = TclGetString(objPtr);
    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);

    /*
     * Stop shimmering and caching nothing when we found nothing.  Just
     * report the failure to find the command as an error.

     */

    if (cmdPtr == NULL) {

	return TCL_ERROR;
    }

    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {

	/*
	 * Re-use existing ResolvedCmdName struct when possible.
	 * Cleanup the old fields that need it.
	 */

	Command *oldCmdPtr = resPtr->cmdPtr;

	if (--oldCmdPtr->refCount == 0) {
	    TclCleanupCommandMacro(oldCmdPtr);
	}
    } else {















	resPtr = NULL;




    }












    SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_RepresentationCmd --

		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		int numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
	case INST_PUSH4:
	    if (nextInst == INST_POP) {
................................................................................
		blank = size + 1;
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(currentInstPtr + 1));
		int numBytes;

		(void) Tcl_GetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:

		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		int numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
	case INST_PUSH4:
	    if (nextInst == INST_POP) {
................................................................................
		blank = size + 1;
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(currentInstPtr + 1));
		int numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:

		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			Tcl_GetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
				maxNumCL * sizeof(int));
		    }
................................................................................

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    int length;
    const char *script = Tcl_GetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

		    && (tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
				maxNumCL * sizeof(int));
		    }
................................................................................

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    int length;
    const char *script = TclGetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}
 
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

		int curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
................................................................................

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */
................................................................................
			    /*
			     * We need to follow this link which is relative
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    Tcl_GetStringFromObj(retVal, &curLen);

			    while (--curLen >= 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

................................................................................
			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    } else {
				retVal = linkObj;
			    }
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				int i;
................................................................................
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

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

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	int len;
	const char *path = Tcl_GetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
	    }
................................................................................
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		int numBytes;
		const char *rest =
			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element
................................................................................
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		int numBytes;
		const char *rest =
			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element
................................................................................
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		int length;

		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
		     * path we were given.
		     */
................................................................................
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    int length;
	    const char *fileName, *extension;

	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			(int) (length - strlen(extension)));
................................................................................
	/*
	 * This is a special case where we can be much more efficient, where
	 * we are joining a single relative path onto an object that is
	 * already of path type. The 'TclNewFSPathObj' call below creates an
	 * object which can be normalized more efficiently. Currently we only
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.



	 */

	if ((i == (elements-2)) && (i == 0)
		&& (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {

	    Tcl_Obj *tailObj = objv[i+1];

	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

................................................................................
			    TclDecrRefCount(res);
			}
			return tailObj;
		    }
		}
	    }
	}
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
	     */

	    if (res != NULL) {
................................................................................
	 * The path element was not of a suitable form to be returned as is.
	 * We need to perform a more complex operation here.
	 */

    noQuickReturn:
	if (res == NULL) {
	    res = Tcl_NewObj();
	    ptr = Tcl_GetStringFromObj(res, &length);
	} else {
	    ptr = Tcl_GetStringFromObj(res, &length);
	}

	/*
	 * Strip off any './' before a tilde, unless this is the beginning of
	 * the path.
	 */

................................................................................
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		Tcl_GetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
................................................................................
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * intrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     */
    bytes = Tcl_GetStringFromObj(tail, &numBytes);
    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}
................................................................................
     * better test than the '!= sep' might be to simply check if 'cwd' is a
     * root volume.
     *
     * Note that if we get this wrong, we will strip off either too much or
     * too little below, leading to wrong answers returned by glob.
     */

    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

................................................................................
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = Tcl_GetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);

	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

................................................................................
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}

	Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) Tcl_GetStringFromObj(dir, &cwdLen);
	cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
................................................................................
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	    /*
	     * Normalize the combined string, but only starting after the end
	     * of the previously normalized 'dir'. This should be much faster!
	     */

................................................................................
     * We remove any trailing directory separator.
     *
     * However, the split/join routines are quite complex, and one has to make
     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
     * cmdAH.test exercise most of the code).
     */

    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	Tcl_DString temp;
................................................................................

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);

    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    copy->bytes = tclEmptyStringRep;
    copy->length = 0;
    TclDecrRefCount(copy);
}
 
/*
................................................................................
	 * It is somewhat unusual to reach this code path without the object
	 * being of tclFsPathType. However, we do our best to deal with the
	 * situation.
	 */

	int len;

	(void) Tcl_GetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}

		int curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
................................................................................

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		TclGetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */
................................................................................
			    /*
			     * We need to follow this link which is relative
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);

			    while (--curLen >= 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

................................................................................
			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    } else {
				retVal = linkObj;
			    }
			    linkStr = TclGetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				int i;
................................................................................
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     */

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

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	int len;
	const char *path = TclGetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
	    }
................................................................................
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element
................................................................................
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		int numBytes;
		const char *rest =
			TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element
................................................................................
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		int length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
		     * path we were given.
		     */
................................................................................
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    int length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			(int) (length - strlen(extension)));
................................................................................
	/*
	 * This is a special case where we can be much more efficient, where
	 * we are joining a single relative path onto an object that is
	 * already of path type. The 'TclNewFSPathObj' call below creates an
	 * object which can be normalized more efficiently. Currently we only
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.
         *
         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
         * to be an absolute path. Added a check for that elt is absolute.
	 */

	if ((i == (elements-2)) && (i == 0)
                && (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[i+1];

	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		int len;

		str = TclGetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

................................................................................
			    TclDecrRefCount(res);
			}
			return tailObj;
		    }
		}
	    }
	}
	strElt = TclGetStringFromObj(elt, &strEltLen);
	type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
	     */

	    if (res != NULL) {
................................................................................
	 * The path element was not of a suitable form to be returned as is.
	 * We need to perform a more complex operation here.
	 */

    noQuickReturn:
	if (res == NULL) {
	    res = Tcl_NewObj();
	    ptr = TclGetStringFromObj(res, &length);
	} else {
	    ptr = TclGetStringFromObj(res, &length);
	}

	/*
	 * Strip off any './' before a tilde, unless this is the beginning of
	 * the path.
	 */

................................................................................
		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		TclGetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
................................................................................
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * intrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     */
    bytes = TclGetStringFromObj(tail, &numBytes);
    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}
................................................................................
     * better test than the '!= sep' might be to simply check if 'cwd' is a
     * root volume.
     *
     * Note that if we get this wrong, we will strip off either too much or
     * too little below, leading to wrong answers returned by glob.
     */

    tempStr = TclGetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

................................................................................
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = TclGetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}
 
/*
 *---------------------------------------------------------------------------
 *
................................................................................
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);

	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

................................................................................
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	if (pathPtr->bytes == NULL) {
	    UpdateStringOfFsPath(pathPtr);
	}

	TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);
	cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
................................................................................
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    int cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	    /*
	     * Normalize the combined string, but only starting after the end
	     * of the previously normalized 'dir'. This should be much faster!
	     */

................................................................................
     * We remove any trailing directory separator.
     *
     * However, the split/join routines are quite complex, and one has to make
     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
     * cmdAH.test exercise most of the code).
     */

    name = TclGetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	Tcl_DString temp;
................................................................................

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);

    pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    copy->bytes = tclEmptyStringRep;
    copy->length = 0;
    TclDecrRefCount(copy);
}
 
/*
................................................................................
	 * It is somewhat unusual to reach this code path without the object
	 * being of tclFsPathType. However, we do our best to deal with the
	 * situation.
	 */

	int len;

	(void) TclGetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}

		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = Tcl_GetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		ckfree(argv3i);
		return TCL_ERROR;
................................................................................
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
		availPtr->nextPtr = prevPtr->nextPtr;
		prevPtr->nextPtr = availPtr;
	    }
	}
	argv4 = Tcl_GetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, (unsigned) length + 1);
	break;
    }
    case PKG_NAMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
................................................................................
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		ckfree(iPtr->packageUnknown);
	    }
	    argv2 = Tcl_GetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
	    }
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");
................................................................................
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i, length;

    for (i = 0; i < reqc; i++) {
	const char *v = Tcl_GetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
	} else {
	    Tcl_AppendPrintfToObj(result, " %s", v);
	}

		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		ckfree(argv3i);
		return TCL_ERROR;
................................................................................
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
		availPtr->nextPtr = prevPtr->nextPtr;
		prevPtr->nextPtr = availPtr;
	    }
	}
	argv4 = TclGetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, (unsigned) length + 1);
	break;
    }
    case PKG_NAMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
................................................................................
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		ckfree(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
	    }
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");
................................................................................
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i, length;

    for (i = 0; i < reqc; i++) {
	const char *v = TclGetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
	} else {
	    Tcl_AppendPrintfToObj(result, " %s", v);
	}

	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */
................................................................................
MakeProcError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
................................................................................
     */

    lambdaPtr = objv[1];
    if (lambdaPtr->typePtr == &tclLambdaType) {
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }

#define JOE_EXTENSION 0
/*
 * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT
 * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt
 * the code. (MS)
 */

#if JOE_EXTENSION
    else {
	/*
	 * Joe English's suggestion to allow cmdNames to function as lambdas.
	 */

	Tcl_Obj *elemPtr;
	int numElem;

	if ((lambdaPtr->typePtr == &tclCmdNameType) ||
		(TclListObjGetElements(interp, lambdaPtr, &numElem,
		&elemPtr) == TCL_OK && numElem == 1)) {
	    return Tcl_EvalObjv(interp, objc-1, objv+1, 0);
	}
    }
#endif

    if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
	result = SetLambdaFromAny(interp, lambdaPtr);
	if (result != TCL_OK) {
	    return result;
	}
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }
................................................................................
MakeLambdaError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetStringFromObj(objv[3], &numBytes);
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */
................................................................................
MakeProcError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
................................................................................
     */

    lambdaPtr = objv[1];
    if (lambdaPtr->typePtr == &tclLambdaType) {
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }

























    if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
	result = SetLambdaFromAny(interp, lambdaPtr);
	if (result != TCL_OK) {
	    return result;
	}
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }
................................................................................
MakeLambdaError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    int overflow, limit = 60, nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    int length;
    const char *bytes;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes+length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
}
 

    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    int length;
    const char *bytes;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = TclGetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes+length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
}
 

 *
 *	- TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
 *		strings that denote floating point values (or accept only the
 *		leading portion of them that are integer values).
 *	- TCL_PARSE_SCAN_PREFIXES:	ignore the prefixes 0b and 0o that are
 *		not part of the [scan] command's vocabulary. Use only in
 *		combination with TCL_PARSE_INTEGER_ONLY.



 *	- TCL_PARSE_OCTAL_ONLY:		parse only in the octal format, whether
 *		or not a prefix is present that would lead to octal parsing.
 *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_HEXADECIMAL_ONLY:	parse only in the hexadecimal format,
 *		whether or not a prefix is present that would lead to
 *		hexadecimal parsing. Use only in combination with
 *		TCL_PARSE_INTEGER_ONLY.
................................................................................
	     * OCTAL state differ only in whether they recognize 'X' and 'b'.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == 'x' || c == 'X') {



		state = ZERO_X;
		break;
	    }
	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
		goto zerox;
	    }
	    if (flags & TCL_PARSE_SCAN_PREFIXES) {
		goto zeroo;
	    }
	    if (c == 'b' || c == 'B') {



		state = ZERO_B;
		break;
	    }
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {

 *
 *	- TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
 *		strings that denote floating point values (or accept only the
 *		leading portion of them that are integer values).
 *	- TCL_PARSE_SCAN_PREFIXES:	ignore the prefixes 0b and 0o that are
 *		not part of the [scan] command's vocabulary. Use only in
 *		combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_BINARY_ONLY:	parse only in the binary format, whether
 *		or not a prefix is present that would lead to binary parsing.
 *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_OCTAL_ONLY:		parse only in the octal format, whether
 *		or not a prefix is present that would lead to octal parsing.
 *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_HEXADECIMAL_ONLY:	parse only in the hexadecimal format,
 *		whether or not a prefix is present that would lead to
 *		hexadecimal parsing. Use only in combination with
 *		TCL_PARSE_INTEGER_ONLY.
................................................................................
	     * OCTAL state differ only in whether they recognize 'X' and 'b'.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == 'x' || c == 'X') {
		if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY)) {
		    goto endgame;
		}
		state = ZERO_X;
		break;
	    }
	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
		goto zerox;
	    }
	    if (flags & TCL_PARSE_SCAN_PREFIXES) {
		goto zeroo;
	    }
	    if (c == 'b' || c == 'B') {
		if (flags & TCL_PARSE_OCTAL_ONLY) {
		    goto endgame;
		}
		state = ZERO_B;
		break;
	    }
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {

size_t
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    size_t numChars;










    /*
     * Optimize the case where we're really dealing with a bytearray object
     * without string representation; we don't need to convert to a string to
     * perform the get-length operation.
     */

................................................................................
	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);
................................................................................
	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {
................................................................................
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The string rep of appendObjPtr is appended to the string
 *	representation of objPtr.


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

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
................................................................................
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
................................................................................
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	Tcl_GetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
................................................................................
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}














































































































































































































































































































































































































































/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 *
 *	Implements the [string reverse] operation.
 *
................................................................................
	TclFreeIntRep(objPtr);

	/*
	 * Create a basic String intrep that just points to the UTF-8 string
	 * already in place at objPtr->bytes.
	 */

	stringPtr->numChars = -1;
	stringPtr->allocated = objPtr->length;
	stringPtr->maxChars = 0;
	stringPtr->hasUnicode = 0;
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;
................................................................................

static void
UpdateStringOfString(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    String *stringPtr = GET_STRING(objPtr);











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

size_t
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    size_t numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * without string representation; we don't need to convert to a string to
     * perform the get-length operation.
     */

................................................................................
	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	stringCheckLimits(length);
................................................................................
	objPtr->length = length;
	objPtr->bytes[length] = 0;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = (size_t)-1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > STRING_MAXCHARS) {
................................................................................
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The string rep of appendObjPtr is appended to the string
 *	representation of objPtr.
 *	IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr.
 *	Callers are counting on that.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
................................................................................
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars != (size_t)-1) {
	stringPtr->numChars = numChars + appendNumChars;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = (size_t)-1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
................................................................................
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	TclGetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
................................................................................
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringCatObjv --
 *
 *	Performs the [string cat] function.
 *
 * Results:
 * 	A standard Tcl result.
 *
 * Side effects:
 * 	Writes to *objPtrPtr the address of Tcl_Obj that is concatenation
 * 	of all objc values in objv.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringCatObjv(
    Tcl_Interp *interp,
    int inPlace,
    int objc,
    Tcl_Obj * const objv[],
    Tcl_Obj **objPtrPtr)
{
    Tcl_Obj *objPtr, *objResultPtr, * const *ov;
    int oc, length = 0, binary = 1, first = 0;
    int allowUniChar = 1, requestUniChar = 0;

    /* assert (objc >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    ov = objv, oc = objc;
    while (oc-- && (binary || allowUniChar)) {
	objPtr = *ov++;

	if (objPtr->bytes) {
	    /* Value has a string rep. */
	    if (objPtr->length) {
		/*
		 * Non-empty string rep. Not a pure bytearray, so we
		 * won't create a pure bytearray
		 */
	 	binary = 0;
		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    if (TclIsPureByteArray(objPtr)) {
		allowUniChar = 0;
	    } else {
		binary = 0;
		if (objPtr->typePtr == &tclStringType) {
		    /* Have a pure Unicode value; ask to preserve it */
		    requestUniChar = 1;
		} else {
		    /* Have another type; prevent shimmer */
		    allowUniChar = 0;
		}
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	ov = objv; oc = objc;
	while (oc-- && (length >= 0)) {
	    objPtr = *ov++;

	    if (objPtr->bytes == NULL) {
		int numBytes;

		Tcl_GetByteArrayFromObj(objPtr, &numBytes);
		if (length == 0) {
		    first = objc - oc - 1;
		}
		length += numBytes;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	ov = objv; oc = objc;
	while (oc-- && (length >= 0)) {
	    objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int numChars;

		Tcl_GetUnicodeFromObj(objPtr, &numChars);
		if (length == 0) {
		    first = objc - oc - 1;
		}
		length += numChars;
	    }
	}
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	ov = objv; oc = objc;
	while (oc-- && (length >= 0)) {
	    int numBytes;

	    objPtr = *ov++;

	    Tcl_GetStringFromObj(objPtr, &numBytes);
	    if ((length == 0) && numBytes) {
		first = objc - oc - 1;
	    }
	    length += numBytes;
	}
    }

    if (length < 0) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return TCL_ERROR;
    }

    if (length == 0) {
	/* Total length of zero means every value has length zero */
	*objPtrPtr = objv[0];
	return TCL_OK;
    }

    objv += first; objc -= first;

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;
	    Tcl_GetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if (objPtr->bytes == NULL) {
		int more;
		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    Tcl_GetStringFromObj(objResultPtr, &start);
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetString(objResultPtr) + start;
	    if (length > start) {
		TclFreeIntRep(objResultPtr);
	    }
	} else {
	    objResultPtr = Tcl_NewObj();
	    Tcl_SetObjLength(objResultPtr, length);
	    dst = Tcl_GetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		char *src = Tcl_GetStringFromObj(objPtr, &more);
		memcpy(dst, src, (size_t) more);
		dst += more;
	    }
	}
    }
    *objPtrPtr = objResultPtr;
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringFind --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringFind(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 */
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	bh = Tcl_GetByteArrayFromObj(haystack, &lh);
	end = bh + lh;

	try = bh + start;
	while (try + ln <= end) {
	    try = memchr(try, bn[0], end - try);

	    if (try == NULL) {
		return -1;
	    }
	    if (0 == memcmp(try+1, bn+1, ln-1)) {
		return (try - bh);
	    }
	    try++;
	}
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (haystack->bytes && (lh == haystack->length)) {
	/* haystack is all single-byte chars */

	if (needle->bytes && (ln == needle->length)) {
	    /* needle is also all single-byte chars */
	    char *found = strstr(haystack->bytes + start, needle->bytes);

	    if (found) {
		return (found - haystack->bytes);
	    } else {
		return -1;
	    }
	} else {
	    /*
	     * Cannot find substring with a multi-byte char inside
	     * a string with no multi-byte chars.
	     */
	    return -1;
	}
    } else {
	Tcl_UniChar *try, *end, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);
	end = uh + lh;

	try = uh + start;
	while (try + ln <= end) {
	    if ((*try == *un)
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
	    try++;
	}
	return -1;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *
 *	Implements the [string last] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	last instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int last)
{
    int lh, ln = Tcl_GetCharLength(needle);

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return 0"
	 */
	return -1;
    }

    if (ln > last + 1) {
	return -1;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *try, *bh;
	unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);

	bh = Tcl_GetByteArrayFromObj(haystack, &lh);

	if (last + 1 > lh) {
	    last = lh - 1;
	}
	try = bh + last + 1 - ln;
	while (try >= bh) {
	    if ((*try == bn[0])
		    && (0 == memcmp(try+1, bn+1, ln-1))) {
		return (try - bh);
	    }
	    try--;
	}
	return -1;
    }

    lh = Tcl_GetCharLength(haystack);
    if (last + 1 > lh) {
	last = lh - 1;
    }
    if (haystack->bytes && (lh == haystack->length)) {
	/* haystack is all single-byte chars */

	if (needle->bytes && (ln == needle->length)) {
	    /* needle is also all single-byte chars */

	    char *try = haystack->bytes + last + 1 - ln;
	    while (try >= haystack->bytes) {
		if ((*try == needle->bytes[0])
			&& (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) {
		    return (try - haystack->bytes);
		}
		try--;
	    }
	    return -1;
	} else {
	    /*
	     * Cannot find substring with a multi-byte char inside
	     * a string with no multi-byte chars.
	     */
	    return -1;
	}
    } else {
	Tcl_UniChar *try, *uh;
	Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);

	uh = Tcl_GetUnicodeFromObj(haystack, &lh);

	try = uh + last + 1 - ln;
	while (try >= uh) {
	    if ((*try == un[0])
		    && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
		return (try - uh);
	    }
	    try--;
	}
	return -1;
    }
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 *
 *	Implements the [string reverse] operation.
 *
................................................................................
	TclFreeIntRep(objPtr);

	/*
	 * Create a basic String intrep that just points to the UTF-8 string
	 * already in place at objPtr->bytes.
	 */

	stringPtr->numChars = (size_t)-1;
	stringPtr->allocated = objPtr->length;
	stringPtr->maxChars = 0;
	stringPtr->hasUnicode = 0;
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;
................................................................................

static void
UpdateStringOfString(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    String *stringPtr = GET_STRING(objPtr);

    /*
     * This routine is only called when we need to generate the
     * string rep objPtr->bytes because it does not exist -- it is NULL.
     * In that circumstance, any lingering claim about the size of
     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */

    stringPtr->allocated = 0;

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

    TclBN_s_mp_sub, /* 60 */
    TclBN_mp_init_set_int, /* 61 */
    TclBN_mp_set_int, /* 62 */
    TclBN_mp_cnt_lsb, /* 63 */
    TclBNInitBignumFromLong, /* 64 */
    TclBNInitBignumFromWideInt, /* 65 */
    TclBNInitBignumFromWideUInt, /* 66 */

};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs,
    &tclOOStubs,

    TclBN_s_mp_sub, /* 60 */
    TclBN_mp_init_set_int, /* 61 */
    TclBN_mp_set_int, /* 62 */
    TclBN_mp_cnt_lsb, /* 63 */
    TclBNInitBignumFromLong, /* 64 */
    TclBNInitBignumFromWideInt, /* 65 */
    TclBNInitBignumFromWideUInt, /* 66 */
    TclBN_mp_expt_d_ex, /* 67 */
};

static const TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs,
    &tclOOStubs,

static int		TestNumUtfCharsCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestHashSystemHashCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static int              NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
                            int result);
static int		TestNREUnwind(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestNRELevels(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestInterpResolverCmd(ClientData clientData,
................................................................................
TestcpuidCmd(
    ClientData dummy,
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int status, index, i;
    unsigned int regs[4];
    Tcl_Obj *regsObjs[4];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "eax");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID((unsigned) index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewLongObj((int) regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
}
#endif
 
/*
................................................................................
    int flags,
    Tcl_Command *rPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *ns2NsPtr = (Namespace *)








            Tcl_FindNamespace(interp, "::ns2", NULL, 0);


    if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr
            || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) {




















        const char *callingCmdName =
                Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);

        if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0')

























                && (name[0] == 'z') && (name[1] == '\0')) {
            Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL,



                    TCL_GLOBAL_ONLY);




            if (sourceCmdPtr != NULL) {
                *rPtr = sourceCmdPtr;
                return TCL_OK;
            }
        }
    }
    return TCL_CONTINUE;
}

static int
InterpVarResolver(
    Tcl_Interp *interp,
................................................................................
{
    static const char *const table[] = {
        "down", "up", NULL
    };
    int idx;
#define RESOLVER_KEY "testInterpResolver"

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "up|down");
 	return TCL_ERROR;







    }
    if (Tcl_GetIndexFromObjStruct(interp, objv[1], table,
	    sizeof(char *), "operation", TCL_EXACT, &idx) != TCL_OK) {
        return TCL_ERROR;
    }
    switch (idx) {
    case 1: /* up */

static int		TestNumUtfCharsCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestHashSystemHashCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static Tcl_NRPostProc	NREUnwind_callback;

static int		TestNREUnwind(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestNRELevels(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestInterpResolverCmd(ClientData clientData,
................................................................................
TestcpuidCmd(
    ClientData dummy,
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int status, index, i;
    int regs[4];
    Tcl_Obj *regsObjs[4];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "eax");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewLongObj(regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
}
#endif
 
/*
................................................................................
    int flags,
    Tcl_Command *rPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *callerNsPtr = varFramePtr->nsPtr;
    Tcl_Command resolvedCmdPtr = NULL;

    /*
     * Just do something special on a cmd literal "z" in two cases:
     *  A)  when the caller is a proc "x", and the proc is either in "::" or in "::ns2".
     *  B) the caller's namespace is "ctx1" or "ctx2"
     */
    if ( (name[0] == 'z') && (name[1] == '\0') ) {
        Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0);

        if (procPtr != NULL
            && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr)
                || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr)
                )
            ) {
            /*
             * Case A)
             *
             *    - The context, in which this resolver becomes active, is
             *      determined by the name of the caller proc, which has to be
             *      named "x".
             *
             *    - To determine the name of the caller proc, the proc is taken
             *      from the topmost stack frame.
             *
             *    - Note that the context is NOT provided during byte-code
             *      compilation (e.g. in TclProcCompileProc)
             *
             *   When these conditions hold, this function resolves the
             *   passed-in cmd literal into a cmd "y", which is taken from the
             *   the global namespace (for simplicity).
             */

            const char *callingCmdName =
                Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);

            if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
            }
        } else if (callerNsPtr != NULL) {
            /*
             * Case B)
             *
             *    - The context, in which this resolver becomes active, is
             *      determined by the name of the parent namespace, which has
             *      to be named "ctx1" or "ctx2".
             *
             *    - To determine the name of the parent namesace, it is taken
             *      from the 2nd highest stack frame.
             *
             *    - Note that the context can be provided during byte-code
             *      compilation (e.g. in TclProcCompileProc)
             *
             *   When these conditions hold, this function resolves the
             *   passed-in cmd literal into a cmd "y" or "Y" depending on the
             *   context. The resolved procs are taken from the the global
             *   namespace (for simplicity).
             */

            CallFrame *parentFramePtr = varFramePtr->callerPtr;
            const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";

            if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
                /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/

            } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
                /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/
            }
        }

        if (resolvedCmdPtr != NULL) {
            *rPtr = resolvedCmdPtr;
            return TCL_OK;
        }

    }
    return TCL_CONTINUE;
}

static int
InterpVarResolver(
    Tcl_Interp *interp,
................................................................................
{
    static const char *const table[] = {
        "down", "up", NULL
    };
    int idx;
#define RESOLVER_KEY "testInterpResolver"

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));
	if (interp == NULL) {
	    Tcl_AppendResult(interp, "provided interpreter not found", NULL);
	    return TCL_ERROR;
	}
    }
    if (Tcl_GetIndexFromObjStruct(interp, objv[1], table,
	    sizeof(char *), "operation", TCL_EXACT, &idx) != TCL_OK) {
        return TCL_ERROR;
    }
    switch (idx) {
    case 1: /* up */

TestbignumobjCmd(
    ClientData clientData,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    const char *const subcmds[] = {
	"set",	    "get",	"mult10",	"div10", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET,	BIGNUM_MULT10,	BIGNUM_DIV10

    };
    int index, varIndex;
    const char *string;
    mp_int bignumValue, newValue;
    Tcl_Obj **varPtr;

    if (objc < 3) {
................................................................................
	}
	mp_clear(&bignumValue);
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
	}












































    }

    Tcl_SetObjResult(interp, varPtr[varIndex]);
    return TCL_OK;
}
 
/*
................................................................................

    argv = ckalloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    /*
     * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = objv[3]->internalRep.twoPtrValue.ptr1;
	if (indexRep->tablePtr == (void *) argv) {
	    TclFreeIntRep(objv[3]);
	}
    }

    result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3],
	    argv, sizeof(char *), "token", (allowAbbrev? 0 : TCL_EXACT), &index);

    ckfree(argv);
    if (result == TCL_OK) {
	Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}
 

TestbignumobjCmd(
    ClientData clientData,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    const char *const subcmds[] = {
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    };
    int index, varIndex;
    const char *string;
    mp_int bignumValue, newValue;
    Tcl_Obj **varPtr;

    if (objc < 3) {
................................................................................
	}
	mp_clear(&bignumValue);
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
	}
	break;

    case BIGNUM_ISEVEN:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], mp_iseven(&bignumValue));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
	}
	mp_clear(&bignumValue);
	break;

    case BIGNUM_RADIXSIZE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], index);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index));
	}
	mp_clear(&bignumValue);
	break;
    }

    Tcl_SetObjResult(interp, varPtr[varIndex]);
    return TCL_OK;
}
 
/*
................................................................................

    argv = ckalloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;
















    result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3],
	    argv, sizeof(char *), "token",
	    INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT), &index);
    ckfree(argv);
    if (result == TCL_OK) {
	Tcl_SetLongObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}
 

}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAllocThread --
 *
 *	This procedure is used to destroy single thread private resources used
 *	in this file.
 * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *

}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAllocThread --
 *
 *	This procedure is used to destroy single thread private resources
 *	defined in this file. Called either during Tcl_FinalizeThread() or
 *	Tcl_Finalize().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *

	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
	} else {
	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
	}
	command = Tcl_GetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, (unsigned) length)) {
		break;
	    }
	}
	if (afterPtr == NULL) {

	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
	} else {
	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
	}
	command = TclGetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, (unsigned) length)) {
		break;
	    }
	}
	if (afterPtr == NULL) {

declare 20 {
    int TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
    int TclBN_mp_init(mp_int *a)
}
declare 22 {
    int TclBN_mp_init_copy(mp_int *a, mp_int *b)
}
declare 23 {
    int TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
    int TclBN_mp_init_set(mp_int *a, mp_digit b)
}
................................................................................
declare 33 {
    int TclBN_mp_neg(const mp_int *a, mp_int *b)
}
declare 34 {
    int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
}
declare 35 {
    int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
}
declare 36 {
    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
................................................................................
}
declare 65 {
    void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
}
declare 66 {
    void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
}






# Local Variables:
# mode: tcl
# End:

declare 20 {
    int TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
    int TclBN_mp_init(mp_int *a)
}
declare 22 {
    int TclBN_mp_init_copy(mp_int *a, const mp_int *b)
}
declare 23 {
    int TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
    int TclBN_mp_init_set(mp_int *a, mp_digit b)
}
................................................................................
declare 33 {
    int TclBN_mp_neg(const mp_int *a, mp_int *b)
}
declare 34 {
    int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
}
declare 35 {
    int TclBN_mp_radix_size(const mp_int *a, int radix, int *size)
}
declare 36 {
    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
................................................................................
}
declare 65 {
    void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
}
declare 66 {
    void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
}

# Added in libtommath 1.0
declare 67 {
    int TclBN_mp_expt_d_ex(mp_int *a, mp_digit b, mp_int *c, int fast)
}

# Local Variables:
# mode: tcl
# End:

 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tom[email protected], http://math.libtomcrypt.com
 */
#ifndef BN_H_
#define BN_H_

#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
#endif



#ifndef MIN
#   define MIN(x,y) ((x)<(y)?(x):(y))
#endif

#ifndef MAX
#   define MAX(x,y) ((x)>(y)?(x):(y))
#endif

#ifdef __cplusplus
extern "C" {

/* C++ compilers don't like assigning void * to mp_digit * */
#define  OPT_CAST(x)  (x *)

#else

/* C on the other hand doesn't care */
#define  OPT_CAST(x)

#endif


/* detect 64-bit mode if possible */
#if defined(NEVER)  /* 128-bit ints fail in too many places */
#   if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))

#	define MP_64BIT
#   endif
#endif

/* some default configurations.
 *
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
   typedef unsigned char      mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef unsigned short     mp_word;




#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED
   typedef unsigned short     mp_digit;

#define MP_DIGIT_DECLARED
#endif
   typedef unsigned long      mp_word;





#elif defined(MP_64BIT)
   /* for GCC only on supported platforms */
#ifndef CRYPT
   typedef unsigned long long ulong64;
   typedef signed long long   long64;
#endif

#ifndef MP_DIGIT_DECLARED
   typedef unsigned long      mp_digit;
#define MP_DIGIT_DECLARED
#endif



   typedef unsigned long      mp_word __attribute__ ((mode(TI)));






#  define DIGIT_BIT          60
#else
   /* this is the default case, 28-bit digits */
   
   /* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
#  if defined(_MSC_VER) || defined(__BORLANDC__)
      typedef unsigned __int64   ulong64;
      typedef signed __int64     long64;
#  else
      typedef unsigned long long ulong64;
      typedef signed long long   long64;
#  endif
#endif

#ifndef MP_DIGIT_DECLARED
   typedef unsigned int      mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef ulong64            mp_word;

#ifdef MP_31BIT   
   /* this is an extension that uses 31-bit digits */
#  define DIGIT_BIT          31
#else
   /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
#  define DIGIT_BIT          28
#  define MP_28BIT
#endif   
#endif

/* define heap macros */
#if 0 /* these are macros in tclTomMathDecls.h */
#ifndef CRYPT
   /* default to libc stuff */
#  ifndef XMALLOC
#     define XMALLOC  malloc
#     define XFREE    free
#     define XREALLOC realloc
#     define XCALLOC  calloc
#  else
      /* prototypes for our heap functions */
      extern void *XMALLOC(size_t n);
      extern void *XREALLOC(void *p, size_t n);
      extern void *XCALLOC(size_t n, size_t s);
      extern void XFREE(void *p);
#  endif
#endif
#endif


/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
#   define DIGIT_BIT     ((int)((CHAR_BIT * sizeof(mp_digit) - 1)))  /* bits per digit */















#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

/* equalities */
................................................................................
#endif

/* define this to use lower memory usage routines (exptmods mostly) */
/* #define MP_LOW_MEM */

/* default precision */
#ifndef MP_PREC
#  ifndef MP_LOW_MEM
#     define MP_PREC                 32     /* default digits of precision */
#  else
#     define MP_PREC                 8      /* default digits of precision */
#  endif
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))

/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
#endif
struct mp_int {
................................................................................


#define USED(m)    ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m)    ((m)->sign)

/* error code to char* string */
/*
char *mp_error_to_string(int code);
*/

/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
int mp_init(mp_int *a);
*/

................................................................................
/* init to a given number of digits */
/*
int mp_init_size(mp_int *a, int size);
*/

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)


/* set to zero */
/*
void mp_zero(mp_int *a);
*/

/* set to a digit */
................................................................................
void mp_set(mp_int *a, mp_digit b);
*/

/* set a 32-bit const */
/*
int mp_set_int(mp_int *a, unsigned long b);
*/











/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);







/* initialize and set a digit */
/*
int mp_init_set (mp_int * a, mp_digit b);
*/

/* initialize and set 32-bit value */
................................................................................
/* copy, b = a */
/*
int mp_copy(const mp_int *a, mp_int *b);
*/

/* inits and copies, a = b */
/*
int mp_init_copy(mp_int *a, mp_int *b);
*/

/* trim unused digits */
/*
void mp_clamp(mp_int *a);
*/











/* ---> digit manipulation <--- */

/* right shift by "b" digits */
/*
void mp_rshd(mp_int *a, int b);
*/

/* left shift by "b" digits */
/*
int mp_lshd(mp_int *a, int b);
*/

/* c = a / 2**b */
/*
int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
*/

/* b = a/2 */
/*
int mp_div_2(mp_int *a, mp_int *b);
*/

/* c = a * 2**b */
/*
int mp_mul_2d(const mp_int *a, int b, mp_int *c);
*/

/* b = a*2 */
/*
int mp_mul_2(mp_int *a, mp_int *b);
*/

/* c = a mod 2**d */
/*
int mp_mod_2d(const mp_int *a, int b, mp_int *c);
*/

/* computes a = 2**b */
/*
int mp_2expt(mp_int *a, int b);
*/

/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(mp_int *a);
*/

/* I Love Earth! */

/* makes a pseudo-random int of a given size */
/*
int mp_rand(mp_int *a, int digits);
................................................................................
int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
*/

/* c = a**b */
/*
int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
*/




/* c = a mod b, 0 <= c < b  */
/*
int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
*/

/* ---> number theory <--- */
................................................................................
/* finds one of the b'th root of a, such that |c|**b <= |a|
 *
 * returns error if a < 0 and b is even
 */
/*
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
*/




/* special sqrt algo */
/*
int mp_sqrt(mp_int *arg, mp_int *ret);
*/






/* is number a square? */
/*
int mp_is_square(mp_int *arg, int *ret);
*/

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
................................................................................
#  define PRIME_SIZE      31
#else
#  define PRIME_SIZE      256
#endif

/* table of first PRIME_SIZE primes */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const mp_digit ltm_prime_tab[];
#endif

/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
/*
int mp_prime_is_divisible(mp_int *a, int *result);
*/

................................................................................
 * Sets result to 0 if composite or 1 if probable prime
 */
/*
int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
*/

/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96 
 */
/*
int mp_prime_rabin_miller_trials(int size);
*/

/* performs t rounds of Miller-Rabin on "a" using the first
 * t prime bases.  Also performs an initial sieve of trial
................................................................................
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
/*
int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/

/* makes a truly random prime of a given size (bytes),
 * call with bbs = 1 if you want it to be congruent to 3 mod 4 
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 * The prime generated will be larger than 2^(8*size).
 */
#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 * 
 *   LTM_PRIME_BBS      - make prime congruent to 3 mod 4
 *   LTM_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
 *   LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
 *   LTM_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */
................................................................................
/*
int mp_toradix(mp_int *a, char *str, int radix);
*/
/*
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
*/
/*
int mp_radix_size(mp_int *a, int radix, int *size);
*/


/*
int mp_fread(mp_int *a, int radix, FILE *stream);
*/
/*
int mp_fwrite(mp_int *a, int radix, FILE *stream);
*/


#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
#define mp_raw_size(mp)           mp_signed_bin_size(mp)
#define mp_toraw(mp, str)         mp_to_signed_bin((mp), (str))
#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
#define mp_mag_size(mp)           mp_unsigned_bin_size(mp)
#define mp_tomag(mp, str)         mp_to_unsigned_bin((mp), (str))

#define mp_tobinary(M, S)  mp_toradix((M), (S), 2)
#define mp_tooctal(M, S)   mp_toradix((M), (S), 8)
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
#define mp_tohex(M, S)     mp_toradix((M), (S), 16)

/* lowlevel functions, do not call! */
/*
int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
*/
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
/*
int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_karatsuba_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_toom_sqr(mp_int *a, mp_int *b);
*/
/*
int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
*/
/*
int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
*/
/*
int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
*/
/*
int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
*/
/*
void bn_reverse(unsigned char *s, int len);
*/

#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const char *mp_s_rmap;
#endif

#ifdef __cplusplus
}
#endif

#endif

 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tstdenis82@gmail.com, http://math.libtomcrypt.com
 */
#ifndef BN_H_
#define BN_H_

#include "tclTomMathDecls.h"
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
#endif











#ifdef __cplusplus
extern "C" {









#endif


/* detect 64-bit mode if possible */
#if defined(NEVER) /* 128-bit ints fail in too many places */

   #if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
      #define MP_64BIT
   #endif
#endif

/* some default configurations.
 *
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
   typedef uint8_t              mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef uint16_t             mp_word;
#define MP_SIZEOF_MP_DIGIT      1
#ifdef DIGIT_BIT
#error You must not define DIGIT_BIT when using MP_8BIT
#endif
#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED

   typedef uint16_t             mp_digit;
#define MP_DIGIT_DECLARED
#endif

   typedef uint32_t             mp_word;
#define MP_SIZEOF_MP_DIGIT      2
#ifdef DIGIT_BIT
#error You must not define DIGIT_BIT when using MP_16BIT
#endif
#elif defined(MP_64BIT)
   /* for GCC only on supported platforms */
#ifndef CRYPT
   typedef unsigned long long   ulong64;
   typedef signed long long     long64;
#endif

#ifndef MP_DIGIT_DECLARED
   typedef ulong64 mp_digit;
#define MP_DIGIT_DECLARED
#endif
#if defined(_WIN32)
   typedef unsigned __int128    mp_word;
#elif defined(__GNUC__)
   typedef unsigned long        mp_word __attribute__ ((mode(TI)));
#else
   /* it seems you have a problem
    * but we assume you can somewhere define your own uint128_t */
   typedef uint128_t            mp_word;
#endif

   #define DIGIT_BIT            60
#else
   /* this is the default case, 28-bit digits */

   /* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT




   typedef unsigned long long   ulong64;
   typedef signed long long     long64;

#endif

#ifndef MP_DIGIT_DECLARED
   typedef uint32_t             mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef ulong64              mp_word;

#ifdef MP_31BIT
   /* this is an extension that uses 31-bit digits */
   #define DIGIT_BIT            31
#else
   /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
   #define DIGIT_BIT            28
   #define MP_28BIT
#endif
#endif





















/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
   #define DIGIT_BIT     (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1))  /* bits per digit */
   typedef uint_least32_t mp_min_u32;
#else
   typedef mp_digit mp_min_u32;
#endif

/* platforms that can use a better rand function */
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
    #define MP_USE_ALT_RAND 1
#endif

/* use arc4random on platforms that support it */
#ifdef MP_USE_ALT_RAND
    #define MP_GEN_RANDOM()    arc4random()
#else
    #define MP_GEN_RANDOM()    rand()
#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

/* equalities */
................................................................................
#endif

/* define this to use lower memory usage routines (exptmods mostly) */
/* #define MP_LOW_MEM */

/* default precision */
#ifndef MP_PREC
   #ifndef MP_LOW_MEM
      #define MP_PREC                 32     /* default digits of precision */
   #else
      #define MP_PREC                 8      /* default digits of precision */
   #endif
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1 << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))

/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
#endif
struct mp_int {
................................................................................


#define USED(m)    ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m)    ((m)->sign)

/* error code to char* string */

const char *mp_error_to_string(int code);


/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
int mp_init(mp_int *a);
*/

................................................................................
/* init to a given number of digits */
/*
int mp_init_size(mp_int *a, int size);
*/

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) ((((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) ? MP_YES : MP_NO)
#define mp_isodd(a)  ((((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) ? MP_YES : MP_NO)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
/*
void mp_zero(mp_int *a);
*/

/* set to a digit */
................................................................................
void mp_set(mp_int *a, mp_digit b);
*/

/* set a 32-bit const */
/*
int mp_set_int(mp_int *a, unsigned long b);
*/

/* set a platform dependent unsigned long value */
/*
int mp_set_long(mp_int *a, unsigned long b);
*/

/* set a platform dependent unsigned long long value */
/*
int mp_set_long_long(mp_int *a, unsigned long long b);
*/

/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);

/* get a platform dependent unsigned long value */
unsigned long mp_get_long(mp_int * a);

/* get a platform dependent unsigned long long value */
unsigned long long mp_get_long_long(mp_int * a);

/* initialize and set a digit */
/*
int mp_init_set (mp_int * a, mp_digit b);
*/

/* initialize and set 32-bit value */
................................................................................
/* copy, b = a */
/*
int mp_copy(const mp_int *a, mp_int *b);
*/

/* inits and copies, a = b */
/*
int mp_init_copy(mp_int *a, const mp_int *b);
*/

/* trim unused digits */
/*
void mp_clamp(mp_int *a);
*/

/* import binary data */
/*
int mp_import(mp_int* rop, size_t count, int order, size_t size, int endian, size_t nails, const void* op);
*/

/* export binary data */
/*
int mp_export(void* rop, size_t* countp, int order, size_t size, int endian, size_t nails, mp_int* op);
*/

/* ---> digit manipulation <--- */

/* right shift by "b" digits */
/*
void mp_rshd(mp_int *a, int b);
*/

/* left shift by "b" digits */
/*
int mp_lshd(mp_int *a, int b);
*/

/* c = a / 2**b, implemented as c = a >> b */
/*
int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
*/

/* b = a/2 */
/*
int mp_div_2(mp_int *a, mp_int *b);
*/

/* c = a * 2**b, implemented as c = a << b */
/*
int mp_mul_2d(const mp_int *a, int b, mp_int *c);
*/

/* b = a*2 */
/*
int mp_mul_2(mp_int *a, mp_int *b);
*/

/* c = a mod 2**b */
/*
int mp_mod_2d(const mp_int *a, int b, mp_int *c);
*/

/* computes a = 2**b */
/*
int mp_2expt(mp_int *a, int b);
*/

/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(const mp_int *a);
*/

/* I Love Earth! */

/* makes a pseudo-random int of a given size */
/*
int mp_rand(mp_int *a, int digits);
................................................................................
int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
*/

/* c = a**b */
/*
int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
*/
/*
int mp_expt_d_ex (mp_int * a, mp_digit b, mp_int * c, int fast);
*/

/* c = a mod b, 0 <= c < b  */
/*
int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
*/

/* ---> number theory <--- */
................................................................................
/* finds one of the b'th root of a, such that |c|**b <= |a|
 *
 * returns error if a < 0 and b is even
 */
/*
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
*/
/*
int mp_n_root_ex (mp_int * a, mp_digit b, mp_int * c, int fast);
*/

/* special sqrt algo */
/*
int mp_sqrt(mp_int *arg, mp_int *ret);
*/

/* special sqrt (mod prime) */
/*
int mp_sqrtmod_prime(mp_int *arg, mp_int *prime, mp_int *ret);
*/

/* is number a square? */
/*
int mp_is_square(mp_int *arg, int *ret);
*/

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
................................................................................
#  define PRIME_SIZE      31
#else
#  define PRIME_SIZE      256
#endif

/* table of first PRIME_SIZE primes */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const mp_digit ltm_prime_tab[PRIME_SIZE];
#endif

/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
/*
int mp_prime_is_divisible(mp_int *a, int *result);
*/

................................................................................
 * Sets result to 0 if composite or 1 if probable prime
 */
/*
int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
*/

/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96
 */
/*
int mp_prime_rabin_miller_trials(int size);
*/

/* performs t rounds of Miller-Rabin on "a" using the first
 * t prime bases.  Also performs an initial sieve of trial
................................................................................
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
/*
int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/

/* makes a truly random prime of a given size (bytes),
 * call with bbs = 1 if you want it to be congruent to 3 mod 4
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 * The prime generated will be larger than 2^(8*size).
 */
#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 *
 *   LTM_PRIME_BBS      - make prime congruent to 3 mod 4
 *   LTM_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)

 *   LTM_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */
................................................................................
/*
int mp_toradix(mp_int *a, char *str, int radix);
*/
/*
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
*/
/*
int mp_radix_size(const mp_int *a, int radix, int *size);
*/

#ifndef LTM_NO_FILE
/*
int mp_fread(mp_int *a, int radix, FILE *stream);
*/
/*
int mp_fwrite(mp_int *a, int radix, FILE *stream);
*/
#endif

#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
#define mp_raw_size(mp)           mp_signed_bin_size(mp)
#define mp_toraw(mp, str)         mp_to_signed_bin((mp), (str))
#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
#define mp_mag_size(mp)           mp_unsigned_bin_size(mp)
#define mp_tomag(mp, str)         mp_to_unsigned_bin((mp), (str))

#define mp_tobinary(M, S)  mp_toradix((M), (S), 2)
#define mp_tooctal(M, S)   mp_toradix((M), (S), 8)
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
#define mp_tohex(M, S)     mp_toradix((M), (S), 16)






























































#ifdef __cplusplus
   }
#endif

#endif


/* $Source$ */
/* $Revision$ */
/* $Date$ */

#define mp_div TclBN_mp_div
#define mp_div_2 TclBN_mp_div_2
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_3 TclBN_mp_div_3
#define mp_div_d TclBN_mp_div_d
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d

#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
................................................................................
/* 19 */
TCLAPI int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
/* 20 */
TCLAPI int		TclBN_mp_grow(mp_int *a, int size);
/* 21 */
TCLAPI int		TclBN_mp_init(mp_int *a);
/* 22 */
TCLAPI int		TclBN_mp_init_copy(mp_int *a, mp_int *b);
/* 23 */
TCLAPI int		TclBN_mp_init_multi(mp_int *a, ...);
/* 24 */
TCLAPI int		TclBN_mp_init_set(mp_int *a, mp_digit b);
/* 25 */
TCLAPI int		TclBN_mp_init_size(mp_int *a, int size);
/* 26 */
................................................................................
/* 32 */
TCLAPI int		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
/* 33 */
TCLAPI int		TclBN_mp_neg(const mp_int *a, mp_int *b);
/* 34 */
TCLAPI int		TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
/* 35 */
TCLAPI int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);

/* 36 */
TCLAPI int		TclBN_mp_read_radix(mp_int *a, const char *str,
				int radix);
/* 37 */
TCLAPI void		TclBN_mp_rshd(mp_int *a, int shift);
/* 38 */
TCLAPI int		TclBN_mp_shrink(mp_int *a);
................................................................................
TCLAPI void		TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/* 65 */
TCLAPI void		TclBNInitBignumFromWideInt(mp_int *bignum,
				Tcl_WideInt initVal);
/* 66 */
TCLAPI void		TclBNInitBignumFromWideUInt(mp_int *bignum,
				Tcl_WideUInt initVal);




typedef struct TclTomMathStubs {
    int magic;
    void *hooks;

    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */
................................................................................
    int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
    int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
    int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
    void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
    int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
    int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
    int (*tclBN_mp_init) (mp_int *a); /* 21 */
    int (*tclBN_mp_init_copy) (mp_int *a, mp_int *b); /* 22 */
    int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
    int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
    int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
    int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
    int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
    int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */
    int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
    int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
    int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
    int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */
    int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */
    int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
    int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
    int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
    void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
    int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
    void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
    int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
    int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
    int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
................................................................................
    int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
    int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
    int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
    int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
    void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
    void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
    void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */

} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
#define TclBNInitBignumFromLong \
	(tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */
#define TclBNInitBignumFromWideInt \
	(tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
#define TclBNInitBignumFromWideUInt \
	(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */



#endif /* defined(USE_TCL_STUBS) */

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

#endif /* _TCLINTDECLS */

#define mp_div TclBN_mp_div
#define mp_div_2 TclBN_mp_div_2
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_3 TclBN_mp_div_3
#define mp_div_d TclBN_mp_div_d
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
................................................................................
/* 19 */
TCLAPI int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
/* 20 */
TCLAPI int		TclBN_mp_grow(mp_int *a, int size);
/* 21 */
TCLAPI int		TclBN_mp_init(mp_int *a);
/* 22 */
TCLAPI int		TclBN_mp_init_copy(mp_int *a, const mp_int *b);
/* 23 */
TCLAPI int		TclBN_mp_init_multi(mp_int *a, ...);
/* 24 */
TCLAPI int		TclBN_mp_init_set(mp_int *a, mp_digit b);
/* 25 */
TCLAPI int		TclBN_mp_init_size(mp_int *a, int size);
/* 26 */
................................................................................
/* 32 */
TCLAPI int		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
/* 33 */
TCLAPI int		TclBN_mp_neg(const mp_int *a, mp_int *b);
/* 34 */
TCLAPI int		TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
/* 35 */
TCLAPI int		TclBN_mp_radix_size(const mp_int *a, int radix,
				int *size);
/* 36 */
TCLAPI int		TclBN_mp_read_radix(mp_int *a, const char *str,
				int radix);
/* 37 */
TCLAPI void		TclBN_mp_rshd(mp_int *a, int shift);
/* 38 */
TCLAPI int		TclBN_mp_shrink(mp_int *a);
................................................................................
TCLAPI void		TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/* 65 */
TCLAPI void		TclBNInitBignumFromWideInt(mp_int *bignum,
				Tcl_WideInt initVal);
/* 66 */
TCLAPI void		TclBNInitBignumFromWideUInt(mp_int *bignum,
				Tcl_WideUInt initVal);
/* 67 */
TCLAPI int		TclBN_mp_expt_d_ex(mp_int *a, mp_digit b, mp_int *c,
				int fast);

typedef struct TclTomMathStubs {
    int magic;
    void *hooks;

    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */
................................................................................
    int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
    int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
    int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
    void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
    int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
    int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
    int (*tclBN_mp_init) (mp_int *a); /* 21 */
    int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */
    int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
    int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
    int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
    int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
    int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
    int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */
    int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
    int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
    int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
    int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */
    int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */
    int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
    int (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size); /* 35 */
    int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
    void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
    int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
    void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
    int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
    int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
    int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
................................................................................
    int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
    int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
    int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
    int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
    void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
    void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
    void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
    int (*tclBN_mp_expt_d_ex) (mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................
	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
#define TclBNInitBignumFromLong \
	(tclTomMathStubsPtr->tclBNInitBignumFromLong) /* 64 */
#define TclBNInitBignumFromWideInt \
	(tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
#define TclBNInitBignumFromWideUInt \
	(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
#define TclBN_mp_expt_d_ex \
	(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */

#endif /* defined(USE_TCL_STUBS) */

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

#endif /* _TCLINTDECLS */

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	opsList = Tcl_NewObj();
	Tcl_IncrRefCount(opsList);
	flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
	if (numFlags == 0) {
	    Tcl_DecrRefCount(opsList);
	    goto badVarOps;
	}
	for (p = flagOps; *p != 0; p++) {
	    Tcl_Obj *opObj;

................................................................................
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	opsList = Tcl_NewObj();
	Tcl_IncrRefCount(opsList);
	flagOps = TclGetStringFromObj(objv[3], &numFlags);
	if (numFlags == 0) {
	    Tcl_DecrRefCount(opsList);
	    goto badVarOps;
	}
	for (p = flagOps; *p != 0; p++) {
	    Tcl_Obj *opObj;

................................................................................
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;

    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,4,4,4,
#else
    1,1,1,1,1,1,1,1,
#endif
#if TCL_UTF_MAX > 4
    5,5,5,5,
#else
    1,1,1,1,
#endif
#if TCL_UTF_MAX > 5
    6,6,6,6
#else
    1,1,1,1
#endif
};
 
/*
 *---------------------------------------------------------------------------
 *
 * TclUtfCount --
 *
................................................................................
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Tcl_UniChar whose size is returned. */
{
    if ((ch > 0) && (ch < UNICODE_SELF)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
    }
#if TCL_UTF_MAX > 3
    if ((ch > 0xFFFF) && (ch <= 0x10FFFF)) {
	return 4;
    }
#endif
    return 3;
}

/*
................................................................................
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most TCL_UTF_MAX bytes). */
{
    if ((ch > 0) && (ch < UNICODE_SELF)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 6) | 0xC0);
................................................................................
		    buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
		    buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
		    buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
		    return 0;
		}
	    }
#endif
	three:
	    buf[2] = (char) ((ch | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 12) | 0xE0);
	    return 3;
	}

#if TCL_UTF_MAX > 3
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) ((ch | 0x80) & 0xBF);
	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
................................................................................
	    buf[0] = (char) ((ch >> 18) | 0xF0);
	    return 4;
	}
#endif
    }

    ch = 0xFFFD;
    goto three;




}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtfDString --
 *
................................................................................
	    return 2;
	}

	/*
	 * A two-byte-character lead-byte not followed by trail-byte
	 * represents itself.
	 */

	*chPtr = (Tcl_UniChar) byte;
	return 1;
    } else if (byte < 0xF0) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
	    /*
	     * Three-byte-character lead byte followed by two trail bytes.
	     */

	    *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
................................................................................
	    return 3;
	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */

	*chPtr = (Tcl_UniChar) byte;
	return 1;
    }
#if TCL_UTF_MAX > 3





    {
	int ch, total, trail;

	total = totalBytes[byte];
	trail = total - 1;
	if (trail > 0) {
	    ch = byte & (0x3F >> trail);
	    do {
		src++;
		if ((*src & 0xC0) != 0x80) {
		    *chPtr = byte;
		    return 1;
		}
		ch <<= 6;
		ch |= (*src & 0x3F);
		trail--;
	    } while (trail > 0);
	    *chPtr = ch;
	    return total;
	}




    }
#endif

    *chPtr = (Tcl_UniChar) byte;
    return 1;
}
 

    2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,4,4,4,
#else
    1,1,1,1,1,1,1,1,
#endif



    1,1,1,1,1,1,1,1






};
 
/*
 *---------------------------------------------------------------------------
 *
 * TclUtfCount --
 *
................................................................................
 *---------------------------------------------------------------------------
 */

int
TclUtfCount(
    int ch)			/* The Tcl_UniChar whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
    }
#if TCL_UTF_MAX > 3
    if (((unsigned)(ch - 0x10000) <= 0xfffff)) {
	return 4;
    }
#endif
    return 3;
}

/*
................................................................................
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most TCL_UTF_MAX bytes). */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 6) | 0xC0);
................................................................................
		    buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
		    buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
		    buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
		    return 0;
		}
	    }
#endif
	    goto three;




	}

#if TCL_UTF_MAX > 3
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) ((ch | 0x80) & 0xBF);
	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
................................................................................
	    buf[0] = (char) ((ch >> 18) | 0xF0);
	    return 4;
	}
#endif
    }

    ch = 0xFFFD;
three:
    buf[2] = (char) ((ch | 0x80) & 0xBF);
    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
    buf[0] = (char) ((ch >> 12) | 0xE0);
    return 3;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtfDString --
 *
................................................................................
	    return 2;
	}

	/*
	 * A two-byte-character lead-byte not followed by trail-byte
	 * represents itself.
	 */



    } else if (byte < 0xF0) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
	    /*
	     * Three-byte-character lead byte followed by two trail bytes.
	     */

	    *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
................................................................................
	    return 3;
	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }



#if TCL_UTF_MAX > 3
    else if (byte < 0xF8) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by three trail bytes.
	     */



	    *chPtr = (Tcl_UniChar) (((byte & 0x0E) << 18) | ((src[1] & 0x3F) << 12)
		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));






	    return 4;
	}







	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }
#endif

    *chPtr = (Tcl_UniChar) byte;
    return 1;
}
 

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

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	Tcl_GetString(objPtr);
	length = objPtr->length;
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
................................................................................
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    char *bytes = Tcl_GetString(objPtr);

    return Tcl_DStringAppend(dsPtr, bytes, objPtr->length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
................................................................................
void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    char *bytes = Tcl_GetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}
 
/*
................................................................................

    /*
     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	bytes = Tcl_GetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": must be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
................................................................................

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = Tcl_GetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
     * Fill the local thread copy directly with the Tcl_Obj value to avoid
................................................................................
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
    }
    cacheMap = GetThreadHash(&pgvPtr->key);
    hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
    if (NULL == hPtr) {
	int dummy;

	/*
	 * No cache for the current epoch - must be a new one.
	 *
	 * First, clear the cacheMap, as anything in it must refer to some
................................................................................
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetNameOfExecutable(void)
{
    Tcl_Obj *obj = TclGetObjNameOfExecutable();
    const char *bytes = Tcl_GetString(obj);

    if (obj->length == 0) {
	return NULL;
    }
    return bytes;
}
 

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

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	TclGetString(objPtr);
	length = objPtr->length;
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	resPtr = NULL;
................................................................................
 */

char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    char *bytes = TclGetString(objPtr);

    return Tcl_DStringAppend(dsPtr, bytes, objPtr->length);
}

char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
................................................................................
void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    char *bytes = TclGetString(obj);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}
 
/*
................................................................................

    /*
     * Report a parse error.
     */

  parseError:
    if (interp != NULL) {
	bytes = TclGetString(objPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad index \"%s\": must be integer?[+-]integer? or"
		" end?[+-]integer?", bytes));
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
................................................................................

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
     * Fill the local thread copy directly with the Tcl_Obj value to avoid
................................................................................
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
    }
    cacheMap = GetThreadHash(&pgvPtr->key);
    hPtr = Tcl_FindHashEntry(cacheMap, (void *) (epoch));
    if (NULL == hPtr) {
	int dummy;

	/*
	 * No cache for the current epoch - must be a new one.
	 *
	 * First, clear the cacheMap, as anything in it must refer to some
................................................................................
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetNameOfExecutable(void)
{
    Tcl_Obj *obj = TclGetObjNameOfExecutable();
    const char *bytes = TclGetString(obj);

    if (obj->length == 0) {
	return NULL;
    }
    return bytes;
}
 

				 * return error if it doesn't exist. */
    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
    Interp *iPtr = (Interp *) interp;

    register Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    const char *part1;
    int index, len1, len2;
    int parsed = 0;
    Tcl_Obj *objPtr;
    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
    const char *errMsg = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;

    *arrayPtrPtr = NULL;

    if (typePtr == &localVarNameType) {
	int localIndex;

    localVarNameTypeHandling:
	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
................................................................................
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		goto donePart1;
	    }
	}
................................................................................
		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    if ((part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2)) {
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}
	    }
	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    typePtr = part1Ptr->typePtr;
	    if (typePtr == &localVarNameType) {
		goto localVarNameTypeHandling;
	    }
	}
	parsed = 1;
    }
    part1 = TclGetStringFromObj(part1Ptr, &len1);

    if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {


	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	register int i;


	len2 = -1;
	for (i = 0; i < len1; i++) {
	    if (*(part1 + i) == '(') {






		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				needArray, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}

		/*
		 * part1Ptr points to an array element; first copy the element
		 * name to a new string part2.
		 */

		part2 = part1 + i + 1;
		len2 = len1 - i - 2;
		len1 = i;


		part2Ptr = Tcl_NewStringObj(part2, len2);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}

		/*
		 * Free the internal rep of the original part1Ptr, now renamed
		 * objPtr, and set it to tclParsedVarNameType.
		 */

		objPtr = part1Ptr;
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &tclParsedVarNameType;

		/*
		 * Define a new string object to hold the new part1Ptr, i.e.,
		 * the array name. Set the internal rep of objPtr, reset
		 * typePtr and part1 to contain the references to the array
		 * name.
		 */

		TclNewStringObj(part1Ptr, part1, len1);
		Tcl_IncrRefCount(part1Ptr);

		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
		Tcl_IncrRefCount(part2Ptr);
		objPtr->internalRep.twoPtrValue.ptr2 = part2Ptr;


		typePtr = part1Ptr->typePtr;
		part1 = TclGetString(part1Ptr);
		break;

	    }
	}
    }

  doneParsing:
    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
     */

    TclFreeIntRep(part1Ptr);

    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
................................................................................
	return NULL;
    }

    /*
     * Cache the newly found variable if possible.
     */


    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */
	Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);

	part1Ptr->typePtr = &localVarNameType;
	if (part1Ptr != cachedNamePtr) {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
	    Tcl_IncrRefCount(cachedNamePtr);
	    if (cachedNamePtr->typePtr != &localVarNameType
		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
................................................................................
	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);
    }
    return varPtr;
}
 
/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
 * lookup is performed for upvar (or similar) purposes, with slightly
 * different rules:
 *    - Bug #696893 - variable is either proc-local or in the current
 *	namespace; never follow the second (global) resolution path
 *    - Bug #631741 - do not use special namespace or interp resolvers
 */

#define AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------------
 *
 * TclLookupSimpleVar --
 *
 *	This function is used by to locate a simple variable (i.e., not an
 *	array element) given its name.
................................................................................

Var *
TclLookupSimpleVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
				 * represent a scalar or an array. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
				 * matter. */
    const int create,		/* If 1, create hash table entry for varname,
				 * if it doesn't already exist. If 0, return
				 * error if it doesn't exist. */
    const char **errMsgPtr,
    int *indexPtr)
{
    Interp *iPtr = (Interp *) interp;
................................................................................
    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & AVOID_RESOLVERS)) {
	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}
................................................................................
		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    if (flags & AVOID_RESOLVERS) {
		flags = (flags | TCL_NAMESPACE_ONLY);
	    }
	    if (flags & TCL_NAMESPACE_ONLY) {
		*indexPtr = -2;
	    }
	}

................................................................................
	/*
	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	    Tcl_Obj *tailPtr;

	    if (create) {	/* Var wasn't found so create it. */
		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
................................................................................
			NULL);
		return TCL_ERROR;
	    }
	}

	/*
	 * Lookup and eventually create the new variable. Set the flag bit
	 * AVOID_RESOLVERS to indicate the special resolution rules for upvar
	 * purposes:
	 *   - Bug #696893 - variable is either proc-local or in the current
	 *     namespace; never follow the second (global) resolution path.
	 *   - Bug #631741 - do not use special namespace or interp resolvers.
	 */

	varPtr = TclLookupSimpleVar(interp, myNamePtr,
		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
	if (varPtr == NULL) {
	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(myNamePtr), NULL);
	    return TCL_ERROR;
	}
    }
................................................................................

    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
	    varPtr = VarHashFirstVar(tablePtr, &search)) {
	Tcl_Obj *objPtr = Tcl_NewObj();
	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
					 * hash. */
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags,
		-1);
	Tcl_DecrRefCount(objPtr);	/* Free no longer needed obj */

	/*

	 * Remove the variable from the table and force it undefined in case
	 * an unset trace brought it back from the dead.



	 */

	if (TclIsVarTraced(varPtr)) {
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
	    ActiveVarTrace *activePtr;

................................................................................
	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
		    activePtr = activePtr->nextPtr) {
		if (activePtr->varPtr == varPtr) {
		    activePtr->nextTracePtr = NULL;
		}
	    }
	}











	VarHashRefCount(varPtr)--;
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}
 
/*
................................................................................

void
TclDeleteVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    TclVarHashTable *tablePtr)	/* Hash table containing variables to
				 * delete. */
{
    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
    Tcl_HashSearch search;
    register Var *varPtr;
    int flags;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    /*
     * Determine what flags to pass to the trace callback functions.
     */





    flags = TCL_TRACE_UNSETS;


    if (tablePtr == &iPtr->globalNsPtr->varTable) {
	flags |= TCL_GLOBAL_ONLY;
    } else if (tablePtr == &currNsPtr->varTable) {
	flags |= TCL_NAMESPACE_ONLY;
    }



    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
	 varPtr = VarHashFirstVar(tablePtr, &search)) {














	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
		-1);




	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,

				 * TCL_GLOBAL_ONLY (look up name only in
				 * global namespace), TCL_NAMESPACE_ONLY (look
				 * up only in contextNsPtr, or the current
				 * namespace if contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
    Tcl_Var var;

................................................................................
				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,

				 * TCL_GLOBAL_ONLY (look up name only in
				 * global namespace), TCL_NAMESPACE_ONLY (look
				 * up only in contextNsPtr, or the current
				 * namespace if contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
................................................................................
	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    } else if (contextNsPtr != NULL) {
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & AVOID_RESOLVERS) &&
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
	resPtr = iPtr->resolverPtr;

	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {

				 * return error if it doesn't exist. */
    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    register Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    const char *errMsg = NULL;

    int index, parsed = 0;

    const Tcl_ObjType *typePtr = part1Ptr->typePtr;




    *arrayPtrPtr = NULL;

    if (typePtr == &localVarNameType) {
	int localIndex;

    localVarNameTypeHandling:
	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
................................................................................
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		goto donePart1;
	    }
	}
................................................................................
		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2;




	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    typePtr = part1Ptr->typePtr;
	    if (typePtr == &localVarNameType) {
		goto localVarNameTypeHandling;
	    }
	}
	parsed = 1;
    }



    if (!parsed) {

	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	int len;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);


	if (len > 1 && (part1[len - 1] == ')')) {


	  const char *part2 = strchr(part1, '(');

	  if (part2) {
	    Tcl_Obj *arrayPtr;

		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				needArray, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}










	    arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
	    part2Ptr = Tcl_NewStringObj(part2 + 1, len - (part2 - part1) - 2);










	    TclFreeIntRep(part1Ptr);










	    Tcl_IncrRefCount(arrayPtr);

	    part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
	    Tcl_IncrRefCount(part2Ptr);
	    part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
	    part1Ptr->typePtr = &tclParsedVarNameType;




	    part1Ptr = arrayPtr;
	  }
	}
    }

  doneParsing:
    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
     */



    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
................................................................................
	return NULL;
    }

    /*
     * Cache the newly found variable if possible.
     */

    TclFreeIntRep(part1Ptr);
    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */
	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);

	part1Ptr->typePtr = &localVarNameType;
	if (part1Ptr != cachedNamePtr) {
	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
	    Tcl_IncrRefCount(cachedNamePtr);
	    if (cachedNamePtr->typePtr != &localVarNameType
		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
................................................................................
	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);
    }
    return varPtr;
}
 












/*
 *----------------------------------------------------------------------
 *
 * TclLookupSimpleVar --
 *
 *	This function is used by to locate a simple variable (i.e., not an
 *	array element) given its name.
................................................................................

Var *
TclLookupSimpleVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
				 * represent a scalar or an array. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
				 * bits matter. */
    const int create,		/* If 1, create hash table entry for varname,
				 * if it doesn't already exist. If 0, return
				 * error if it doesn't exist. */
    const char **errMsgPtr,
    int *indexPtr)
{
    Interp *iPtr = (Interp *) interp;
................................................................................
    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & TCL_AVOID_RESOLVERS)) {
	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}
................................................................................
		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    if (flags & TCL_AVOID_RESOLVERS) {
		flags = (flags | TCL_NAMESPACE_ONLY);
	    }
	    if (flags & TCL_NAMESPACE_ONLY) {
		*indexPtr = -2;
	    }
	}

................................................................................
	/*
	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	    Tcl_Obj *tailPtr;

	    if (create) {	/* Var wasn't found so create it. */
		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
................................................................................
			NULL);
		return TCL_ERROR;
	    }
	}

	/*
	 * Lookup and eventually create the new variable. Set the flag bit
	 * TCL_AVOID_RESOLVERS to indicate the special resolution rules for
	 * upvar purposes:
	 *   - Bug #696893 - variable is either proc-local or in the current
	 *     namespace; never follow the second (global) resolution path.
	 *   - Bug #631741 - do not use special namespace or interp resolvers.
	 */

	varPtr = TclLookupSimpleVar(interp, myNamePtr,
		myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
	if (varPtr == NULL) {
	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(myNamePtr), NULL);
	    return TCL_ERROR;
	}
    }
................................................................................

    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
	    varPtr = VarHashFirstVar(tablePtr, &search)) {
	Tcl_Obj *objPtr = Tcl_NewObj();
	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
					 * hash. */
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		NULL, flags, -1);


	/*
	 * We just unset the variable. However, an unset trace might
	 * have re-set it, or might have re-established traces on it.
	 * This namespace and its vartable are going away unconditionally,
	 * so we cannot let such things linger. That would be a leak.
	 *
	 * First we destroy all traces. ...
	 */

	if (TclIsVarTraced(varPtr)) {
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
	    ActiveVarTrace *activePtr;

................................................................................
	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
		    activePtr = activePtr->nextPtr) {
		if (activePtr->varPtr == varPtr) {
		    activePtr->nextTracePtr = NULL;
		}
	    }
	}

	/*
	 * ...and then, if the variable still holds a value, we unset it
	 * again. This time with no traces left, we're sure it goes away.
	 */

	if (!TclIsVarUndefined(varPtr)) {
	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		    NULL, flags, -1);
	}
	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
	VarHashRefCount(varPtr)--;
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}
 
/*
................................................................................

void
TclDeleteVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    TclVarHashTable *tablePtr)	/* Hash table containing variables to
				 * delete. */
{

    Tcl_HashSearch search;
    register Var *varPtr;






    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
	 varPtr = VarHashFirstVar(tablePtr, &search)) {
	VarHashRefCount(varPtr)++;

	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
		NULL, TCL_TRACE_UNSETS, -1);

        if (TclIsVarTraced(varPtr)) {
            Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
            VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
            ActiveVarTrace *activePtr;


            while (tracePtr) {
                VarTrace *prevPtr = tracePtr;


                tracePtr = tracePtr->nextPtr;
                prevPtr->nextPtr = NULL;
                Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
            }
            Tcl_DeleteHashEntry(tPtr);
            varPtr->flags &= ~VAR_ALL_TRACES;
            for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
                    activePtr = activePtr->nextPtr) {
                if (activePtr->varPtr == varPtr) {
                    activePtr->nextTracePtr = NULL;
                }
            }
        }

	if (!TclIsVarUndefined(varPtr)) {
	    UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),

		    NULL, TCL_TRACE_UNSETS, -1);
	}

	VarHashRefCount(varPtr)--;
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}
 
/*
 *----------------------------------------------------------------------
................................................................................
				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of:
				 * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
				 * up name only in global namespace),
				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
    Tcl_Var var;

................................................................................
				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of:
				 * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
				 * up name only in global namespace),
				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
................................................................................
	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    } else if (contextNsPtr != NULL) {
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & TCL_AVOID_RESOLVERS) &&
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
	resPtr = iPtr->resolverPtr;

	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {

static Tcl_ObjCmdProc		ZlibStreamAddCmd;
static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
static Tcl_ObjCmdProc		ZlibStreamPutCmd;

static void		ConvertError(Tcl_Interp *interp, int code,
			    uLong adler);
static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);


static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
			    GzipHeader *headerPtr, int *extraSizePtr);
static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
			    int toRead);
................................................................................
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = Tcl_GetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
................................................................................
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = Tcl_GetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
................................................................................
    }

    if (latin1enc != NULL) {
	Tcl_FreeEncoding(latin1enc);
    }
}
 




static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
................................................................................
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, (unsigned) length);
    }
    return Z_OK;
}
































 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamInit --
 *
 *	This command initializes a (de)compression context/handle for
................................................................................
 *
 *	Add data to the stream for compression or decompression from a
 *	bytearray Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */



int
Tcl_ZlibStreamPut(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e, size, outSize;
    Tcl_Obj *obj;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
	}
................................................................................
	if (size == 0) {
	    return TCL_OK;
	}

	if (HaveDictToSet(zshPtr)) {
	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {
		if (zshPtr->interp) {
		    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		}
		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}

	/*
	 * Deflatebound doesn't seem to take various header sizes into
	 * account, so we add 100 extra bytes.


	 */

	outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
	zshPtr->stream.avail_out = outSize;



	dataTmp = ckalloc(zshPtr->stream.avail_out);
	zshPtr->stream.next_out = (Bytef *) dataTmp;


	e = deflate(&zshPtr->stream, flush);











	while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {






	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after
	     * saving the old generated data to the outData list.
	     */

	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);

	    if (outSize < 0xFFFF) {

		outSize = 0xFFFF;	/* There may be *lots* of data left to
					 * output... */
		dataTmp = ckrealloc(dataTmp, outSize);
	    }
	    zshPtr->stream.avail_out = outSize;
	    zshPtr->stream.next_out = (Bytef *) dataTmp;

	    e = deflate(&zshPtr->stream, flush);
	}

	if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
	    if (zshPtr->interp) {
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
	    }
	    return TCL_ERROR;
	}

	/*
	 * And append the final data block.
	 */

	if (outSize - zshPtr->stream.avail_out > 0) {
	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
		    outSize - zshPtr->stream.avail_out);

	    /*
	     * Now append the compressed data to the outData list.
	     */

	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
	}

	if (dataTmp) {
	    ckfree(dataTmp);
	}
    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);

................................................................................
	 * (You can't do it in response to getting Z_NEED_DATA as raw streams
	 * don't ever issue that.)
	 */

	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {
		if (zshPtr->interp) {
		    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		}
		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}
	e = inflate(&zshPtr->stream, zshPtr->flush);
	if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
................................................................................

static int
ZlibTransformClose(
    ClientData instanceData,
    Tcl_Interp *interp)
{
    ZlibChannelData *cd = instanceData;
    int e, result = TCL_OK;

    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);

................................................................................
    /*
     * Flush any data waiting to be compressed.
     */

    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	cd->outStream.avail_in = 0;
	do {
	    cd->outStream.next_out = (Bytef *) cd->outBuffer;









	    cd->outStream.avail_out = (unsigned) cd->outAllocated;
	    e = deflate(&cd->outStream, Z_FINISH);

	    if (e != Z_OK && e != Z_STREAM_END) {
		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }
	    if (cd->outStream.avail_out != (unsigned) cd->outAllocated) {
		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
			cd->outAllocated - cd->outStream.avail_out) < 0) {
		    /* TODO: is this the right way to do errors on close?
		     * Note: when close is called from FinalizeIOSubsystem
		     * then interp may be NULL */
		    if (!TclInThreadExit() && interp) {
			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				"error while finalizing file: %s",
				Tcl_PosixError(interp)));
		    }
		    result = TCL_ERROR;
		    break;
		}
	    }
	} while (e != Z_STREAM_END);
	(void) deflateEnd(&cd->outStream);
    } else {
	(void) inflateEnd(&cd->inStream);
    }

................................................................................
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }

    cd->outStream.next_in = (Bytef *) buf;
    cd->outStream.avail_in = toWrite;
    do {
	cd->outStream.next_out = (Bytef *) cd->outBuffer;
	cd->outStream.avail_out = cd->outAllocated;

	e = deflate(&cd->outStream, Z_NO_FLUSH);








	produced = cd->outAllocated - cd->outStream.avail_out;


	if (e == Z_OK && produced > 0) {
	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
		*errorCodePtr = Tcl_GetErrno();
		return -1;
	    }
	}
    } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);

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

    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */

	cd->outStream.next_out = (Bytef *) cd->outBuffer;
	cd->outStream.avail_out = cd->outAllocated;

	e = deflate(&cd->outStream, flushType);

	if (e != Z_OK && e != Z_BUF_ERROR) {
	    ConvertError(interp, e, cd->outStream.adler);
	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */

	len = cd->outStream.next_out - (Bytef *) cd->outBuffer;
	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

................................................................................
		Tcl_DStringAppendElement(dsPtr,
			Tcl_GetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		const char *str = Tcl_GetString(cd->compDictObj);

		Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length);
	    }
	    return TCL_OK;
	}
    }

static Tcl_ObjCmdProc		ZlibStreamAddCmd;
static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
static Tcl_ObjCmdProc		ZlibStreamPutCmd;

static void		ConvertError(Tcl_Interp *interp, int code,
			    uLong adler);
static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
static inline int	Deflate(z_streamp strm, void *bufferPtr,
			    int bufferSize, int flush, int *writtenPtr);
static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
			    GzipHeader *headerPtr, int *extraSizePtr);
static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
			    int toRead);
................................................................................
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
................................................................................
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetString(value);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, value->length, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
................................................................................
    }

    if (latin1enc != NULL) {
	Tcl_FreeEncoding(latin1enc);
    }
}
 
/*
 * Disentangle the worst of how the zlib API is used.
 */

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	int length;
................................................................................
	int length;
	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, (unsigned) length);
    }
    return Z_OK;
}

static inline int
Deflate(
    z_streamp strm,
    void *bufferPtr,
    int bufferSize,
    int flush,
    int *writtenPtr)
{
    int e;

    strm->next_out = (Bytef *) bufferPtr;
    strm->avail_out = (unsigned) bufferSize;
    e = deflate(strm, flush);
    if (writtenPtr != NULL) {
	*writtenPtr = bufferSize - strm->avail_out;
    }
    return e;
}

static inline void
AppendByteArray(
    Tcl_Obj *listObj,
    void *buffer,
    int size)
{
    if (size > 0) {
	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);

	Tcl_ListObjAppendElement(NULL, listObj, baObj);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamInit --
 *
 *	This command initializes a (de)compression context/handle for
................................................................................
 *
 *	Add data to the stream for compression or decompression from a
 *	bytearray Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

#define BUFFER_SIZE_LIMIT	0xFFFF

int
Tcl_ZlibStreamPut(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e, size, outSize, toStore;


    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
	}
................................................................................
	if (size == 0) {
	    return TCL_OK;
	}

	if (HaveDictToSet(zshPtr)) {
	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {

		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);

		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}

	/*
	 * deflateBound() doesn't seem to take various header sizes into
	 * account, so we add 100 extra bytes. However, we can also loop
	 * around again so we also set an upper bound on the output buffer
	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;

	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = ckalloc(outSize);


	while (1) {
	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);

	    /*
	     * Test if we've filled the buffer up and have to ask deflate() to
	     * give us some more. Note that the condition for needing to
	     * repeat a buffer transfer when the result is Z_OK is whether
	     * there is no more space in the buffer we provided; the zlib
	     * library does not necessarily return a different code in that
	     * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
	     */

	    if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) {
		if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
		    break;
		}
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }

	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after
	     * saving the old generated data to the outData list.
	     */

	    AppendByteArray(zshPtr->outData, dataTmp, outSize);


	    if (outSize < BUFFER_SIZE_LIMIT) {
		outSize = BUFFER_SIZE_LIMIT;
		/* There may be *lots* of data left to output... */

		dataTmp = ckrealloc(dataTmp, outSize);
	    }











	}

	/*
	 * And append the final data block to the outData list.
	 */

	AppendByteArray(zshPtr->outData, dataTmp, toStore);











	ckfree(dataTmp);

    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);

................................................................................
	 * (You can't do it in response to getting Z_NEED_DATA as raw streams
	 * don't ever issue that.)
	 */

	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {

		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);

		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}
	e = inflate(&zshPtr->stream, zshPtr->flush);
	if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
................................................................................

static int
ZlibTransformClose(
    ClientData instanceData,
    Tcl_Interp *interp)
{
    ZlibChannelData *cd = instanceData;
    int e, written, result = TCL_OK;

    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);

................................................................................
    /*
     * Flush any data waiting to be compressed.
     */

    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	cd->outStream.avail_in = 0;
	do {
	    e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		    Z_FINISH, &written);

	    /*
	     * Can't be sure that deflate() won't declare the buffer to be
	     * full (with Z_BUF_ERROR) so handle that case.
	     */

	    if (e == Z_BUF_ERROR) {
		e = Z_OK;
		written = cd->outAllocated;

	    }
	    if (e != Z_OK && e != Z_STREAM_END) {
		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }

	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {

		/* TODO: is this the right way to do errors on close?
		 * Note: when close is called from FinalizeIOSubsystem then
		 * interp may be NULL */
		if (!TclInThreadExit() && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error while finalizing file: %s",
			    Tcl_PosixError(interp)));
		}
		result = TCL_ERROR;
		break;

	    }
	} while (e != Z_STREAM_END);
	(void) deflateEnd(&cd->outStream);
    } else {
	(void) inflateEnd(&cd->inStream);
    }

................................................................................
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }

    cd->outStream.next_in = (Bytef *) buf;
    cd->outStream.avail_in = toWrite;
    do {
	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		Z_NO_FLUSH, &produced);

	if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) {
	    /*
	     * deflate() indicates that it is out of space by returning
	     * Z_BUF_ERROR *or* by simply returning Z_OK with no remaining
	     * space; in either case, we must write the whole buffer out and
	     * retry to compress what is left.
	     */

	    if (e == Z_BUF_ERROR) {
		produced = cd->outAllocated;
		e = Z_OK;
	    }

	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
		*errorCodePtr = Tcl_GetErrno();
		return -1;
	    }
	}
    } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);

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

    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */




	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		flushType, &len);
	if (e != Z_OK && e != Z_BUF_ERROR) {
	    ConvertError(interp, e, cd->outStream.adler);
	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */


	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

................................................................................
		Tcl_DStringAppendElement(dsPtr,
			Tcl_GetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		const char *str = TclGetString(cd->compDictObj);

		Tcl_DStringAppend(dsPtr, str, cd->compDictObj->length);
	    }
	    return TCL_OK;
	}
    }

	    lappend dirs [file join [file dirname $grandParentDir] \
			      $basename$patch library]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# Take note that the [file normalize] below has been noted to cause
	# difficulties for the freewrap utility.  See Bug 1072136.  Until
	# freewrap resolves the matter, one might work around the problem by
	# disabling that branch.
	if {[interp issafe]} {

	    set norm $i
	} else {
	    set norm [file normalize $i]
	}
	if {[info exists seen($norm)]} {
	    continue
	}
	set seen($norm) {}
	lappend uniqdirs $i
    }
    set dirs $uniqdirs
    foreach i $dirs {
        set the_library $i
        set file [file join $i $initScript]

	# source everything when in a safe interpreter because we have a
	# source command, but no file exists command

        if {[interp issafe] || [file exists $file]} {

	    lappend dirs [file join [file dirname $grandParentDir] \
			      $basename$patch library]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# Make sure $i is unique under normalization. Avoid repeated [source].



	if {[interp issafe]} {
	    # Safe interps have no [file normalize].
	    set norm $i
	} else {
	    set norm [file normalize $i]
	}
	if {[info exists seen($norm)]} {
	    continue
	}
	set seen($norm) {}




        set the_library $i
        set file [file join $i $initScript]

	# source everything when in a safe interpreter because we have a
	# source command, but no file exists command

        if {[interp issafe] || [file exists $file]} {

    if {![llength $args]} {
	set args info
    }

    # Tricky stuff needed to make stack and errors come out right!
    tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
























 
# tcl::HistAdd --
#
#	Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
#	event		the command to add

    if {![llength $args]} {
	set args info
    }

    # Tricky stuff needed to make stack and errors come out right!
    tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
 
# (unnamed) --
#
#	Callback when [::history] is destroyed. Destroys the implementation.
#
# Parameters:
#	oldName    what the command was called.
#	newName    what the command is now called (an empty string).
#	op	   the operation (= delete).
#
# Results:
#	none
#
# Side Effects:
#	The implementation of the [::history] command ceases to exist.

trace add command ::history delete [list apply {{oldName newName op} {
    variable history
    unset -nocomplain history
    foreach c [info procs ::tcl::Hist*] {
	rename $c {}
    }
    rename ::tcl::history {}
} ::tcl}]
 
# tcl::HistAdd --
#
#	Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
#	event		the command to add

#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.9

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
................................................................................
		return
	    }

	    # We have to use binary translation to count bytes properly.
	    fconfigure $sock -translation binary

	    if {
		$state(-binary) || ![string match -nocase text* $state(type)]
	    } {
		# Turn off conversions for non-text data
		set state(binary) 1
	    }
	    if {[info exists state(-channel)]} {
		if {$state(binary) || [llength [ContentEncoding $token]]} {
		    fconfigure $state(-channel) -translation binary
................................................................................
	} else {
	    # open connection closed on a token that has been cleaned up.
	    CloseSocket $sock
	}
	return
    }
}

































# http::getTextLine --
#
#	Get one line with the stream in blocking crlf mode
#
# Arguments
#	sock	The socket receiving input.

#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.10

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
................................................................................
		return
	    }

	    # We have to use binary translation to count bytes properly.
	    fconfigure $sock -translation binary

	    if {
		$state(-binary) || [IsBinaryContentType $state(type)]
	    } {
		# Turn off conversions for non-text data
		set state(binary) 1
	    }
	    if {[info exists state(-channel)]} {
		if {$state(binary) || [llength [ContentEncoding $token]]} {
		    fconfigure $state(-channel) -translation binary
................................................................................
	} else {
	    # open connection closed on a token that has been cleaned up.
	    CloseSocket $sock
	}
	return
    }
}

# http::IsBinaryContentType --
#
#	Determine if the content-type means that we should definitely transfer
#	the data as binary. [Bug 838e99a76d]
#
# Arguments
#	type	The content-type of the data.
#
# Results:
#	Boolean, true if we definitely should be binary.

proc http::IsBinaryContentType {type} {
    lassign [split [string tolower $type] "/;"] major minor
    if {$major eq "text"} {
	return false
    }
    # There's a bunch of XML-as-application-format things about. See RFC 3023
    # and so on.
    if {$major eq "application"} {
	set minor [string trimright $minor]
	if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} {
	    return false
	}
    }
    # Not just application/foobar+xml but also image/svg+xml, so let us not
    # restrict things for now...
    if {[string match "*+xml" $minor]} {
	return false
    }
    return true
}

# http::getTextLine --
#
#	Get one line with the stream in blocking crlf mode
#
# Arguments
#	sock	The socket receiving input.

if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.9 [list tclPkgSetup $dir http 2.8.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.8.10 [list tclPkgSetup $dir http 2.8.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Cambridge_Bay) {
    {-9223372036854775808 0 0 zzz}
    {-1577923200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {325674000 -21600 1 MDT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Cambridge_Bay) {
    {-9223372036854775808 0 0 -00}
    {-1577923200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {325674000 -21600 1 MDT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Inuvik) {
    {-9223372036854775808 0 0 zzz}
    {-536457600 -28800 0 PST}
    {-147888000 -21600 1 PDDT}
    {-131558400 -28800 0 PST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Inuvik) {
    {-9223372036854775808 0 0 -00}
    {-536457600 -28800 0 PST}
    {-147888000 -21600 1 PDDT}
    {-131558400 -28800 0 PST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Iqaluit) {
    {-9223372036854775808 0 0 zzz}
    {-865296000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {-147898800 -10800 1 EDDT}
    {-131569200 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Iqaluit) {
    {-9223372036854775808 0 0 -00}
    {-865296000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {-147898800 -10800 1 EDDT}
    {-131569200 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}

    {-1615129200 -28800 0 PST}
    {-1601820000 -25200 1 PDT}
    {-1583679600 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-757353600 -28800 0 PST}
    {-687967200 -25200 1 PDT}
    {-662655600 -28800 0 PST}
    {-620834400 -25200 1 PDT}
    {-608137200 -28800 0 PST}
    {-589384800 -25200 1 PDT}
    {-576082800 -28800 0 PST}
    {-557935200 -25200 1 PDT}
    {-544633200 -28800 0 PST}
    {-526485600 -25200 1 PDT}
    {-513183600 -28800 0 PST}
    {-495036000 -25200 1 PDT}
    {-481734000 -28800 0 PST}
    {-463586400 -25200 1 PDT}
    {-450284400 -28800 0 PST}
    {-431532000 -25200 1 PDT}
    {-418230000 -28800 0 PST}
    {-400082400 -25200 1 PDT}
    {-386780400 -28800 0 PST}
    {-368632800 -25200 1 PDT}
    {-355330800 -28800 0 PST}
    {-337183200 -25200 1 PDT}
    {-323881200 -28800 0 PST}
    {-305733600 -25200 1 PDT}
    {-292431600 -28800 0 PST}
    {-273679200 -25200 1 PDT}
    {-260982000 -28800 0 PST}
    {-242229600 -25200 1 PDT}
    {-226508400 -28800 0 PST}
    {-210780000 -25200 1 PDT}
    {-195058800 -28800 0 PST}
    {-179330400 -25200 1 PDT}
    {-163609200 -28800 0 PST}
    {-147880800 -25200 1 PDT}
    {-131554800 -28800 0 PST}
    {-116431200 -25200 1 PDT}
    {-100105200 -28800 0 PST}
    {-94665600 -28800 0 PST}
    {-84376800 -25200 1 PDT}
    {-68655600 -28800 0 PST}
    {-52927200 -25200 1 PDT}
    {-37206000 -28800 0 PST}
    {-21477600 -25200 1 PDT}

    {-1615129200 -28800 0 PST}
    {-1601820000 -25200 1 PDT}
    {-1583679600 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-757353600 -28800 0 PST}
    {-687967140 -25200 1 PDT}
    {-662655600 -28800 0 PST}
    {-620838000 -25200 1 PDT}
    {-608137200 -28800 0 PST}
    {-589388400 -25200 1 PDT}
    {-576082800 -28800 0 PST}
    {-557938800 -25200 1 PDT}
    {-544633200 -28800 0 PST}
    {-526489200 -25200 1 PDT}
    {-513183600 -28800 0 PST}
    {-495039600 -25200 1 PDT}
    {-481734000 -28800 0 PST}
    {-463590000 -25200 1 PDT}
    {-450284400 -28800 0 PST}
    {-431535600 -25200 1 PDT}
    {-418230000 -28800 0 PST}
    {-400086000 -25200 1 PDT}
    {-386780400 -28800 0 PST}
    {-368636400 -25200 1 PDT}
    {-355330800 -28800 0 PST}
    {-337186800 -25200 1 PDT}
    {-323881200 -28800 0 PST}
    {-305737200 -25200 1 PDT}
    {-292431600 -28800 0 PST}
    {-273682800 -25200 1 PDT}
    {-260982000 -28800 0 PST}
    {-242233200 -25200 1 PDT}
    {-226508400 -28800 0 PST}
    {-210783600 -25200 1 PDT}
    {-195058800 -28800 0 PST}
    {-179334000 -25200 1 PDT}
    {-163609200 -28800 0 PST}
    {-147884400 -25200 1 PDT}
    {-131554800 -28800 0 PST}
    {-116434800 -25200 1 PDT}
    {-100105200 -28800 0 PST}
    {-94665600 -28800 0 PST}
    {-84376800 -25200 1 PDT}
    {-68655600 -28800 0 PST}
    {-52927200 -25200 1 PDT}
    {-37206000 -28800 0 PST}
    {-21477600 -25200 1 PDT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Pangnirtung) {
    {-9223372036854775808 0 0 zzz}
    {-1546300800 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-147902400 -7200 1 ADDT}
    {-131572800 -14400 0 AST}
    {325663200 -10800 1 ADT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Pangnirtung) {
    {-9223372036854775808 0 0 -00}
    {-1546300800 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-147902400 -7200 1 ADDT}
    {-131572800 -14400 0 AST}
    {325663200 -10800 1 ADT}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rankin_Inlet) {
    {-9223372036854775808 0 0 zzz}
    {-410227200 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rankin_Inlet) {
    {-9223372036854775808 0 0 -00}
    {-410227200 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Resolute) {
    {-9223372036854775808 0 0 zzz}
    {-704937600 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Resolute) {
    {-9223372036854775808 0 0 -00}
    {-704937600 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}

    {-1207242000 -28800 0 PST}
    {-873820800 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-761677200 -28800 0 PST}
    {-686073600 -25200 1 PDT}
    {-661539600 -28800 0 PST}
    {-504892800 -28800 0 PST}
    {-495036000 -25200 1 PDT}
    {-481734000 -28800 0 PST}
    {-463586400 -25200 1 PDT}
    {-450284400 -28800 0 PST}
    {-431532000 -25200 1 PDT}
    {-418230000 -28800 0 PST}
    {-400082400 -25200 1 PDT}
    {-386780400 -28800 0 PST}
    {-368632800 -25200 1 PDT}
    {-355330800 -28800 0 PST}
    {-337183200 -25200 1 PDT}
    {-323881200 -28800 0 PST}
    {-305733600 -25200 1 PDT}
    {-292431600 -28800 0 PST}
    {-283968000 -28800 0 PST}
    {189331200 -28800 0 PST}
    {199274400 -25200 1 PDT}
    {215600400 -28800 0 PST}
    {230724000 -25200 1 PDT}
    {247050000 -28800 0 PST}

    {-1207242000 -28800 0 PST}
    {-873820800 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-761677200 -28800 0 PST}
    {-686073600 -25200 1 PDT}
    {-661539600 -28800 0 PST}
    {-504892800 -28800 0 PST}
    {-495039600 -25200 1 PDT}
    {-481734000 -28800 0 PST}
    {-463590000 -25200 1 PDT}
    {-450284400 -28800 0 PST}
    {-431535600 -25200 1 PDT}
    {-418230000 -28800 0 PST}
    {-400086000 -25200 1 PDT}
    {-386780400 -28800 0 PST}
    {-368636400 -25200 1 PDT}
    {-355330800 -28800 0 PST}
    {-337186800 -25200 1 PDT}
    {-323881200 -28800 0 PST}
    {-305737200 -25200 1 PDT}
    {-292431600 -28800 0 PST}
    {-283968000 -28800 0 PST}
    {189331200 -28800 0 PST}
    {199274400 -25200 1 PDT}
    {215600400 -28800 0 PST}
    {230724000 -25200 1 PDT}
    {247050000 -28800 0 PST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Yellowknife) {
    {-9223372036854775808 0 0 zzz}
    {-1104537600 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {315558000 -25200 0 MST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Yellowknife) {
    {-9223372036854775808 0 0 -00}
    {-1104537600 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {315558000 -25200 0 MST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 zzz}
    {-31536000 28800 0 AWST}
    {1255802400 39600 0 CAST}
    {1267714800 28800 0 AWST}
    {1319738400 39600 0 CAST}
    {1329843600 28800 0 AWST}

}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 -00}
    {-31536000 28800 0 +08}
    {1255802400 39600 0 +11}
    {1267714800 28800 0 +08}
    {1319738400 39600 0 +11}
    {1329843600 28800 0 +08}
    {1477065600 39600 0 +11}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Davis) {
    {-9223372036854775808 0 0 zzz}
    {-409190400 25200 0 DAVT}
    {-163062000 0 0 zzz}
    {-28857600 25200 0 DAVT}
    {1255806000 18000 0 DAVT}
    {1268251200 25200 0 DAVT}
    {1319742000 18000 0 DAVT}
    {1329854400 25200 0 DAVT}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Davis) {
    {-9223372036854775808 0 0 -00}
    {-409190400 25200 0 +07}
    {-163062000 0 0 -00}
    {-28857600 25200 0 +07}
    {1255806000 18000 0 +05}
    {1268251200 25200 0 +07}
    {1319742000 18000 0 +05}
    {1329854400 25200 0 +07}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/DumontDUrville) {
    {-9223372036854775808 0 0 zzz}
    {-725846400 36000 0 PMT}
    {-566992800 0 0 zzz}
    {-415497600 36000 0 DDUT}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/DumontDUrville) {
    {-9223372036854775808 0 0 -00}
    {-725846400 36000 0 +10}
    {-566992800 0 0 -00}
    {-415497600 36000 0 +10}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Macquarie) {
    {-9223372036854775808 0 0 zzz}
    {-2214259200 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-1601719200 0 0 zzz}
    {-94730400 36000 0 AEST}
    {-71136000 39600 1 AEDT}
    {-55411200 36000 0 AEST}
    {-37267200 39600 1 AEDT}
    {-25776000 36000 0 AEST}
    {-5817600 39600 1 AEDT}
    {5673600 36000 0 AEST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Macquarie) {
    {-9223372036854775808 0 0 -00}
    {-2214259200 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-1601719200 0 0 -00}
    {-94730400 36000 0 AEST}
    {-71136000 39600 1 AEDT}
    {-55411200 36000 0 AEST}
    {-37267200 39600 1 AEDT}
    {-25776000 36000 0 AEST}
    {-5817600 39600 1 AEDT}
    {5673600 36000 0 AEST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Mawson) {
    {-9223372036854775808 0 0 zzz}
    {-501206400 21600 0 MAWT}
    {1255809600 18000 0 MAWT}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Mawson) {
    {-9223372036854775808 0 0 -00}
    {-501206400 21600 0 +06}
    {1255809600 18000 0 +05}
}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Palmer) {
    {-9223372036854775808 0 0 zzz}
    {-157766400 -14400 0 ART}
    {-152654400 -14400 0 ART}
    {-132955200 -10800 1 ARST}
    {-121122000 -14400 0 ART}
    {-101419200 -10800 1 ARST}
    {-86821200 -14400 0 ART}
    {-71092800 -10800 1 ARST}

# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Palmer) {
    {-9223372036854775808 0 0 -00}
    {-157766400 -14400 0 ART}
    {-152654400 -14400 0 ART}
    {-132955200 -10800 1 ARST}
    {-121122000 -14400 0 ART}
    {-101419200 -10800 1 ARST}
    {-86821200 -14400 0 ART}
    {-71092800 -10800 1 ARST}