Tcl Source Code

          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=4"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc

            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit --disable-shared"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LinkArray, Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)
.sp
.VS "TIP 312"
int
\fBTcl_LinkArray\fR(\fIinterp, varName, addr, type, size\fR)
.VE "TIP 312"
.sp
\fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
.sp
\fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
.SH ARGUMENTS
.AS Tcl_Interp varName in
.AP Tcl_Interp *interp in
Interpreter that contains \fIvarName\fR.
Also used by \fBTcl_LinkVar\fR to return error messages.
.AP "const char" *varName in
Name of global variable.
.AP void *addr in
Address of C variable that is to be linked to \fIvarName\fR.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, may be NULL to tell Tcl to create the storage
for the array in the variable.
.VE "TIP 312"
.AP int type in
Type of C variable for \fBTcl_LinkVar\fR or type of array element for
\fBTcl_LinkArray\fR.  Must be one of \fBTCL_LINK_INT\fR,
\fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
\fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
\fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR, \fBTCL_LINK_DOUBLE\fR,
\fBTCL_LINK_BOOLEAN\fR, or one of the extra ones listed below.
.sp
In \fBTcl_LinkVar\fR, the additional linked type \fBTCL_LINK_STRING\fR may be
used.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
.AP int size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE
.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
named by \fIvarName\fR in sync with the C variable at the address
given by \fIaddr\fR.
Whenever the Tcl variable is read the value of the C variable will
be returned, and whenever the Tcl variable is written the C
variable will be updated to have the same value.
\fBTcl_LinkVar\fR normally returns \fBTCL_OK\fR;  if an error occurs
while setting up the link (e.g. because \fIvarName\fR is the
name of array) then \fBTCL_ERROR\fR is returned and the interpreter's result
contains an error message.
.PP
.VS "TIP 312"
\fBTcl_LinkArray\fR is similar, but for arrays of fixed size (given by
the \fIsize\fR argument). When asked to allocate the backing C array
storage (via the \fIaddr\fR argument being NULL), it writes the
address that it allocated to the Tcl interpreter result.
.VE "TIP 312"
.PP
The \fItype\fR argument specifies the type of the C variable,
or the type of the elements of the C array,
and must have one of the following values, optionally OR'ed with
\fBTCL_LINK_READ_ONLY\fR:
.TP
\fBTCL_LINK_INT\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_UINT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned int\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned int\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_CHAR\fR
.
The C variable, or each element of the C array, is of type \fBchar\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBchar\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_CHARS\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_CHARS\fR
.VS "TIP 312"
The C array is of type \fBchar *\fR and is mapped into Tcl as a string.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_UCHAR\fR
.
The C variable, or each element of the C array, is of type \fBunsigned char\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned char\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_BYTES\fR
.VS "TIP 312"
The C array is of type \fBunsigned char *\fR and is mapped into Tcl
as a bytearray.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_SHORT\fR
.
The C variable, or each element of the C array, is of type \fBshort\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBshort\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_USHORT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned short\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned short\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_LONG\fR
.
The C variable, or each element of the C array, is of type \fBlong\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write
non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
integer representations (like the empty string, '+', '-' or the
hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_ULONG\fR
.
The C variable, or each element of the C array, is of type \fBunsigned long\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned long\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_DOUBLE\fR
.
The C variable, or each element of the C array, is of type \fBdouble\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer or real representations (like the
empty string, '.', '+', '-' or the hex/octal/binary prefix) are
accepted as if they are valid too.
.TP
\fBTCL_LINK_FLOAT\fR
.
The C variable, or each element of the C array, is of type \fBfloat\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
range acceptable for a \fBfloat\fR; attempts to
write non-real values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
or real representations (like the empty string, '.', '+', '-' or
the hex/octal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_WIDE_INT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideInt\fR
(which is an integer type
at least 64-bits wide on all platforms that can support it.)
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/binary prefix) are accepted
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
If its value is zero then it will read from Tcl as
.QW 0 ;
otherwise it will read from Tcl as
.QW 1 .
Whenever \fIvarName\fR is
modified, the C variable will be set to a 0 or 1 value.
Any value written into the Tcl variable must have a proper boolean
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR
.
The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .
This is only supported by \fBTcl_LinkVar\fR.
.PP
If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
variable will be read-only from Tcl, so that its value can only be
changed by modifying the C variable.
Attempts to write the variable from Tcl will be rejected with errors.
.PP
\fBTcl_UnlinkVar\fR removes the link previously set up for the

.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified) or the
class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may

.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified), or the
class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:

This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object (e.g., because it was created
through \fBoo::objdefine method\fR). Does not affect the classes that the
object is an instance of, or remove the exposure of those class-provided
methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. Note
that the actual list of filters also depends on the filters set upon any
classes that the object is an instance of.
By default, this slot works by appending.
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of and cannot rename in an instance object the
methods provided by those classes (though a \fBoo::objdefine forward\fRed
method may provide an equivalent capability). Does not change the export
status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500

elements in a manner similar to \fBarray get\fR. That is, the first
element of each pair would be the key and the second element would be
the value for that key.
.PP
It is an error to attempt to retrieve a value for a key that is not
present in the dictionary.
.RE
.TP
\fBdict getdef \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.TP
\fBdict getwithdefault \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.VS "8.7, TIP342"
This behaves the same as \fBdict get\fR (with at least one \fIkey\fR
argument), returning the value that the key path maps to in the
dictionary \fIdictionaryValue\fR, except that instead of producing an
error because the \fIkey\fR (or one of the \fIkey\fRs on the key path)
is absent, it returns the \fIdefault\fR argument instead.
.RS
.PP
Note that there must always be at least one \fIkey\fR provided, and that
\fBdict getdef\fR and \fBdict getwithdefault\fR are aliases for each other.
.RE
.VE "8.7, TIP342"
.TP
\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
.
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys

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

% lindex $var 1
elements to
% \fBlrange\fR $var 1 1
{elements to}
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lremove(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

'\"
'\" Copyright (c) 2019 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lremove n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbirary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES
.PP
Removing the third element of a list:
.PP
.CS
% \fBlremove\fR {a b c d e} 2
a b d e
.CE
.PP
Removing two elements from a list:
.PP
.CS
% \fBlremove\fR {a b c d e} end-1 1
a c e
.CE
.PP
Removing the same element indicated in two different ways:
.PP
.CS
% \fBlremove\fR {a b c d e} 2 end-2
a b d e
.CE
.SH "SEE ALSO"
list(n), lrange(n), lsearch(n), lsearch(n)
.SH KEYWORDS
element, list, remove
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lremove(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

.SH "SERIAL COMMUNICATIONS"
.PP
If \fIfileName\fR refers to a serial port, then the specified serial port
is opened and initialized in a platform-dependent manner.  Acceptable
values for the \fIfileName\fR to use to open a serial port are described in
the PORTABILITY ISSUES section.
.PP
The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query
and set additional configuration options specific to serial ports (where
supported):
.TP
\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
.
This option is a set of 4 comma-separated values: the baud rate, parity,
number of data bits, and number of stop bits for this serial port.  The
\fIbaud\fR rate is a simple integer that specifies the connection speed.
\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,

.TP
\fB\-xchar\fR \fI{xonChar xoffChar}\fR
.
(Windows and Unix). This option is used to query or change the software
handshake characters. Normally the operating system default should be
DC1 (0x11) and DC3 (0x13) representing the ASCII standard
XON and XOFF characters.
.TP
\fB\-closemode\fR \fIcloseMode\fR
.VS "8.7, TIP 160"
(Windows and Unix). This option is used to query or change the close mode of
the serial channel, which defines how pending output in operating system
buffers is handled when the channel is closed. The following values for
\fIcloseMode\fR are supported:
.RS
.TP
\fBdefault\fR
.
indicates that a system default operation should be used; all serial channels
default to this.
.TP
\fBdiscard\fR
.
indicates that the contents of the OS buffers should be discarded.  Note that
this is \fInot recommended\fR when writing to a POSIX terminal, as it can
interact unexpectedly with handling of \fBstderr\fR.
.TP
\fBdrain\fR
.
indicates that Tcl should wait when closing the channel until all output has
been consumed. This may slow down \fBclose\fR noticeably.
.RE
.VE "8.7, TIP 160"
.TP
\fB\-inputmode\fR \fIinputMode\fR
.VS "8.7, TIP 160"
(Unix only; Windows has the equivalent option on console channels). This
option is used to query or change the input mode of the serial channel under
the assumption that it is talking to a terminal, which controls how interactive
input from users is handled. The following values for \fIinputMode\fR are
supported:
.RS
.TP
\fBnormal\fR
.
indicates that normal line-oriented input should be used, with standard
terminal editing capabilities enabled.
.TP
\fBpassword\fR
.
indicates that non-echoing input should be used, with standard terminal
editing capabilities enabled but no writing of typed characters to the
terminal (except for newlines). Some terminals may indicate this specially.
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
terminal doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
indicates that the terminal should be reset to what state it was in when the
terminal was opened.
.PP
Note that setting this option (technically, anything that changes the terminal
state from its initial value \fIvia this option\fR) will cause the channel to
turn on an automatic reset of the terminal when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
(Unix only; Windows has the equivalent option on console channels). This
option is query only. It retrieves a two-element list with the the current
width and height of the terminal.
.VE "8.7, TIP 160"
.TP
\fB\-pollinterval\fR \fImsec\fR
.
(Windows only). This option is used to set the maximum time between
polling for fileevents.
This affects the time interval between checking for events throughout the Tcl
interpreter (the smallest value always wins).  Use this option only if

\fB\-lasterror\fR
.
(Windows only). This option is query only.
In case of a serial communication error, \fBread\fR or \fBputs\fR
returns a general Tcl file I/O error.
\fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details.
See below for an explanation of the various error codes.
.SS "SERIAL PORT SIGNALS"
.PP
RS-232 is the most commonly used standard electrical interface for serial
communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and
a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C).  The
following signals are specified for incoming and outgoing data, status
lines and handshaking. Here we are using the terms \fIworkstation\fR for
your computer and \fImodem\fR for the external device, because some signal

.IP \fBBREAK\fR
A BREAK condition is not a hardware signal line, but a logical zero on the
TXD or RXD lines for a long period of time, usually 250 to 500
milliseconds.  Normally a receive or transmit data signal stays at the mark
(on=1) voltage until the next character is transferred. A BREAK is sometimes
used to reset the communications line or change the operating mode of
communications hardware.
.SS "ERROR CODES (Windows only)"
.PP
A lot of different errors may occur during serial read operations or during
event polling in background. The external device may have been switched
off, the data lines may be noisy, system buffers may overrun or your mode
settings may be wrong.  That is why a reliable software should always
\fBcatch\fR serial read operations.  In cases of an error Tcl returns a
general file I/O error.  Then \fBfconfigure\fR \fB\-lasterror\fR may help to

A stop-bit error has been detected by your UART.
Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBBREAK\fR
.
A BREAK condition has been detected by your UART (see above).
.SS "PORTABILITY ISSUES"
.TP
\fBWindows \fR
.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9.  An attempt to open a serial port that

not accessing the console, or if the command pipeline does not use standard
input, but is redirected from a file, then the above problem does not occur.
.RE
.PP
See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
additional information not specific to command pipelines about executing
applications on the various platforms
.SH "CONSOLE CHANNELS"
.VS "8.7, TIP 160"
On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR)
support the following options:
.TP
\fB\-inputmode\fR \fIinputMode\fR
.
This option is used to query or change the input mode of the console channel,
which controls how interactive input from users is handled. The following
values for \fIinputMode\fR are supported:
.RS
.TP
\fBnormal\fR
.
indicates that normal line-oriented input should be used, with standard
console editing capabilities enabled.
.TP
\fBpassword\fR
.
indicates that non-echoing input should be used, with standard console
editing capabilitied enabled but no writing of typed characters to the
terminal (except for newlines).
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
console doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
indicates that the console should be reset to what state it was in when the
console channel was opened.
.PP
Note that setting this option (technically, anything that changes the console
state from its default \fIvia this option\fR) will cause the channel to turn
on an automatic reset of the console when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
This option is query only.
It retrieves a two-element list with the the current width and height of the
console that this channel is talking to.
.PP
Note that the equivalent options exist on Unix, but are on the serial channel
type.
.VE "8.7, TIP 160"
.SH "EXAMPLES"
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
    puts "ls command failed: $err"
}
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
.PP
.CS
chan configure stdin \fB-inputmode password\fR
try {
    chan puts -nonewline "Password: "
    chan flush stdout
    set thePassword [chan gets stdin]
} finally {
    chan configure stdin \fB-inputmode reset\fR
}
.CE
.VE "8.7, TIP 160"
.SH "SEE ALSO"
file(n), close(n), filename(n), fconfigure(n), gets(n), read(n),
puts(n), exec(n), pid(n), fopen(3)
.SH KEYWORDS
access mode, append, create, file, non-blocking, open, permissions,
pipeline, process, serial
'\"Local Variables:
'\"mode: nroff
'\"End:

string.  \fIcharIndex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
.TP
\fBstring insert \fIstring index insertString\fR
.VS "TIP 504"
Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
\fIindex\fR'th character.  The \fIindex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIindex\fR is start-relative, the first character inserted in the returned
string will be at the specified index.  If \fIindex\fR is end-relative, the last
character inserted in the returned string will be at the specified index.
.PP
If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR.  If \fIindex\fR is at
or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
\fIinsertString\fR is appended to \fIstring\fR.
.RE
.VE "TIP 504"
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function

\fIpattern\fR.
.RE
.TP
\fBstring range \fIstring first last\fR
.
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
\fBSTRING INDICES\fR). An index of \fB0\fR refers to the first
character of the string; an index of \fBend\fR refers to last
character of the string.  \fIfirst\fR and \fIlast\fR may be specified
as for the \fBindex\fR method.  If \fIfirst\fR is less than zero then
it is treated as if it were zero, and if \fIlast\fR is greater than or
equal to the length of the string then it is treated as if it were
\fBend\fR.  If \fIfirst\fR is greater than \fIlast\fR then an empty
string is returned.
.TP
\fBstring repeat \fIstring count\fR
.
Returns a string consisting of \fIstring\fR concatenated with itself
\fIcount\fR times. If \fIcount\fR is 0, the empty string will be
returned.
.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
.
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
\fBSTRING INDICES\fR).  An index of 0 refers to the
first character of the string.  \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method.  If \fInewstring\fR is
specified, then it is placed in the removed character range.  If
\fIfirst\fR is less than zero then it is treated as if it were zero,
and if \fIlast\fR is greater than or equal to the length of the string
then it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater
than \fIlast\fR or the length of the initial string, or \fIlast\fR is

'\"
'\" Copyright (c) 2005 Sergey Brester aka sebres.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH timerate n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
timerate \- Calibrated performance measurements of script execution time
.SH SYNOPSIS
\fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.sp
\fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR?
.BE
.SH DESCRIPTION
.PP
The \fBtimerate\fR command does calibrated performance measurement of a Tcl
command or script, \fIscript\fR. The \fIscript\fR should be written so that it
can be executed multiple times during the performance measurement process.
Time is measured in elapsed time using the finest timer resolution as possible,
not CPU time; if \fIscript\fR interacts with the OS, the cost of that
interaction is included.
This command may be used to provide information as to how well a script or
Tcl command is performing, and can help determine bottlenecks and fine-tune
application performance.
.PP
The first and second form will evaluate \fIscript\fR until the interval
\fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second)
if \fItime\fR is not specified.
.sp
The parameter \fImax-count\fR could additionally impose a further restriction
by the maximal number of iterations to evaluate the script.
If \fImax-count\fR is specified, the evalution will stop either this count of
iterations is reached or the time is exceeded.
.sp
It will then return a canonical tcl-list of the form:
.PP
.CS
\fB0.095977 \(mcs/# 52095836 # 10419167 #/sec 5000.000 nett-ms\fR
.CE
.PP
which indicates:
.IP \(bu 3
the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0])
.IP \(bu 3
the count how many times it was executed ([\fBlindex\fR $result 2])
.IP \(bu 3
the estimated rate per second ([\fBlindex\fR $result 4])
.IP \(bu 3
the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6])
.PP


The following options may be supplied to the \fBtimerate\fR command:


.TP
\fB\-calibrate\fR
.
To measure very fast scripts as exactly as possible, a calibration process
may be required.

The \fB\-calibrate\fR option is used to calibrate \fBtimerate\fR itself,
calculating the estimated overhead of the given script as the default overhead
for future invocations of the \fBtimerate\fR command. If the \fItime\fR
parameter is not specified, the calibrate procedure runs for up to 10 seconds.
.RS
.PP
Note that calibration is not thread safe in the current implementation.
.RE
.TP
\fB\-overhead \fIdouble\fR
.
The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the
measurement overhead of each iteration of the tested script. This quantity
will be subtracted from the measured time prior to reporting results. This can
be useful for removing the cost of interpreter state reset commands from the
script being measured.
.TP
\fB\-direct\fR
.
The \fB-direct\fR option causes direct execution of the supplied script,
without compilation, in a manner similar to the \fBtime\fR command. It can be
used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical
lists, and of the uncompiled versions of bytecoded commands.
.PP
As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed
number of iterations, the timerate command runs it for a fixed time.
Additionally, the compiled variant of the script will be used during the entire
measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR
option is not specified. The fixed time period and possibility of compilation allow
for more precise results and prevent very long execution times by slow scripts, making
it practical for measuring scripts with highly uncertain execution times.

.SH EXAMPLES
Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including
operations on variable \fIi\fR) to count to ten:
.PP
.CS
\fI# calibrate\fR
\fBtimerate\fR -calibrate {}

\fI# measure\fR
\fBtimerate\fR { for {set i 0} {$i<10} {incr i} {} } 5000
.CE
.PP
Estimate how fast it takes for a simple Tcl \fBfor\fR loop, ignoring the

overhead of the management of the variable that controls the loop:
.PP
.CS
\fI# calibrate for overhead of variable operations\fR
set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000

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

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

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

}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
    char *Tcl_JoinPath(int argc, const char *const *argv,
	    Tcl_DString *resultPtr)
}
declare 187 {
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr,
	    int type)
}

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

    void Tcl_DecrRefCount(Tcl_Obj *objPtr)
}

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}

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

# TIP #542
declare 645 {
    Tcl_Obj *Tcl_NewUnicodeObj(const int *unicode, int numChars)
}
declare 646 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const int *unicode,
	    int numChars)
}
declare 647 {
    int *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 648 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const int *unicode,
	    int length)
}
declare 649 {
    int Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 650 {
    char *Tcl_UniCharToUtfDString(const int *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 651 {
    int *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 652 {
    int Tcl_UniCharLen(const int *uniStr)
}
declare 653 {
    int Tcl_UniCharNcmp(const int *ucs, const int *uct,
	    unsigned long numChars)
}
declare 654 {
    int Tcl_UniCharNcasecmp(const int *ucs, const int *uct,
	    unsigned long numChars)
}
declare 655 {
    int Tcl_UniCharCaseMatch(const int *uniStr,
	    const int *uniPattern, int nocase)
}


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

#define TCL_LINK_ULONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_CHARS		15
#define TCL_LINK_BINARY		16
#define TCL_LINK_READ_ONLY	0x80

/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

    ASSEM_BOOL_LVT4,		/* One Boolean, one 4-byte LVT ref. */
    ASSEM_CLOCK_READ,		/* 1-byte unsigned-integer case number, in the
				 * range 0-3 */
    ASSEM_CONCAT1,		/* 1-byte unsigned-integer operand count, must
				 * be strictly positive, consumes N, produces
				 * 1 */
    ASSEM_DICT_GET,		/* 'dict get' and related - consumes N+1
				 * operands, produces 1, N > 0 */
    ASSEM_DICT_GET_DEF,		/* 'dict getwithdefault' - consumes N+2
				 * operands, produces 1, N > 0 */
    ASSEM_DICT_SET,		/* specifies key count and LVT index, consumes
				 * N+1 operands, produces 1, N > 0 */
    ASSEM_DICT_UNSET,		/* specifies key count and LVT index, consumes
				 * N operands, produces 1, N > 0 */
    ASSEM_END_CATCH,		/* End catch. No args. Exception range popped
				 * from stack and stack pointer restored. */

    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
    {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
    {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,1},
    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
    {"dictGetDef",	ASSEM_DICT_GET_DEF, INST_DICT_GET_DEF,	INT_MIN,1},
    {"dictIncrImm",	ASSEM_SINT4_LVT4,
					INST_DICT_INCR_IMM,	1,	1},
    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
    {"dictUnset",	ASSEM_DICT_UNSET,

    int count)			/* Count of operands for variadic insts */
{
    int consumed = TalInstructionTable[tblIdx].operandsConsumed;
    int produced = TalInstructionTable[tblIdx].operandsProduced;

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

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

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

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

static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

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

MODULE_SCOPE const TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */

    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},

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

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

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

	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}

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

	cmdPtr = Tcl_GetHashValue(hPtr);

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

	 */

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

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

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

	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {

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

	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}

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

	cmdPtr = Tcl_GetHashValue(hPtr);

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

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

    /*
     * Lookup the Command to dispatch.
     */

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

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

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

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

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

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


	Tcl_IncrRefCount(commandPtr);
	if (!enterTracesDone) {

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

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

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

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

	     */

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

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

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

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



    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
     * This only needs to be done for the first item in the list: all other
     * are for NR function calls, and those are Tcl_Obj based.
     */

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

    /*
     * This is the trampoline.
     */

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

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

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

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

	listPtr = Tcl_NewListObj(objc, objv);

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

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

                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

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

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

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

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

static int
NRPostInvoke(

	kini("line");	kini("level");
#undef kini
    }
    for (i = 0; i < 6; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
	args[i] = val ? TclGetString(val) : NULL;
    }

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

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

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

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

     * at the proper time.
     */

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

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

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

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }

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

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

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

    /*
     * Look up the coroutine.
     */

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

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

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

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

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

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

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

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

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

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

    /*

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

	return;
    }

    length = (unsigned int)len;

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {

/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this

     * bytecompiled - in that case, the return was a copy of the body's string
     * rep. In order to better isolate the implementation details of the
     * compiler/engine subsystem, we now always return a copy of the string
     * rep. It is important to return a copy so that later manipulations of
     * the object do not invalidate the internal rep.
     */

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

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

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

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);

{
    Tcl_Command command;

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

    /*
     * There's one special case: safe slave interpreters can't see aliases as

	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

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

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

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

    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;

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

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

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

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

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

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

    return TCL_OK;
}

/*

    if (result != TCL_OK) {
	return result;
    }

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

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

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

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

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

    /*
     * Parse the arguments.
     */

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

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

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

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

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

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

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

	/*
	 * Repeated index and sanity check.
	 */

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

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

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

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

    }

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

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

    if (last >= listLen) {

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

     */

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

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

	     */

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

		if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" cannot select an element "
			    "from any list", TclGetString(indexv[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));

    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

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

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

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

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringInsertCmd --
 *
 *	This procedure is invoked to process the "string insert" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

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

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

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

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

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

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

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * StringIsCmd --
 *
 *	This procedure is invoked to process the "string is" Tcl command. See
 *	the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:

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

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

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

	return TCL_ERROR;
    }

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

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

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

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

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

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

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

    static const EnsembleImplMap stringImplMap[] = {
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},

     */

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

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

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

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

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

    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };

    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;

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

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
	}
	if (index == TMRT_LAST) {
	    i++;
	    break;

	    break;
	case TMRT_CALIBRATE:
	    calibrate = objv[i];
	    break;
	}
    }

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

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

    /*
     * If we are doing calibration.
     */

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

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

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

	    /*
	     * Reset last measurement overhead.
	     */

	    measureOverhead = (double) 0;

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

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

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

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

	    measureOverhead = (double) UWIDE_MAX;

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

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

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

		maxms -= -maxms / 4;

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


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

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

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

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

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

    }

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

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

    Tcl_ResetResult(interp);

    /*
     * Compile object if needed.
     */

    if (!direct) {
	if (TclInterpReady(interp) != TCL_OK) {
	    return TCL_ERROR;
	}
	codePtr = TclCompileObj(interp, objPtr, NULL, 0);
	TclPreserveByteCode(codePtr);
    }

    /*
     * Get start and stop time.
     */

#ifdef TCL_WIDE_CLICKS
    start = middle = TclpGetWideClicks();

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

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

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

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

    /*
     * Start measurement.
     */

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

	     */

	    count++;
	    if (!direct) {		/* precompiled */

		rootPtr = TOP_CB(interp);
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */

		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }
	    if (result != TCL_OK) {
		/*
		 * Allow break from measurement cycle (used for conditional
		 * stop).
		 */

		if (result != TCL_BREAK) {
		    goto done;
		}

		/*
		 * Force stop immediately.
		 */

		threshold = 1;
		maxcnt = 0;
		result = TCL_OK;
	    }

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

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

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

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

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

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

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

	    /*
	     * Average iteration time in microsecs.
	     */

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

		/*
		 * Iterations seem to be longer.
		 */



		if (threshold > maxIterTm * 2) {
		    factor *= 2;

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

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

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

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

	    /*
	     * Consider max-count
	     */

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

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

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

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

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

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

	/*
	 * If not calibrating...
	 */

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

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

		Tcl_WideUInt curOverhead = overhead * count;

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

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

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

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

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

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

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

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

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

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

  done:

    if (codePtr != NULL) {
	TclReleaseByteCode(codePtr);
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TryObjCmd, TclNRTryObjCmd --

	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

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

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

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

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

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

		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */

    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	goto notCompilable;
    }
    bytes = TclGetString(objPtr);

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

    }

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

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

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

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

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,	envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

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

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

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

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

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

	if (idx < (int)TCL_INDEX_END) {
	    idx++;
	}
	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx - 1,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    }

    return TCL_OK;
}


     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (idx2 == (int)TCL_INDEX_NONE) {
	suffixStart = idx1;
    } else if (idx2 == (int)TCL_INDEX_END) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (((idx2 < (int)TCL_INDEX_END) && (idx1 <= (int)TCL_INDEX_END))
	    || ((idx2 >= (int)TCL_INDEX_START) && (idx1 >= (int)TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {
	return TCL_ERROR;
    }

    /* All paths start with computing/pushing the original value. */
    CompileWord(envPtr, listTokenPtr, interp, 1);

    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    if (idx1 != (int)TCL_INDEX_START) {
	/* Prefix may not be empty; generate bytecode to push it */
	if (emptyPrefix) {
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	}
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx1 - 1,		envPtr);
	if (!emptyPrefix) {
	    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
	emptyPrefix = 0;
    }

    if (!emptyPrefix) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    if (suffixStart == (int)TCL_INDEX_NONE) {
	TclEmitOpcode(		INST_POP,			envPtr);
	if (emptyPrefix) {
	    PushStringLiteral(envPtr, "");
	}
    } else {
	/* Suffix may not be empty; generate bytecode to push it */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	if (!emptyPrefix) {
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
    }

    return TCL_OK;
}

    Tcl_DStringInit(&pattern);
    tokenPtr = TokenAfter(tokenPtr);
    patternObj = Tcl_NewObj();
    if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
	goto done;
    }
    if (TclGetString(patternObj)[0] == '-') {
	if (strcmp(TclGetString(patternObj), "--") != 0
		|| parsePtr->numWords == 5) {
	    goto done;
	}
	tokenPtr = TokenAfter(tokenPtr);
	Tcl_DecrRefCount(patternObj);
	patternObj = Tcl_NewObj();
	if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {

	    }
	case '\0': case '?': case '[': case '\\':
	    goto done;
	}
	bytes++;
    }
  isSimpleGlob:
    for (bytes = TclGetString(replacementObj); *bytes; bytes++) {
	switch (*bytes) {
	case '\\': case '&':
	    goto done;
	}
    }

    /*

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}

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

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

    /* Compute and push the string in which to insert */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /* See what can be discovered about index at compile time */
    tokenPtr = TokenAfter(tokenPtr);
    if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
	    TCL_INDEX_END, &idx)) {

	/* Nothing useful knowable - cease compile; let it direct eval */
	return TCL_OK;
    }

    /* Compute and push the string to be inserted */
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    if (idx == (int)TCL_INDEX_START) {
	/* Prepend the insertion string */
	OP4(	REVERSE, 2);
	OP1(	STR_CONCAT1, 2);
    } else  if (idx == (int)TCL_INDEX_END) {
	/* Append the insertion string */
	OP1(	STR_CONCAT1, 2);
    } else {
	/* Prefix + insertion + suffix */
	if (idx < (int)TCL_INDEX_END) {
	    /* See comments in compiler for [linsert]. */
	    idx++;
	}
	OP4(	OVER, 1);
	OP44(	STR_RANGE_IMM, 0, idx-1);
	OP4(	REVERSE, 3);
	OP44(	STR_RANGE_IMM, idx, TCL_INDEX_END);
	OP1(	STR_CONCAT1, 3);
    }

    return TCL_OK;
}

int
TclCompileStringIsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being

    if (parsePtr->numWords == 4) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	str = tokenPtr[1].start;
	length = tokenPtr[1].size;
	if ((length <= 1) || strncmp(str, "-nocase", length)) {
	    /*
	     * Fail at run time, not in compilation.
	     */

	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	nocase = 1;

	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == (int)TCL_INDEX_NONE) {
	/* [string range $s $first -1] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    /*

     *		(last < 0)		OR
     *		(end < first)
     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

    if ((last == (int)TCL_INDEX_NONE)		/* Know (last < 0) */
	    || (first == (int)TCL_INDEX_NONE)	/* Know (first > end) */

	/*
	 * Tricky to determine when runtime (last < first) can be
	 * certainly known based on the encoded values. Consider the
	 * cases...
	 *
	 * (first <= TCL_INDEX_END) &&
	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
	 *	else => cannot tell REJECT
	 */
	    || ((first <= (int)TCL_INDEX_END) && (last <= (int)TCL_INDEX_END)
		&& (last < first))		/* Know (last < first) */
	/*
	 * (first == TCL_INDEX_NONE) &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else		=> (first < last) REJECT
	 *
	 * else [[first >= TCL_INDEX_START]] &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
	 */
	    || ((first >= (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)
		&& (last < first))) {		/* Know (last < first) */
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP(		POP);		/* Pop newString */
	}
	/* Original string argument now on TOS as result */

     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */

    if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == INT_MAX) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }

    if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	return TCL_OK;
    }

	/* FLOW THROUGH TO genericReplace */

    } else {
	/*
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
	 * are harmless when they are replaced by another empty string.
	 */

	if (first == (int)TCL_INDEX_START) {
	    /* empty prefix - build suffix only */

	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix too => empty result */
		OP(	POP);		/* Pop  original */
		PUSH	(	"");
		return TCL_OK;
	    }
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    return TCL_OK;
	} else {
	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix - build prefix only */
		OP44(	STR_RANGE_IMM, 0, first-1);
		return TCL_OK;
	    }
	    OP(		DUP);
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    OP4(	REVERSE, 2);
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	    return TCL_OK;
	}
    }

    genericReplace:
	tokenPtr = TokenAfter(valueTokenPtr);

	 * Stack:  ... varName list => ... listVarContents */

    {"clockRead",	 2,	+1,	1,	{OPERAND_UINT1}},
        /* Read clock out to the stack. Operand is which clock to read
	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
	 * Stack: ... => ... time */

    {"dictGetDef",	  5,	INT_MIN,   1,	{OPERAND_UINT4}},
	/* The top word is the default, the next op4 words (min 1) are a key
	 * path into the dictionary just below the keys on the stack, and all
	 * those values are replaced by the value read out of that key-path
	 * (like [dict get]) except if there is no such key, when instead the
	 * default is pushed instead.
	 * Stack:  ... dict key1 ... keyN default => ... value */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
};

/*
 * Prototypes for procedures defined later in this file:
 */

#define INST_LAPPEND_LIST		185
#define INST_LAPPEND_LIST_ARRAY		186
#define INST_LAPPEND_LIST_ARRAY_STK	187
#define INST_LAPPEND_LIST_STK		188

#define INST_CLOCK_READ			189

#define INST_DICT_GET_DEF		190

/* The last opcode */
#define LAST_INST_OPCODE		190

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"

/* 185 */
EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
				Tcl_DString *resultPtr);
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				void *addr, int type);
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);

/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				int size);
/* 645 */
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const int *unicode, int numChars);
/* 646 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const int *unicode, int numChars);
/* 647 */
EXTERN int *		Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 648 */
EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const int *unicode, int length);
/* 649 */
EXTERN int		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 650 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 651 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 652 */
EXTERN int		Tcl_UniCharLen(const int *uniStr);
/* 653 */
EXTERN int		Tcl_UniCharNcmp(const int *ucs, const int *uct,
				unsigned long numChars);
/* 654 */
EXTERN int		Tcl_UniCharNcasecmp(const int *ucs, const int *uct,
				unsigned long numChars);
/* 655 */
EXTERN int		Tcl_UniCharCaseMatch(const int *uniStr,
				const int *uniPattern, int nocase);

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

    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */

    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, int size); /* 644 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const int *unicode, int numChars); /* 645 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const int *unicode, int numChars); /* 646 */
    int * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 647 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const int *unicode, int length); /* 648 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 649 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 650 */
    int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 651 */
    int (*tcl_UniCharLen) (const int *uniStr); /* 652 */
    int (*tcl_UniCharNcmp) (const int *ucs, const int *uct, unsigned long numChars); /* 653 */
    int (*tcl_UniCharNcasecmp) (const int *ucs, const int *uct, unsigned long numChars); /* 654 */
    int (*tcl_UniCharCaseMatch) (const int *uniStr, const int *uniPattern, int nocase); /* 655 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

	(tclStubsPtr->tcl_HasStringRep) /* 640 */
#define Tcl_IncrRefCount \
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
	(tclStubsPtr->tcl_LinkArray) /* 644 */
#define Tcl_NewUnicodeObj \
	(tclStubsPtr->tcl_NewUnicodeObj) /* 645 */
#define Tcl_SetUnicodeObj \
	(tclStubsPtr->tcl_SetUnicodeObj) /* 646 */
#define Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 647 */
#define Tcl_AppendUnicodeToObj \
	(tclStubsPtr->tcl_AppendUnicodeToObj) /* 648 */
#define Tcl_UtfToUniChar \
	(tclStubsPtr->tcl_UtfToUniChar) /* 649 */
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 650 */
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 651 */
#define Tcl_UniCharLen \
	(tclStubsPtr->tcl_UniCharLen) /* 652 */
#define Tcl_UniCharNcmp \
	(tclStubsPtr->tcl_UniCharNcmp) /* 653 */
#define Tcl_UniCharNcasecmp \
	(tclStubsPtr->tcl_UniCharNcasecmp) /* 654 */
#define Tcl_UniCharCaseMatch \
	(tclStubsPtr->tcl_UniCharCaseMatch) /* 655 */

#endif /* defined(USE_TCL_STUBS) */

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

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp

#undef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#undef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#ifdef TCL_NO_DEPRECATED
#undef Tcl_GetStringResult
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#undef Tcl_Eval
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, 0)
#undef Tcl_GlobalEval
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#undef Tcl_SaveResult

			    int objc, Tcl_Obj *const *objv);
static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetDefCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictLappendCmd(ClientData dummy, Tcl_Interp *interp,

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
    {"getdef",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd, NULL,NULL,0},
    {"getwithdefault",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd,
	NULL, NULL, 0 },
    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
    {"info",	DictInfoCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    {"keys",	DictKeysCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
    {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
    {"merge",	DictMergeCmd,	TclCompileDictMergeCmd, NULL, NULL, 0 },
    {"remove",	DictRemoveCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },

    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictGetDefCmd --
 *
 *	This function implements the "dict getdef" and "dict getwithdefault"
 *	Tcl commands. See the user documentation for details on what it does,
 *	and TIP#342 for the formal specification.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetDefCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
    Tcl_Obj *const *keyPath;
    int numKeys;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...? key default");
	return TCL_ERROR;
    }

    /*
     * Give the bits of arguments names for clarity.
     */

    dictPtr = objv[1];
    keyPath = &objv[2];
    numKeys = objc - 4;		/* Number of keys in keyPath; there's always
				 * one extra key afterwards too. */
    keyPtr = objv[objc - 2];
    defaultPtr = objv[objc - 1];

    /*
     * Implement the getting-with-default operation.
     */

    dictPtr = TclTraceDictPath(interp, dictPtr, numKeys, keyPath,
	    DICT_PATH_EXISTS);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr) != TCL_OK) {
	return TCL_ERROR;
    } else if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else {
	Tcl_SetObjResult(interp, valuePtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictReplaceCmd --
 *
 *	This function implements the "dict replace" Tcl command. See the user
 *	documentation for details on what it does, and TIP#111 for the formal
 *	specification.
 *
 * Results:

    Tcl_Obj *dictPtr, *valuePtr;

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

    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS);

    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT ||

	    Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
    }
    return TCL_OK;
}


	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
	    type1 = 0;
	} else if (type1 == TCL_NUMBER_BIG) {
	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
	    Tcl_WideInt w;

	    if (TclGetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
		type1 = TCL_NUMBER_INT;
	    }
	}
	TclNewIntObj(objResultPtr, type1);
	TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1));
	NEXT_INST_F(1, 1, 1);

	    TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 1, 0);


    case INST_DICT_EXISTS: {

	register int found;

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);



	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(NULL, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_EXISTS);
	    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT) {

		found = 0;
		goto afterDictExists;
	    }





	}

	if (Tcl_DictObjGet(NULL, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {

	    found = (objResultPtr ? 1 : 0);



















	} else {
	    found = 0;
	}
    afterDictExists:
	TRACE_APPEND(("%d\n", found));

	/*
	 * The INST_DICT_EXISTS instruction is usually followed by a
	 * conditional jump, so we can take advantage of this to do some
	 * peephole optimization (note that we're careful to not close out
	 * someone doing something else).
	 */

	JUMP_PEEPHOLE_V(found, 5, opnd+1);
    }
    case INST_DICT_GET:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd);
	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ);
	    if (dictPtr == NULL) {
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    }
	}
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	if (!objResultPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS)));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), NULL);
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(5, opnd+1, 1);
    case INST_DICT_GET_DEF:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = OBJ_AT_DEPTH(opnd+1);
	if (opnd > 1) {
	    dictPtr = TclTraceDictPath(interp, dictPtr, opnd-1,
		    &OBJ_AT_DEPTH(opnd), DICT_PATH_EXISTS);
	    if (dictPtr == NULL) {
		TRACE_WITH_OBJ((
			"ERROR tracing dictionary path into \"%.30s\": ",
			O2S(OBJ_AT_DEPTH(opnd+1))),
			Tcl_GetObjResult(interp));
		goto gotError;
	    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
		goto dictGetDefUseDefault;
	    }
	}
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
		&objResultPtr) != TCL_OK) {
	    TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s",
		    O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	} else if (!objResultPtr) {
	dictGetDefUseDefault:
	    objResultPtr = OBJ_AT_TOS;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(5, opnd+2, 1);

    case INST_DICT_SET:
    case INST_DICT_UNSET:
    case INST_DICT_INCR_IMM:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);

	if (w1 == -2) {
	    int signum = oddExponent ? -1 : 1;

	    /*
	     * Reduce small powers of 2 to shifts.
	     */

	    if ((Tcl_WideUInt) w2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) {
		WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
	    }
	    goto overflowExpon;
	}
	if (w2 - 2 < (long)MaxBase64Size
		&& w1 <=  MaxBase64[w2 - 2]
		&& w1 >= -MaxBase64[w2 - 2]) {

		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
		WIDE_RESULT(wResult);
	    }
	}

    overflowExpon:

	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)

		|| (value2Ptr->typePtr != &tclIntType)
		|| (Tcl_WideUInt)w2 >= (1<<28)) {



	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "exponent too large", -1));
	    return GENERAL_ARITHMETIC_ERROR;
	}
	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
	mp_init(&bigResult);
	mp_expt_d_ex(&big1, w2, &bigResult, 1);
	mp_clear(&big1);

	BIG_RESULT(&bigResult);
    }

    case INST_ADD:
    case INST_SUB:
    case INST_MULT:
    case INST_DIV:

	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;

    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
    }

    UpdateInterest(chanPtr);

    return total;
}

/*
 *---------------------------------------------------------------------------
 *

	     * - It does not process all events in the event queue, but only
	     *	 one, at least in some situations.
	     *
	     * In that case we can get into a situation where
	     *
	     * - Tcl drops READABLE here, because it has data in its own
	     *	 buffers waiting to be read by the extension.
	     * - A READABLE event is synthesized via timer.
	     * - The OS still reports the EXCEPTION condition on the file.
	     * - And the extension gets the EXCEPTION event first, and handles
	     *	 this as EOF.
	     *
	     * End result ==> Premature end of reading from a file.
	     *
	     * The concrete example is 'Expect', and its [expect] command
	     * (and at the C-level, deep in the bowels of Expect,
	     * 'exp_get_next_event'. See marker 'SunOS' for commentary in

	    if (!statePtr->timer) {
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
	    }
	}
    }

    if (!statePtr->timer
	&& mask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --

static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
	&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
	) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
    }

    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
	    && (statePtr->interestMask & TCL_READABLE)
	    && (statePtr->inQueueHead != NULL)
	    && IsBufferReady(statePtr->inQueueHead)) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);

	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);

    } else {

	UpdateInterest(chanPtr);
    }
    Tcl_Release(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *

			    int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static void     TimerRunRead(ClientData clientData);
static void     TimerRunWrite(ClientData clientData);

/*
 * The C layer channel type/driver definition used by the reflection. This is
 * a version 3 structure.
 */

static const Tcl_ChannelType tclRChannelType = {

    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */

    Tcl_TimerToken readTimer;   /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is readable
			        */
    Tcl_TimerToken writeTimer;  /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is writable
			        */

    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *


     * A timer is used here as well in order to ensure at least on pass through

     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * ef28eb1f1516.
     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'

    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
	if (events & TCL_READABLE) {
	    if (rcPtr->readTimer == NULL) {
		rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunRead, rcPtr);
	    }
	}
	if (events & TCL_WRITABLE) {
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

    Tcl_ResetResult(interp);
    return TCL_OK;

#undef CHAN
#undef EVENT
}

static void
TimerRunRead(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    rcPtr->readTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}

static void
TimerRunWrite(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    rcPtr->writeTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}

/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
MarshallError(

#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree(tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
	if (rcPtr->readTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->readTimer);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */

    }
#endif
    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	ckfree(tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    if (rcPtr->readTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->readTimer);
    }
    if (rcPtr->writeTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*
 *----------------------------------------------------------------------
 *

    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
    rcPtr->readTimer = 0;
    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */

			    const char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,

			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LpopObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LremoveObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetWithDefaultCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringInsertCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLastCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

 *
 * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the bignum out of the bignum
 * representation of a Tcl_Obj.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum);
 *----------------------------------------------------------------
 */

#define TclUnpackBignum(objPtr, bignum) \
    do {								\
	register Tcl_Obj *bignumObj = (objPtr);				\
	register int bignumPayload =					\
		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
	if (bignumPayload == -1) {					\
	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
	} else {							\
	    (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1;	\
	    (bignum).sign = bignumPayload >> 30;			\
	    (bignum).alloc = (bignumPayload >> 15) & 0x7fff;		\
	    (bignum).used = bignumPayload & 0x7fff;			\
	}								\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclGrowTokenArray(Tcl_Token *tokenPtr, int used,

/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 Rene Zaumseil
 * Copyright (c) 2019 Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include <math.h>

/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl
 * variable.
 */

typedef struct Link {
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    int bytes;			/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    int numElems;		/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
	short s;
	unsigned short us;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	long l;
	unsigned long ul;
#endif
	Tcl_WideInt w;
	Tcl_WideUInt uw;
	float f;
	double d;
	void *aryPtr;		/* Generic array. */
	char *cPtr;		/* char array */
	unsigned char *ucPtr;	/* unsigned char array */
	short *sPtr;		/* short array */
	unsigned short *usPtr;	/* unsigned short array */
	int *iPtr;		/* int array */
	unsigned int *uiPtr;	/* unsigned int array */
	long *lPtr;		/* long array */
	unsigned long *ulPtr;	/* unsigned long array */
	Tcl_WideInt *wPtr;	/* wide (long long) array */
	Tcl_WideUInt *uwPtr;	/* unsigned wide (long long) array */
	float *fPtr;		/* float array */
	double *dPtr;		/* double array */
    } lastValue;		/* Last known value of C variable; used to
				 * avoid string conversions. */
    int flags;			/* Miscellaneous one-bit values; see below for
				 * definitions. */
} Link;

/*
 * Definitions for flag bits:
 * LINK_READ_ONLY -		1 means errors should be generated if Tcl
 *				script attempts to write variable.
 * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
 *				in progress for this variable, so trace
 *				callbacks on the variable should be ignored.
 * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the
 *				heap.
 * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on
 *				the heap.
 */

#define LINK_READ_ONLY		1
#define LINK_BEING_UPDATED	2
#define LINK_ALLOC_ADDR		4
#define LINK_ALLOC_LAST		8

/*
 * Forward references to functions defined later in this file:
 */

static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static Tcl_Obj *	ObjValue(Link *linkPtr);
static void		LinkFree(Link *linkPtr);
static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);

static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
			    double *doublePtr);
static int		SetInvalidRealFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);

/*
 * A marker type used to flag weirdnesses so we can pass them around right.
 */

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
 * is not strictly a good thing, but it keeps the code much shorter and

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

int
Tcl_LinkVar(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. */
    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY, LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->nsPtr = NULL;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
	linkPtr->type = TCL_LINK_LONG;
    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
	linkPtr->type = TCL_LINK_ULONG;
    }
#endif
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }
    linkPtr->bytes = 0;
    linkPtr->numElems = 0;
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	return TCL_ERROR;
    }

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinkArray --
 *
 *	Link a C variable array to a Tcl variable so that changes to either
 *	one causes the other to change.
 *
 * Results:
 *	The return value is TCL_OK if everything went well or TCL_ERROR if an
 *	error occurred (the interp's result is also set after errors).
 *
 * Side effects:
 *	The value at *addr is linked to the Tcl variable "varName", using
 *	"type" to convert between string values for Tcl and binary values for
 *	*addr.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LinkArray(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    int size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    if (size < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong array size given", -1));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
    linkPtr->numElems = size;
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
    case TCL_LINK_BOOLEAN:
	linkPtr->bytes = size * sizeof(int);
	break;
    case TCL_LINK_DOUBLE:
	linkPtr->bytes = size * sizeof(double);
	break;
    case TCL_LINK_WIDE_INT:
	linkPtr->bytes = size * sizeof(Tcl_WideInt);
	break;
    case TCL_LINK_WIDE_UINT:
	linkPtr->bytes = size * sizeof(Tcl_WideUInt);
	break;
    case TCL_LINK_CHAR:
	linkPtr->bytes = size * sizeof(char);
	break;
    case TCL_LINK_UCHAR:
	linkPtr->bytes = size * sizeof(unsigned char);
	break;
    case TCL_LINK_SHORT:
	linkPtr->bytes = size * sizeof(short);
	break;
    case TCL_LINK_USHORT:
	linkPtr->bytes = size * sizeof(unsigned short);
	break;
    case TCL_LINK_UINT:
	linkPtr->bytes = size * sizeof(unsigned int);
	break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	linkPtr->bytes = size * sizeof(long);
	break;
    case TCL_LINK_ULONG:
	linkPtr->bytes = size * sizeof(unsigned long);
	break;
#endif
    case TCL_LINK_FLOAT:
	linkPtr->bytes = size * sizeof(float);
	break;
    case TCL_LINK_STRING:
	linkPtr->bytes = size * sizeof(char);
	size = 1;		/* This is a variable length string, no need
				 * to check last value. */

	/*
	 * If no address is given create one and use as address the
         * not needed linkPtr->lastValue
	 */

	if (addr == NULL) {
	    linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
	    linkPtr->flags |= LINK_ALLOC_LAST;
	    addr = (char *) &linkPtr->lastValue.cPtr;
	}
	break;
    case TCL_LINK_CHARS:
    case TCL_LINK_BINARY:
	linkPtr->bytes = size * sizeof(char);
	break;
    default:
	LinkFree(linkPtr);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad linked array variable type", -1));
	return TCL_ERROR;
    }

    /*
     * Allocate C variable space in case no address is given
     */

    if (addr == NULL) {
	linkPtr->addr = ckalloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_ADDR;
    } else {
	linkPtr->addr = addr;
    }

    /*
     * If necessary create space for last used value.
     */

    if (size > 1) {
	linkPtr->lastValue.aryPtr = ckalloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_LAST;
    }

    /*
     * Initialize allocated space.
     */

    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	memset(linkPtr->addr, 0, linkPtr->bytes);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memset(linkPtr->lastValue.aryPtr, 0, linkPtr->bytes);
    }

    /*
     * Set common structure values.
     */

    linkPtr->interp = interp;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	return TCL_ERROR;
    }

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *

    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    LinkFree(linkPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *

	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetInt, GetWide, GetUWide, GetDouble, EqualDouble, IsSpecial --
 *
 *	Helper functions for LinkTraceProc and ObjValue. These are all
 *	factored out here to make those functions simpler.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetInt(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    return (Tcl_GetIntFromObj(NULL, objPtr, intPtr) != TCL_OK
	    && GetInvalidIntFromObj(objPtr, intPtr) != TCL_OK);
}

static inline int
GetWide(
    Tcl_Obj *objPtr,
    Tcl_WideInt *widePtr)
{
    if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) {
	int intValue;

	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	    return 1;
	}
	*widePtr = intValue;
    }
    return 0;
}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
    ClientData clientData;
    int type, intValue;

    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
	if (type == TCL_NUMBER_INT) {
	    *widePtr = *((const Tcl_WideInt *) clientData);
	    return (*widePtr < 0);
	} else if (type == TCL_NUMBER_BIG) {
	    mp_int *numPtr = clientData;
	    Tcl_WideUInt value = 0;
	    union {
		Tcl_WideUInt value;
		unsigned char bytes[sizeof(Tcl_WideUInt)];
	    } scratch;
	    unsigned long numBytes = sizeof(Tcl_WideUInt);
	    unsigned char *bytes = scratch.bytes;

	    if (numPtr->sign || (MP_OKAY != mp_to_unsigned_bin_n(numPtr,
		    bytes, &numBytes))) {
		/*
		 * If the sign bit is set (a negative value) or if the value
		 * can't possibly fit in the bits of an unsigned wide, there's
		 * no point in doing further conversion.
		 */
		return 1;
	    }
#ifdef WORDS_BIGENDIAN
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
#else /* !WORDS_BIGENDIAN */
	    /*
	     * Little-endian can read the value directly.
	     */
	    value = scratch.value;
#endif /* WORDS_BIGENDIAN */
	    *uwidePtr = value;
	    return 0;
	}
    }

    /*
     * Evil edge case fallback.
     */

    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	return 1;
    }
    *uwidePtr = intValue;
    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)
{
    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
	return 0;
    } else {
#ifdef ACCEPT_NAN
	Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType);

	if (irPtr != NULL) {
	    *dblPtr = irPtr->doubleValue;
	    return 0;
	}
#endif /* ACCEPT_NAN */
	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
    }
}

static inline int
EqualDouble(
    double a,
    double b)
{
    return (a == b)
#ifdef ACCEPT_NAN
	|| (TclIsNaN(a) && TclIsNaN(b))
#endif /* ACCEPT_NAN */
	;
}

static inline int
IsSpecial(
    double a)
{
    return TclIsInfinite(a)
#ifdef ACCEPT_NAN
	|| TclIsNaN(a)
#endif /* ACCEPT_NAN */
	;
}

/*
 * Mark an object as holding a weird double.
 */

static int
SetInvalidRealFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;

    str = TclGetString(objPtr);
    if ((objPtr->length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
	/*
	 * If number is followed by [eE][+-]?, then it is an invalid
	 * double, but it could be the start of a valid double.
	 */

	if (*endPtr == 'e' || *endPtr == 'E') {
	    ++endPtr;
	    if (*endPtr == '+' || *endPtr == '-') {
		++endPtr;
	    }
	    if (*endPtr == 0) {
		double doubleValue = 0.0;

		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &invalidRealType;
		objPtr->internalRep.doubleValue = doubleValue;
		return TCL_OK;
	    }
	}
    }
    return TCL_ERROR;
}

/*
 * This function checks for integer representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
 * (upperand lowercase). See bug [39f6304c2e].
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    const char *str = TclGetString(objPtr);

    if ((objPtr->length == 0) || ((objPtr->length == 2) && (str[0] == '0')
	    && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((objPtr->length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 * This function checks for double representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "+", "-", "", ".", "0x", "0b" and "0o"
 * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
 */

static int
GetInvalidDoubleFromObj(
    Tcl_Obj *objPtr,
    double *doublePtr)
{
    int intValue;

    if (TclHasIntRep(objPtr, &invalidRealType)) {
	goto gotdouble;
    }
    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
	*doublePtr = (double) intValue;
	return TCL_OK;
    }
    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
    gotdouble:
	*doublePtr = objPtr->internalRep.doubleValue;
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * LinkTraceProc --
 *
 *	This function is invoked when a linked Tcl variable is read, written,
 *	or unset from Tcl. It's responsible for keeping the C variable in sync
 *	with the Tcl variable.
 *
 * Results:

    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    int changed;
    int valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    int objc;
    Tcl_Obj **objv;
    int i;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    LinkFree(linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, Tcl_GetString(linkPtr->varName), NULL,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
	}

    /*
     * For read accesses, update the Tcl variable if the C variable has
     * changed since the last time we updated the Tcl variable.
     */

    if (flags & TCL_TRACE_READS) {
	/*
	 * Variable arrays
	 */

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    changed = memcmp(linkPtr->addr, linkPtr->lastValue.aryPtr,
		    linkPtr->bytes);
	} else {
	    /* single variables */
	    switch (linkPtr->type) {
	    case TCL_LINK_INT:
	    case TCL_LINK_BOOLEAN:
		changed = (LinkedVar(int) != linkPtr->lastValue.i);
		break;
	    case TCL_LINK_DOUBLE:
		changed = !EqualDouble(LinkedVar(double), linkPtr->lastValue.d);
		break;
	    case TCL_LINK_WIDE_INT:
		changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
		break;
	    case TCL_LINK_WIDE_UINT:
		changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
		break;
	    case TCL_LINK_CHAR:
		changed = (LinkedVar(char) != linkPtr->lastValue.c);
		break;
	    case TCL_LINK_UCHAR:
		changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
		break;
	    case TCL_LINK_SHORT:
		changed = (LinkedVar(short) != linkPtr->lastValue.s);
		break;
	    case TCL_LINK_USHORT:
		changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
		break;
	    case TCL_LINK_UINT:
		changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
		break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	    case TCL_LINK_LONG:
		changed = (LinkedVar(long) != linkPtr->lastValue.l);
		break;
	    case TCL_LINK_ULONG:
		changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
		break;
#endif
	    case TCL_LINK_FLOAT:
		changed = !EqualDouble(LinkedVar(float), linkPtr->lastValue.f);
		break;
	    case TCL_LINK_STRING:
	    case TCL_LINK_CHARS:
	    case TCL_LINK_BINARY:
		changed = 1;
		break;
	    default:
		changed = 0;
		/* return (char *) "internal error: bad linked variable type"; */
	    }
	}
	if (changed) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	}
	return NULL;
    }

	/*
	 * This shouldn't ever happen.
	 */

	return (char *) "internal error: linked variable couldn't be read";
    }


































































































































    /*

     * Special cases.
     */








    switch (linkPtr->type) {











    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
	} else {
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) Tcl_GetByteArrayFromObj(valueObj, &valueLength);
	if (valueLength != linkPtr->bytes) {
	    return (char *) "wrong size of binary value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, (size_t) valueLength);
	    memcpy(linkPtr->addr, value, (size_t) valueLength);
	} else {
	    linkPtr->lastValue.uc = (unsigned char) *value;
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
	}
	return NULL;
    }

    /*
     * A helper macro. Writing this as a function is messy because of type
     * variance.
     */

#define InRange(lowerLimit, value, upperLimit)			\
    ((value) >= (lowerLimit) && (value) <= (upperLimit))

    /*
     * If we're working with an array of numbers, extract the Tcl list.
     */

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
		|| objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (GetInt(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have integer values";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (GetInt(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have integer value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	break;

    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		Tcl_WideInt *varPtr = &linkPtr->lastValue.wPtr[i];

		if (GetWide(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have wide integer value";
		}
	    }
	} else {
	    Tcl_WideInt *varPtr = &linkPtr->lastValue.w;

	    if (GetWide(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have wide integer value";
	    }
	    LinkedVar(Tcl_WideInt) = *varPtr;
	}
	break;

    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &linkPtr->lastValue.dPtr[i])) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *) "variable array must have real value";
		}
	    }
	} else {
	    double *varPtr = &linkPtr->lastValue.d;

	    if (GetDouble(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have real value";
	    }
	    LinkedVar(double) = *varPtr;
	}
	break;

    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have boolean value";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have boolean value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	break;

    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have char value";
		}
		linkPtr->lastValue.cPtr[i] = (char) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have char value";
	    }
	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
	}
	break;

    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, UCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have unsigned char value";
		}
		linkPtr->lastValue.ucPtr[i] = (unsigned char) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(0, valueInt, UCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned char value";
	    }
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc =
		    (unsigned char) valueInt;
	}
	break;

    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have short value";
		}
		linkPtr->lastValue.sPtr[i] = (short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have short value";
	    }
	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
	}
	break;

    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, USHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			"variable array must have unsigned short value";
		}
		linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
	    }
	} else {
	    if (GetInt(valueObj, &valueInt)
		    || !InRange(0, valueInt, USHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned short value";
	    }
	    LinkedVar(unsigned short) = linkPtr->lastValue.us =
		    (unsigned short) valueInt;
	}
	break;

    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(0, valueWide, UINT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned int value";
		}
		linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)
		    || !InRange(0, valueWide, UINT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned int value";
	    }
	    LinkedVar(unsigned int) = linkPtr->lastValue.ui =
		    (unsigned int) valueWide;
	}
	break;

#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have long value";
		}
		linkPtr->lastValue.lPtr[i] = (long) valueWide;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)
		    || !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have long value";
	    }
	    LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide;
	}
	break;

    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)
			|| !InRange(0, valueUWide, ULONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned long value";
		}
		linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)
		    || !InRange(0, valueUWide, ULONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned long value";
	    }
	    LinkedVar(unsigned long) = linkPtr->lastValue.ul =
		    (unsigned long) valueUWide;
	}
	break;
#endif

    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned wide int value";
		}
		linkPtr->lastValue.uwPtr[i] = valueUWide;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned wide int value";
	    }
	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = valueUWide;
	}
	break;

    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &valueDouble)
			&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		        && !IsSpecial(valueDouble)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have float value";
		}
		linkPtr->lastValue.fPtr[i] = (float) valueDouble;
	    }
	} else {
	    if (GetDouble(valueObj, &valueDouble)
		    && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		    && !IsSpecial(valueDouble)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have float value";
	    }
	    LinkedVar(float) = linkPtr->lastValue.f = (float) valueDouble;
	}
	break;

    default:
	return (char *) "internal error: bad linked variable type";
    }

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ObjValue --

 */

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    int i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewIntObj(linkPtr->lastValue.i);
    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.wPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.uiPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ui = LinkedVar(unsigned int);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.lPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.l = LinkedVar(long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.ulPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ul = LinkedVar(unsigned long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);



	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}
	return Tcl_NewStringObj(p, -1);

    case TCL_LINK_CHARS:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    linkPtr->lastValue.cPtr[linkPtr->bytes-1] = '\0';
	    /* take care of proper string end */
	    return Tcl_NewStringObj(linkPtr->lastValue.cPtr, linkPtr->bytes);
	}
	linkPtr->lastValue.c = '\0';
	return Tcl_NewStringObj(&linkPtr->lastValue.c, 1);

    case TCL_LINK_BINARY:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    return Tcl_NewByteArrayObj((unsigned char *) linkPtr->addr,
		    linkPtr->bytes);
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewByteArrayObj(&linkPtr->lastValue.uc, 1);

    /*
     * This code only gets executed if the link type is unknown (shouldn't
     * ever happen).
     */

    default:
	TclNewLiteralStringObj(resultObj, "??");
	return resultObj;
    }
}


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


 * LinkFree --




 *




 *	Free's allocated space of given link and link structure.
 *
















 * Results:


 *	None.





 *
 * Side effects:
 *	None.
 *





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




static void


LinkFree(







    Link *linkPtr)		/* Structure describing linked variable. */


{
    if (linkPtr->nsPtr) {
	TclNsDecrRefCount(linkPtr->nsPtr);


    }
    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	ckfree(linkPtr->addr);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {










	ckfree(linkPtr->lastValue.aryPtr);


    }

    ckfree((char *) linkPtr);








}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

	 * both. Allocate a new struct and insert elements into it.
	 */

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

	if (needGrow) {
	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(NULL, newMax, NULL);
	if (listRepPtr == NULL) {

	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}

int
TclNamespaceDeleted(
    Namespace *nsPtr)
{
    return (nsPtr->flags & NS_DYING) ? 1 : 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTeardownNamespace --
 *
 *	Used internally to dismantle and unlink a namespace when it is

    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

    Tcl_DStringInit(&buffer);
    for (i = 0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i = 0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);

    /*
     * Create the special objects at the core of the object system.
     */

    InitClassSystemRoots(interp, fPtr);

    /*
     * Basic method declarations for the core classes.
     */

    for (i = 0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i = 0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
     */

	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }


  configNamespace:

    ((Namespace *) oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

    if (fPtr->helpersNs != NULL) {

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr =
		    clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1];

	    /*
	     * This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */

	    if (!Deleted(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    }
    if (clsPtr->subclasses.size > 0) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1];

	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);

    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;

    if (Deleted(oPtr)) {
	/*
	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
	 * this guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DELETED;

    /*
     * Let the dominoes fall!
     */

    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
	int result;

	Tcl_InterpState state;

	oPtr->flags |= DESTRUCTOR_CALLED;

	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
		    contextPtr, 0, NULL);
	    if (result != TCL_OK) {
		Tcl_BackgroundException(interp, result);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if it
     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command

    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */


    /* TODO: Should this be protected with a !IsRoot() condition? */


    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}

     */

    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}


Object *
TclNewObjectInstanceCommon(
    Tcl_Interp *interp,
    Class *classPtr,
    const char *nameStr,
    const char *nsNameStr)
{
    Tcl_HashEntry *hPtr;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    const char *simpleName = NULL;
    Namespace *nsPtr = NULL, *dummy;
    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);


    if (nameStr) {
	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
	if (hPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	    return NULL;
	}







    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);

	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}



static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];

	ckfree(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}

	/*
	 * For the reference just created in DUPLICATE.
	 */

	AddRef(mixinPtr->thisPtr);
    }

    /*
     * Copy the object's filter list to the new object.
     */

     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;

	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

	    /*
	     * For the new item in cls2Ptr->superclasses that memcpy just
	     * created.
	     */

	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    ckfree(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);

	    /*
	     * For the copy just created in DUPLICATE.
	     */

	    AddRef(mixinPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's methods, constructor and destructor.
	 */

    int skip)
{
    CallContext *contextPtr = (CallContext *) context;
    int savedIndex = contextPtr->index;
    int savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv,
    int skip)
{
    register CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	int i;

	for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when
	 * we're doing unknown processing.
	 */

    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    int i;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------

    } else {
	ckfree(strings);
	*stringsPtr = NULL;
    }
    return i;
}

/*
 * Comparator for SortMethodNames
 */

static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;

    }

    /*
     * First test whether the method is already in the call chain. Skip over
     * any leading filters.
     */

    for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
	if (callPtr->chain[i].mPtr == mPtr &&
		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
	    /*
	     * Call chain semantics states that methods come as *late* in the
	     * call chain as possible. This is done by copying down the
	     * following methods. Note that this does not change the number of
	     * method invocations in the call chain; it just rearranges them.
	     */

	    Class *declCls = callPtr->chain[i].filterDeclarer;

	    for (; i + 1 < callPtr->numChain ; i++) {
		callPtr->chain[i] = callPtr->chain[i + 1];
	    }
	    callPtr->chain[i].mPtr = mPtr;
	    callPtr->chain[i].isFilter = (doneFilters != NULL);
	    callPtr->chain[i].filterDeclarer = declCls;
	    return;
	}
    }

     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;