Tcl Source Code

# Tcl/Tk 9.0b2 Release Announcement
April ??, 2024

The Tcl Core Team is pleased to announce the 9.0b2 releases of the Tcl
dynamic language and the Tk graphical interface package.  These are the
second beta releases of Tcl 9.0 and Tk 9.0.  More details can be found below.

We would like to express our gratitude to all those who submit bug
reports and patches.  This information is invaluable in enabling us
to identify and eliminate problems in the core. Such reports can be
submitted here.


        https://core.tcl-lang.org/tcl/ticket
        https://core.tcl-lang.org/tk/ticket

We ask that you log in (anonymous if you wish) to create tickets.
This deters abuse of the ticketing system.

## Contents
 1. [Where to get the new releases](#wheretoget)
 2. [General Summary](#summary)
 3. [Some of the most noteworthy changes](#changes)
 4. [Tcl Improvement Proposals (TIPs)](#tips)
 5. [Additional support resources](#support)
 6. [For additional information](#info)

## <a id="wheretoget">1.</a> Where to get the new releases

Tcl/Tk 9.0b2 sources are freely available as open source from the Tcl
SourceForge project's file distribution area:

        https://sourceforge.net/projects/tcl/files/

This distribution is source code only.  We keep links to some third
parties offering pre-built binaries for various systems here:

        https://www.tcl-lang.org/software/tcltk/bindist.html

## <a id="summary">2.</a> General Summary

These are new major versions of both Tcl and Tk.  There are new features
to be enjoyed.  There are incompatibilities to be considered. The list
of both is long and detailed and not fully included here.  We believe many
scripts written for Tcl 8 will run unchanged in Tcl 9.  We believe many more
can be modified in small and simple ways to produce a new script that runs
in both Tcl 8 and Tcl 9.  We expect that extensions and applications using
the public C APIs of Tcl and Tk will involve more effort, but that it is
still within reasonable reach to produce source code supporting both Tcl 8
and Tcl 9 while both releases remain in widespread use.

These are beta releases.  The developers believe the new feature set is
complete enough and the code quality is high enough that it is time for
a larger audience of Tcl/Tk users to give them a try and report back
to the developers what difficulties need resolution before stable
releases of Tcl/Tk 9.0.0.

The experiences of Tcl/Tk 8 users adapting their code to the beta releases
of Tcl/Tk 9 will shape the final interfaces of Tcl/Tk 9.0.0, and will
determine the need for possible Tcl/Tk 8.7 releases that might supply
additional lifecycle and migration support.

It is not recommended to deploy these beta releases directly to mission
critical use without significant testing and review.

## <a id="changes">3.</a> Some of the most noteworthy changes

Tcl 9:

  * 64-bit capacity: Data values larger than 2Gb

  * Internationalization of text
    - Full Unicode range of codepoints
    - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc.
    - [encoding] options -profile, -failindex manage encoding of I/O.
    - [msgcat] supports custom locale search list
    - [source] defaults to -encoding utf-8

  * Zip filesystems and attached archives.

  * Unix notifiers available using epoll() or kqueue()
    - relieves limits on file descriptors imposed by legacy select()

  * Notable incompatibilities
    - Unqualified varnames resolved in current namespace, not global.
    - No --disable-threads build option.  Always thread-enabled.
    - I/O malencoding default response: raise error (-profile strict)
    - Windows platform needs Windows 7 or Windows Server 2008 R2 or later
    - Ended interpretation of ~ as home directory in pathnames
    - Removed the "identity" encoding
    - $::tcl_precision no longer controls string generation of doubles
    - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes
    - Removed subcommands [trace variable|vdelete|vinfo]
    - No -eofchar option for channels anymore for writing.
    - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8.

  * Incompatibilities in C public interface
    - Many arguments expanded type from int to Tcl_Size
    - Ended support for Tcl_ChannelTypeVersion less than 5
    - Introduced versioning of the Tcl_ObjType struct
    - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support
    - Removed routines:
        Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(),
        Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(),
        Tcl_(Get|Set)DefaultEncodingDir(),
        Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch()

  * New commands
    - [array default], [array for]
    - [coroinject], [coroprobe]
    - [clock add weekdays]
    - [const], [info const*]
    - [dict getdefault]
    - [file tempdir], [file home], [file tildeexpand]
    - [info commandtype]
    - [ledit]
    - [lpop]
    - [lremove]
    - [lseq]
    - [package files]
    - [string insert], [string is dict]
    - [tcl::process]
    - [*::build-info]

  * New command options
    - [regsub ... -command ...]
    - [lsearch ... -stride ...]
    - [clock scan ... -validate ...]
    - [socket ... -nodelay ... -keepalive ...]
    - [vwait] controlled by several new options

  * Numbers
    - 0NNN format is no longer octal interpretation. Use 0oNNN.
    - 0dNNNN format to compel decimal interpretation.
    - NN_NNN_NNN, underscores in numbers for optional readability
    - Functions: isinf() isnan() isnormal() issubnormal() isunordered()
    - [fpclassify]
    - Function int() no longer truncates to word size

  * tcl::oo facilities
    - private variable and methods
    - [method -export], [method -unexport]

Tk 9:

  * Many improvements to use of platform features and conventions.
    - Built-in widgets and themes are scaling-aware.
    - Improved support of two-finger gestures, where available
    - The [tk windowingsystem] "aqua" needs macOS 10.10 or later

  * New commands and options
    - [tk sysnotify]: access to the OS notifications system
    - [tk systray]: access to the OS tray facility
    - [tk print]: access to the OS printing facility

  * Widget options
    - New ttk::progressbar option: -text
    - [$frame ... -backgroundimage $img -tile $bool]
    - [$menu id], [$menu add|insert ... ?$id? ...]
    - [$image get ... -withalpha ...]
    - All indices now accept the forms "end", "end-int", "int+|-int"

  * Improved widget appearance
    - ttk::notebook with nondefault tab positions

  * Images
    - Partial SVG support
    - Read/write access to photo image metadata

## <a id="tips">4.</a> Tcl Improvement Proposals (TIPs)

Each new user-visible feature in Tcl or Tk should find its origins in
a Tcl Improvement Proposal (TIP).  TIPs are published, edited, considered
and voted in public, and should contain valuable information about how
a feature came to be the way it is.  See the full collection here:

    https://tip.tcl-lang.org/

## <a id="support">5.</a> Additional support resources

See the following links for an accumulation of migration advice:

https://core.tcl-lang.org/tcl/wiki?name=Migrating+C+extensions+to+Tcl+9
https://core.tcl-lang.org/tcl/wiki?name=Migrating+scripts+to+Tcl+9

There has been much progress already porting many known applications,
extensions, and packages in the Tcl world to compatibility with Tcl/Tk 9:

https://wiki.tcl-lang.org/page/Apps+confirmed+to+work+with+Tcl+9
https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9

## <a id="info">6.</a> For additional information:

Please visit the Tcl Developer Xchange web site:

        https://www.tcl-lang.org/

This site contains a variety of information about Tcl/Tk in general, the
core Tcl and Tk distributions, Tcl development tools, and much more.

--
Tcl Core Team and Maintainers
Don Porter, Tcl Core Release Manager

'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2023 Nathan Coulter
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
.SH DESCRIPTION
.PP
The following rules define the syntax and semantics of the Tcl language:
.
.IP "[1] \fBScript.\fR"
A script is composed of zero or more commands delimited by semi-colons or
newlines.



.IP "[2] \fBCommand.\fR"
A command is composed of zero or more words delimited by whitespace.  The

replacement for a substitution is included verbatim in the word. For example, a
space in the replacement is included in the word rather than becoming a
delimiter, and \fI\\\\\fR becomes a single backslash in the word.  Each word is
processed from left to right and each substitution is performed as soon as it
is complete.

For example, the command
.RS
.PP
.CS
set y [set x 0][incr x][incr x]
.CE
.PP
is composed of three words, and sets the value of \fIy\fR to \fI012\fR.
.PP
If hash


.PQ #
is the first character of what would otherwise be the first word of a command,
all characters up to the next newline are ignored.
.RE
.
.IP "[3] \fBBraced word.\fR"
If a word is enclosed in braces
.PQ {

and
.PQ } ""
, the braces are removed and the enclosed characters become the word.  No
substitutions are performed.  Nested pairs of braces may occur within the word.
A brace preceded by an odd number of backslashes is not considered part of a
pair, and neither brace nor the backslashes are removed from the word.
.
.IP "[4] \fBQuoted word.\fR"
If a word is enclosed in double quotes
.PQ \N'34'



, the double quotes are removed and the enclosed characters become the word.

Substitutions are performed.
.

.IP "[5] \fBList.\fR"
A list has the form of a single command.  Newline is whitespace, and semicolon
has no special interpretation.  There is no script evaluation so there is no
argument expansion, variable substitution, or command substitution: Dollar-sign
and open bracket have no special interpretation, and what would be argument
expansion in a script is invalid in a list.
.
.IP "[6] \fBArgument expansion.\fR"
If
.QW {*}
prefixes a word, it is removed.  After any remaining enclosing braces or quotes

are processed and applicable substitutions performed, the word, which must
be a list, is removed from the command, and in its place each word in the
list becomes an additional word in the command.  For example,
.CS
cmd a {*}{b [c]} d {*}{$e f {g h}}
.CE
is equivalent to
.CS
cmd a b {[c]} d {$e} f {g h} .
.CE


.
.IP "[7] \fBEvaluation.\fR"
To evaluate a script, an interpreter evaluates each successive command.  The
first word identifies a procedure, and the remaining words are passed to that

procedure for further evaluation.  The procedure interprets each argument in
its own way, e.g. as an integer, variable name, list, mathematical expression,
script, or in some other arbitrary way.  The result of the last command is the






result of the script.
.

.IP "[8] \fBCommand substitution.\fR"
Each pair of brackets
.PQ [
and




.PQ ] ""
encloses a script and is replaced by the result of that script.




.IP "[9] \fBVariable substitution.\fR"
Each of the following forms begins with dollar sign
.PQ $
and is replaced by the value of the identified variable.  \fIname\fR names the
variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and
\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace
delimiters (two or more colons).  \fIindex\fR is the name of an individual

variable within an array variable, and may be empty.

.RS
.TP 15
\fB$\fIname\fR
.
\fIname\fR may not be empty.




.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.







\fIname\fR may be empty.  Substitutions are performed on \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
.


\fIname\fR may be empty.


.TP 15

\fB${\fIname(index)\fB}\fR



.
\fIname\fR may be empty. No substitutions are performed.





.RE
Variables that are not accessible through one of the forms above may be
accessed through other mechanisms, e.g. the \fBset\fR command.
.IP "[10] \fBBackslash substitution.\fR"
Each backslash
.PQ \e


that is not part of one of the forms listed below is removed, and the next
character is included in the word verbatim, which allows the inclusion of
characters that would normally be interpreted, namely whitespace, braces,


brackets, double quote, dollar sign, and backslash.  The following sequences
are replaced as described:
.RS
.RS
.RS
.TP 7
\e\fBa\fR
.
Audible alert (bell) (U+7).
.TP 7
\e\fBb\fR
.
Backspace (U+8).
.TP 7
\e\fBf\fR
.
Form feed (U+C).
.TP 7
\e\fBn\fR
.
Newline (U+A).
.TP 7
\e\fBr\fR
.
Carriage-return (U+D).
.TP 7
\e\fBt\fR
.
Tab (U+9).
.TP 7
\e\fBv\fR
.
Vertical tab (U+B).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
Newline preceded by an odd number of backslashes, along with the consecutive
spaces and tabs that immediately follow it, is replaced by a single space.
Because this happens before the command is split into words, it occurs even

within braced words, and if the resulting space may subsequently be treated as
a word delimiter.
.TP 7
\e\e
.
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR
.

Up to three octal digits form an eight-bit value for a Unicode character in the
range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF.  Only the digits that result in a


number in this range are consumed.
.TP 7
\e\fBx\fIhh\fR
.
Up to two hexadecimal digits form an eight-bit value for a Unicode character in


the range \fI0\fR\(en\fIFF\fR.
.TP 7
\e\fBu\fIhhhh\fR
.
Up to four hexadecimal digits form a 16-bit value for a Unicode character in


the range \fI0\fR\(en\fIFFFF\fR.
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
Up to eight hexadecimal digits form a 21-bit value for a Unicode character in

the range \fI0\fR\(en\fI10FFFF\fR.  Only the digits that result in a number in
this range are consumed.

.RE
.RE
.PP


.RE




















.

















.SH KEYWORDS
backslash, command, comment, script, substitution, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

The result of the \fBunknown\fR command is used as the result for
the original non-existent command.
.PP
The default implementation of \fBunknown\fR behaves as follows.
It first calls the \fBauto_load\fR library procedure to load the command.
If this succeeds, then it executes the original command with its
original arguments.
If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR
to see if there is an executable file by the name \fIcmd\fR.
If so, it invokes the Tcl \fBexec\fR command
with \fIcmd\fR and all the \fIargs\fR as arguments.
If \fIcmd\fR cannot be auto-executed, \fBunknown\fR checks to
see if the command was invoked at top-level and outside of any
script.  If so, then \fBunknown\fR takes two additional steps.
First, it sees if \fIcmd\fR has one of the following three forms:

declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    void *clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
}
# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 82 {
    int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
    char *Tcl_Concat(Tcl_Size argc, const char *const *argv)
}
declare 84 {

 * README.md		(sections 0 and 2, with and without separator)
 * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
 * win/README		(not patchlevel) (sections 0 and 2)
 * unix/tcl.spec	(1 LOC patch)
 */

#if !defined(TCL_MAJOR_VERSION)
#   define TCL_MAJOR_VERSION   9
#endif
#if TCL_MAJOR_VERSION != 9
#   error "This header-file is for Tcl 9 only"
#endif
#define TCL_MINOR_VERSION   1
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  0

#ifndef RC_INVOKED

/*
 * Special macro to define mutexes.
 */

#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;


/*
 * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
 * SEEK_END, all #define'd by stdio.h .
 *
 * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
 * providing it for them rather than #include-ing it themselves as they

/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
    Tcl_Size start;			/* Character offset of first character in
				 * match. */
    Tcl_Size end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    Tcl_Size nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    Tcl_Size extendStart;		/* The offset at which a subsequent match
				 * might begin. */
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

	void *clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (void *clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);

/* Abstract List functions */
typedef	      Tcl_Size	(Tcl_ObjTypeLengthProc)  (struct Tcl_Obj *listPtr);
typedef		   int	(Tcl_ObjTypeIndexProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size index, struct Tcl_Obj** elemObj);
typedef		   int	(Tcl_ObjTypeSliceProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size fromIdx, Tcl_Size toIdx,
                                             struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     struct Tcl_Obj **newObjPtr);
typedef		   int	(Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
					     Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
typedef	struct Tcl_Obj*	(Tcl_ObjTypeSetElement)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
                                             Tcl_Size indexCount,
                                             struct Tcl_Obj *const indexArray[],
                                             struct Tcl_Obj *valueObj);
typedef            int  (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
                                             Tcl_Size first, Tcl_Size numToDelete,
                                             Tcl_Size numToInsert,
                                             struct Tcl_Obj *const insertObjs[]);
typedef            int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
                                             struct Tcl_Obj *listObj, int *boolResult);

#ifndef TCL_NO_DEPRECATED
#   define Tcl_PackageInitProc Tcl_LibraryInitProc
#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
#endif

/*

    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
    size_t version;

    /* List emulation functions - ObjType Version 1 */
    Tcl_ObjTypeLengthProc *lengthProc;	     /* Return the [llength] of the
					     ** AbstractList */
    Tcl_ObjTypeIndexProc *indexProc;	     /* Return a value (Tcl_Obj) for
					     ** [lindex $al $index] */
    Tcl_ObjTypeSliceProc *sliceProc;	     /* Return an AbstractList for

					     ** [lrange $al $start $end] */
    Tcl_ObjTypeReverseProc *reverseProc;     /* Return an AbstractList for
					     ** [lreverse $al] */
    Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
					     ** the list */
    Tcl_ObjTypeSetElement *setElementProc;   /* Replace the element at the indicie

					     ** with the given valueObj. */
    Tcl_ObjTypeReplaceProc *replaceProc;     /* Replace subset with subset */

    Tcl_ObjTypeInOperatorProc *inOperProc;   /* "in" and "ni" expr list
                                             ** operation Determine if the given
                                             ** string value matches an element in
                                             ** the list */
} Tcl_ObjType;

#define TCL_OBJTYPE_V0 0, \
	0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
#define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
	a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
#define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType),  \

				 * array as a readonly value. */
    Tcl_Size length;		/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjInternalRep internalRep;	/* The internal representation: */

} Tcl_Obj;


/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */

typedef struct Tcl_Namespace {
    char *name;			/* The namespace's name within its parent
				 * namespace. This contains no ::'s. The name
				 * of the global namespace is "" although "::"
				 * is an synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    void *clientData;	/* Arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Function invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Tcl_Namespace *parentPtr;
				/* Points to the namespace that contains this
				 * one. NULL if this is the global

    void *objProcNotUsed;	/* Command's object-based function. */
    void *objClientDataNotUsed;	/* ClientData for object proc. */
#else
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    void *objClientData;	/* ClientData for object proc. */
#endif
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    void *clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    void *deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */
    Tcl_ObjCmdProc2 *objProc2;	/* Command's object2-based function. */

 *				o Run in iPtr->lookupNsPtr or global namespace
 *				o Cut out of error traces
 *				o Don't reset the flags controlling ensemble
 *				  error message rewriting.
 *	TCL_CANCEL_UNWIND:	Magical Tcl_CancelEval mode that causes the
 *				stack for the script in progress to be
 *				completely unwound.
 *	TCL_EVAL_NOERR:	Do no exception reporting at all, just return
 *				as the caller will report.
 */

#define TCL_NO_EVAL		0x010000
#define TCL_EVAL_GLOBAL		0x020000
#define TCL_EVAL_DIRECT		0x040000
#define TCL_EVAL_INVOKE		0x080000

 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
    size_t hash;		/* Hash value. */
    void *clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */

struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    Tcl_Size numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    Tcl_Size numEntries;		/* Total number of entries present in
				 * table. */
    Tcl_Size rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
    int keyType;		/* Type of keys used in this table. It's
				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,

 * token.
 */

typedef struct Tcl_Token {
    int type;			/* Type of token, such as TCL_TOKEN_WORD; see
				 * below for valid types. */
    const char *start;		/* First character in token. */
    Tcl_Size size;			/* Number of bytes in token. */
    Tcl_Size numComponents;		/* If this token is composed of other tokens,
				 * this field tells how many of them there are
				 * (including components of components, etc.).
				 * The component tokens immediately follow
				 * this one. */
} Tcl_Token;

/*

 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    const char *commentStart;	/* Pointer to # that begins the first of one
				 * or more comments preceding the command. */
    Tcl_Size commentSize;		/* Number of bytes in comments (up through
				 * newline character that terminates the last
				 * comment). If there were no comments, this
				 * field is 0. */
    const char *commandStart;	/* First character in first word of
				 * command. */
    Tcl_Size commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the
				 * terminating newline, close bracket, or
				 * semicolon. */
    Tcl_Size numWords;		/* Total number of words in command. May be
				 * 0. */
    Tcl_Token *tokenPtr;	/* Pointer to first token representing the
				 * words of the command. Initially points to

				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_FreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    Tcl_Size nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1, 2, or 4. */
} Tcl_EncodingType;

				 * argv array. */
    void *srcPtr;		/* Value to be used in setting dst; usage
				 * depends on type.*/
    void *dstPtr;		/* Address of value to be modified; usage
				 * depends on type.*/
    const char *helpStr;	/* Documentation message describing this
				 * option. */
    void *clientData;	/* Word to pass to function callbacks. */
} Tcl_ArgvInfo;

/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
const char *		TclInitStubTable(const char *version);
void *			TclStubCall(void *arg);
#if defined(_WIN32)
    TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL)
#endif

#ifdef USE_TCL_STUBS
#   define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_PkgInitStubsCheck(interp, version, \
		(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif

/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \

	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp())))
EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
EXTERN const char *	Tcl_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
EXTERN const char *	Tcl_FindExecutable(const char *argv0);
EXTERN const char *	Tcl_SetPreInitScript(const char *string);
EXTERN const char *	Tcl_SetPanicProc(
			    Tcl_PanicProc *panicProc);
EXTERN void		Tcl_StaticLibrary(Tcl_Interp *interp,
			    const char *prefix,
			    Tcl_LibraryInitProc *initProc,
			    Tcl_LibraryInitProc *safeInitProc);
#ifndef TCL_NO_DEPRECATED
#   define Tcl_StaticPackage Tcl_StaticLibrary
#endif
EXTERN Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif

 *   Tcl_DecrRefCount(objPtr);
 *
 * This will free the obj if there are no references to the obj.
 */
#   define Tcl_BounceRefCount(objPtr) \
    TclBounceRefCount(objPtr, __FILE__, __LINE__)

static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)




{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DbDecrRefCount(objPtr, fn, line);
	}
    }
}
#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	((void)++(objPtr)->refCount)
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * https://wiki.c2.com/?TrivialDoWhileLoop
     */
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if (_objPtr->refCount-- <= 1) { \
		TclFreeObj(_objPtr); \
	    } \
	} while(0)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	((objPtr)->refCount > 1)

/*
 * Declare that obj will no longer be used or referenced.
 * This will release the obj if there is no referece count,
 * otherwise let it be.
 */
#   define Tcl_BounceRefCount(objPtr)     \
    TclBounceRefCount(objPtr);

static inline void TclBounceRefCount(Tcl_Obj* objPtr)


{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DecrRefCount(objPtr);
	}
    }
}

 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

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

#undef  Tcl_FindHashEntry

 * enabled then a second word holds the size of the requested block, less 1,
 * rounded up to a multiple of sizeof(RMAGIC). The order of elements is
 * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic
 * can not be a valid ov.next bit pattern.
 */

union overhead {
    union overhead *next;		/* when free */
    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */

    struct {
	unsigned char magic0;		/* magic number */
	unsigned char index;		/* bucket # */
	unsigned char unused;		/* unused */
	unsigned char magic1;		/* other magic number */
#ifndef NDEBUG
	unsigned short rmagic;		/* range magic number */
	size_t size;		/* actual block size */
	unsigned short unused2;		/* padding to 8-byte align */
#endif
    } ovu;
#define overMagic0	ovu.magic0
#define overMagic1	ovu.magic1
#define bucketIndex	ovu.index
#define rangeCheckMagic	ovu.rmagic
#define realBlockSize	ovu.size
};


#define MAGIC		0xEF	/* magic # on accounting info */
#define RMAGIC		0x5555	/* magic # on range info */

#ifndef NDEBUG
#define	RSLOP		sizeof(unsigned short)
#else

/*
 * nextf[i] is the pointer to the next free block of size 2^(i+3). The
 * smallest allocatable block is MINBLOCK bytes. The overhead information
 * precedes the data area returned to the user.
 */


#define MINBLOCK	((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
#define NBUCKETS	(13 - (MINBLOCK >> 4))
#define MAXMALLOC	((size_t)1 << (NBUCKETS+2))
static union overhead *nextf[NBUCKETS];

/*
 * The following structure is used to keep track of all system memory
 * currently owned by Tcl. When finalizing, all this memory will be returned

 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    union overhead *overPtr;
    size_t bucket;
    size_t amount;
    struct block *bigBlockPtr = NULL;

    if (!allocInit) {

 *	Attempts to get more memory from the system.
 *
 *----------------------------------------------------------------------
 */

static void
MoreCore(
    size_t bucket)	/* What bucket to allocate to. */
{
    union overhead *overPtr;
    size_t size;	/* size of desired block */
    size_t amount;		/* amount to allocate */
    size_t numBlocks;		/* how many blocks we get */
    struct block *blockPtr;

    /*
     * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
     * VAX, I think) or for a negative arg.

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

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloc'ed block. */
    size_t numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;

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

void *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
{
    return realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#else
TCL_MAC_EMPTY_FILE(generic_tclAlloc_c)

 * double layout and a 32-bit 'int' type).
 */
#define TCL_FPCLASSIFY_MODE 2
#endif /* !fpclassify */
/* actually there is no fallback to builtin fpclassify */
#endif /* !TCL_FPCLASSIFY_MODE */


/*
 * Bug 7371b6270b: to check C call stack depth, prefer an approach which is
 * compatible with AddressSanitizer (ASan) use-after-return detection.
 */

#if defined(_MSC_VER) && defined(HAVE_INTRIN_H)
#include <intrin.h> /* for _AddressOfReturnAddress() */

#define __has_builtin(x) 0 /* for non-clang compilers */
#endif

void *
TclGetCStackPtr(void)
{
#if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address)
  return __builtin_frame_address(0);
#elif defined(_MSC_VER) && defined(HAVE_INTRIN_H)
  return _AddressOfReturnAddress();
#else
  ptrdiff_t unused = 0;
  /*
   * LLVM recommends using volatile:
   * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31
   */
  ptrdiff_t *volatile stackLevel = &unused;
  return (void *)stackLevel;
#endif
}

#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE    200

/*

    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc2   BadEnsembleSubcommand;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(void *clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(void *clientData);

static Tcl_ObjCmdProc2	ExprBinaryFunc;
static Tcl_ObjCmdProc2	ExprBoolFunc;
static Tcl_ObjCmdProc2	ExprCeilFunc;
static Tcl_ObjCmdProc2	ExprDoubleFunc;
static Tcl_ObjCmdProc2	ExprFloorFunc;
static Tcl_ObjCmdProc2	ExprIntFunc;
static Tcl_ObjCmdProc2	ExprIsqrtFunc;
static Tcl_ObjCmdProc2   ExprIsFiniteFunc;
static Tcl_ObjCmdProc2   ExprIsInfinityFunc;
static Tcl_ObjCmdProc2   ExprIsNaNFunc;
static Tcl_ObjCmdProc2   ExprIsNormalFunc;
static Tcl_ObjCmdProc2   ExprIsSubnormalFunc;
static Tcl_ObjCmdProc2   ExprIsUnorderedFunc;
static Tcl_ObjCmdProc2	ExprMaxFunc;
static Tcl_ObjCmdProc2	ExprMinFunc;
static Tcl_ObjCmdProc2	ExprRandFunc;
static Tcl_ObjCmdProc2	ExprRoundFunc;
static Tcl_ObjCmdProc2	ExprSqrtFunc;
static Tcl_ObjCmdProc2	ExprSrandFunc;
static Tcl_ObjCmdProc2	ExprUnaryFunc;
static Tcl_ObjCmdProc2	ExprWideFunc;
static Tcl_ObjCmdProc2   FloatClassifyObjCmd;
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

static void		ProcessUnexpectedResult(Tcl_Interp *interp,

MODULE_SCOPE const TclStubs tclStubs;

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

#define CORO_ACTIVATE_YIELD    NULL
#define CORO_ACTIVATE_YIELDM   INT2PTR(1)

#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     ((Tcl_Size)-1)
#define COROUTINE_ARGUMENTS_ARBITRARY           ((Tcl_Size)-2)

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		/* Name of object-based command. */
    Tcl_ObjCmdProc2 *objProc;	/* Object-based function for command. */
    CompileProc *compileProc;	/* Function called to compile command. */
    Tcl_ObjCmdProc2 *nreProc;	/* NR-based function for command */
    int flags;			/* Various flag bits, as defined below. */
} CmdInfo;

#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
                                 * commands present by default in a safe
                                 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */

/*
 * The following struct states that the command it talks about (a subcommand
 * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
 * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
 * structs.) Alas, we can't sensibly just store the information directly in
 * the commands.
 */

typedef struct {
    const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
                                 * the end of the list of commands to hide. */
    const char *commandName;    /* The name of the command within the
                                 * ensemble. If this is NULL, we want to also
                                 * make the overall command be hidden, an ugly
                                 * hack because it is expected by security
                                 * policies in the wild. */
} UnsafeEnsembleInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"const", 		Tcl_ConstObjCmd,	TclCompileConstCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"fpclassify",      FloatClassifyObjCmd,    NULL,                   NULL,   CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"ledit",		Tcl_LeditObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"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},
    {"lseq",		Tcl_LseqObjCmd,         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},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},

    {NULL, NULL}
};

/*
 * Math functions. All are safe.
 */





typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
    Tcl_ObjCmdProc2 *objCmdProc;	/* Function that evaluates the function */
    double (*fn)(double x);	/* Real function pointer */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",	ExprAbsFunc,	NULL			},
    { "acos",	ExprUnaryFunc,	acos			},
    { "asin",	ExprUnaryFunc,	asin			},
    { "atan",	ExprUnaryFunc,	atan			},
    { "atan2",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) atan2},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	cos				},
    { "cosh",	ExprUnaryFunc,	cosh			},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	exp				},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) fmod},
    { "hypot",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) hypot},
    { "int",	ExprIntFunc,	NULL			},
    { "isfinite", ExprIsFiniteFunc, NULL        	},
    { "isinf",	ExprIsInfinityFunc, NULL        	},
    { "isnan",	ExprIsNaNFunc,	NULL            	},
    { "isnormal", ExprIsNormalFunc, NULL        	},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "issubnormal", ExprIsSubnormalFunc, NULL,         },
    { "isunordered", ExprIsUnorderedFunc, NULL,         },
    { "log",	ExprUnaryFunc,	log				},
    { "log10",	ExprUnaryFunc,	log10			},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) pow},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	sin				},
    { "sinh",	ExprUnaryFunc,	sinh			},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	tan				},
    { "tanh",	ExprUnaryFunc,	tanh			},
    { "wide",	ExprWideFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.

	Tcl_DeleteHashTable(&cancelTable);
	cancelTableInitialized = 0;
    }
    Tcl_MutexUnlock(&cancelLock);

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_DeleteHashTable(&commandTypeTable);
        commandTypeInit = 0;
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

/*
 *----------------------------------------------------------------------
 *

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












    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;



    }
    if (objc == 2) {



	Tcl_Size len;
	const char *arg = TclGetStringFromObj(objv[1], &len);
	if (len == 7 && !strcmp(arg, "version")) {
	    char buf[80];
	    const char *p = strchr((char *)clientData, '.');
	    if (p) {
		const char *q = strchr(p+1, '.');
		const char *r = strchr(p+1, '+');
		p = (q < r) ? q : r;
	    }
	    if (p) {



		memcpy(buf, (char *)clientData, p - (char *)clientData);
		buf[p - (char *)clientData] = '\0';
		Tcl_AppendResult(interp, buf, (char *)NULL);
	    }
	    return TCL_OK;
	} else if (len == 10 && !strcmp(arg, "patchlevel")) {

	    char buf[80];
	    const char *p = strchr((char *)clientData, '+');


	    if (p) {
		memcpy(buf, (char *)clientData, p - (char *)clientData);
		buf[p - (char *)clientData] = '\0';
		Tcl_AppendResult(interp, buf, (char *)NULL);
	    }
	    return TCL_OK;
	} else if (len == 6 && !strcmp(arg, "commit")) {
	    const char *q, *p = strchr((char *)clientData, '+');
	    if (p) {
		if ((q = strchr(p, '.'))) {
		    char buf[80];
		    memcpy(buf, p+1, q - p - 1);
		    buf[q - p - 1] = '\0';
		    Tcl_AppendResult(interp, buf, (char *)NULL);
		} else {
		    Tcl_AppendResult(interp, p+1, (char *)NULL);

		}
	    }
	    return TCL_OK;
	} else if (len == 8 && !strcmp(arg, "compiler")) {

	    const char *p = strchr((char *)clientData, '.');



	    while (p) {
		if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4)
			    || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) {

		    const char *q = strchr(p+1, '.');
		    if (q) {
			char buf[16];
			memcpy(buf, p+1, q - p - 1);
			buf[q - p - 1] = '\0';
			Tcl_AppendResult(interp, buf, (char *)NULL);
		    } else {
			Tcl_AppendResult(interp, p+1, (char *)NULL);
		    }







		    return TCL_OK;
		}



		p = strchr(p+1, '.');


	    }




	    Tcl_AppendResult(interp, "0", (char *)NULL);
	    return TCL_OK;
	}
	const char *p = strchr((char *)clientData, '.');
	while (p) {
	    if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) {
		Tcl_AppendResult(interp, "1", (char *)NULL);
		return TCL_OK;
	    }
	    p = strchr(p+1, '.');
	}
	Tcl_AppendResult(interp, "0", (char *)NULL);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, (char *)clientData, (char *)NULL);
    return TCL_OK;
}

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

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --

	    cancelTableInitialized = 1;
	}

	Tcl_MutexUnlock(&cancelLock);
    }

    if (commandTypeInit == 0) {
        TclRegisterCommandTypeName(TclObjInterpProc2, "proc");
        TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
        TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclChildObjCmd, "interp");
        TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
        TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
        TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
        TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
        TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
    }

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
        iPtr->flags |= INTERP_DEBUG_FRAME;
    }
#endif

    /*
     * Initialise the tables for variable traces and searches *before*
     * creating the global ns - so that the trace on errorInfo can be
     * recorded.

	    cmdPtr->proc = NULL;
	    cmdPtr->clientData = cmdPtr;
	    cmdPtr->objProc2 = cmdInfoPtr->objProc;
	    cmdPtr->objClientData2 = NULL;
	    cmdPtr->deleteProc = NULL;
	    cmdPtr->deleteData = NULL;
	    cmdPtr->flags = 0;
            if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
                cmdPtr->flags |= CMD_COMPILES_EXPANDED;
            }
	    cmdPtr->importRefPtr = NULL;
	    cmdPtr->tracePtr = NULL;
	    cmdPtr->nreProc2 = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    Tcl_CreateObjCommand2(interp, "::tcl::unsupported::getbytecode",
	    Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
    Tcl_CreateObjCommand2(interp, "::tcl::unsupported::representation",
	    Tcl_RepresentationCmd, NULL, NULL);

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

    /* Coroutine monkeybusiness */
    Tcl_NRCreateCommand2(interp, "::tcl::unsupported::inject", NULL,
	    NRInjectObjCmd, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "::tcl::unsupported::corotype",
            CoroTypeObjCmd, NULL, NULL);

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


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

    Tcl_CreateObjCommand2(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);

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

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

}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *
 *      Command type registration and lookup mechanism. Everything is keyed by
 *      the Tcl_ObjCmdProc2 for the command, and that is used as the *key* into
 *      the hash table that maps to constant strings that are names. (It is
 *      recommended that those names be ASCII.)
 *
 * ---------------------------------------------------------------------
 */

void
TclRegisterCommandTypeName(
    Tcl_ObjCmdProc2 *implementationProc,
    const char *nameStr)
{
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit == 0) {
        Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
        commandTypeInit = 1;
    }
    if (nameStr != NULL) {
        int isNew;

        hPtr = Tcl_CreateHashEntry(&commandTypeTable,
                implementationProc, &isNew);
        Tcl_SetHashValue(hPtr, (void *) nameStr);
    } else {
        hPtr = Tcl_FindHashEntry(&commandTypeTable,
                implementationProc);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    Tcl_ObjCmdProc2 *procPtr = cmdPtr->objProc2;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc2;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);

        if (hPtr && Tcl_GetHashValue(hPtr)) {
            name = (const char *) Tcl_GetHashValue(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);

    return name;
}

/*

    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }

    for (unsafePtr = unsafeEnsembleCommands;
            unsafePtr->ensembleNsName; unsafePtr++) {
        if (unsafePtr->commandName) {
            /*
             * Hide an ensemble subcommand.
             */

            Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);
            Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);



            if (TclRenameCommand(interp, TclGetString(cmdName),
                        "___tmp") != TCL_OK
                    || Tcl_HideCommand(interp, "___tmp",
                            TclGetString(hideName)) != TCL_OK) {
                Tcl_Panic("problem making '%s %s' safe: %s",
                        unsafePtr->ensembleNsName, unsafePtr->commandName,
                        Tcl_GetStringResult(interp));
            }
            Tcl_CreateObjCommand2(interp, TclGetString(cmdName),
                    BadEnsembleSubcommand, (void *)unsafePtr, NULL);
            TclDecrRefCount(cmdName);
            TclDecrRefCount(hideName);
        } else {
            /*
             * Hide an ensemble main command (for compatibility).
             */

            if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
                    unsafePtr->ensembleNsName) != TCL_OK) {
                Tcl_Panic("problem making '%s' safe: %s",
                        unsafePtr->ensembleNsName,
                        Tcl_GetStringResult(interp));
            }
        }
    }

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

    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Size) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *

 */

void
Tcl_CallWhenDeleted(
    Tcl_Interp *interp,		/* Interpreter to watch. */
    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
				 * to be deleted. */
    void *clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

 */

void
Tcl_DontCallWhenDeleted(
    Tcl_Interp *interp,		/* Interpreter to watch. */
    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
				 * to be deleted. */
    void *clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTablePtr;
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    AssocData *dPtr;

void
Tcl_SetAssocData(
    Tcl_Interp *interp,		/* Interpreter to associate with. */
    const char *name,		/* Name for association. */
    Tcl_InterpDeleteProc *proc,	/* Proc to call when interpreter is about to
				 * be deleted. */
    void *clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {

	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
    }


    if (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	/*
	 * Invoke deletion callbacks; note that a callback can create new
	 * callbacks, so we iterate.

     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of
     * the command must be given if using namespaces.

    /*
     * Check that the command is really in global namespace
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only hide global namespace commands (use rename then hide)",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Initialize the hidden command table if necessary.
     */

     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "hidden command named \"%s\" already exists",
                hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a special separate name
     * table. Changes here and in TclRenameCommand must be kept in synch until
     * the common parts are actually factorized out.

     * Check that we have a regular name for the command (that the user is not
     * trying to do an expose and a rename (to another namespace) at the same
     * time).
     */

    if (strstr(cmdName, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "cannot expose to a namespace (use expose to toplevel, then rename)",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Get the command from the hidden command table:
     */

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown hidden command \"%s\"", hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
                hiddenCmdToken, (char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	/*
	 * This case is theoretically impossible, we might rather Tcl_Panic
	 * than 'nicely' erroring out ?
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"trying to expose a non-global command namespace command",
		-1));
	return TCL_ERROR;
    }

    /*
     * This is the global table.
     */

    nsPtr = cmdPtr->nsPtr;

    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "exposed command \"%s\" already exists", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * 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,

    Tcl_Interp *interp,		/* Token for command interpreter returned by a
				 * previous call to Tcl_CreateInterp. */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_CmdProc *proc,		/* Function to associate with cmdName. */
    void *clientData,	/* Arbitrary value passed to string proc. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    Interp *iPtr = (Interp *) interp;
    ImportRef *oldRefPtr = NULL;
    Namespace *nsPtr;

     * If the command name we seek to create already exists, we need to
     * delete that first.  That can be tricky in the presence of traces.
     * Loop until we no longer find an existing command in the way, or
     * until we've deleted one command and that didn't finish the job.
     */

    while (1) {
        /*
         * Determine where the command should reside. If its name contains
         * namespace qualifiers, we put it in the specified namespace;
	 * otherwise, we always put it in the global namespace.
         */

        if (strstr(cmdName, "::") != NULL) {
	    Namespace *dummy1, *dummy2;

	    TclGetNamespaceForQualName(interp, cmdName, NULL,
		    TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	    if ((nsPtr == NULL) || (tail == NULL)) {
	        return (Tcl_Command) NULL;
	    }
        } else {
	    nsPtr = iPtr->globalNsPtr;
	    tail = cmdName;
        }

        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);

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

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

	cmdPtr = (Command *)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.

    Tcl_ObjCmdProc *proc;
    void *clientData; /* Arbitrary value to pass to proc function. */
    Tcl_CmdDeleteProc *deleteProc;
    void *deleteData; /* Arbitrary value to pass to deleteProc function. */
    Tcl_ObjCmdProc *nreProc;
} CmdWrapperInfo;


static int
cmdWrapperProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj * const *objv)
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    if (objc > INT_MAX) {
	Tcl_WrongNumArgs(interp, 1, objv, "?args?");
	return TCL_ERROR;
    }
    return info->proc(info->clientData, interp, (int)objc, objv);
}

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

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

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

				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc2 *proc,	/* Object-based function to associate with
				 * name. */
    void *clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
)
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr;
    const char *tail;

    if (iPtr->flags & DELETED) {
	/*

	proc, clientData, deleteProc);
}

Tcl_Command
TclCreateObjCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,	/* Name of command, without any namespace
                                 * components. */
    Tcl_Namespace *namesp,   /* The namespace to create the command in */
    Tcl_ObjCmdProc2 *proc,	/* Object-based function to associate with
				 * name. */
    void *clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    int deleted = 0, isNew = 0;
    Command *cmdPtr;

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

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

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

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

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

	/*
         * Make sure namespace doesn't get deallocated.
         */

	cmdPtr->nsPtr->refCount++;

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                (Tcl_Namespace *) cmdPtr->nsPtr);
	TclNsDecrRefCount(cmdPtr->nsPtr);

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

     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't %s \"%s\": command doesn't exist",
		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
		oldName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.
     */

     */

    TclGetNamespaceForQualName(interp, newName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": bad command name", newName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": command already exists", newName));
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
                "TARGET_EXISTS", (char *)NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*
     * Warning: any changes done in the code here are likely to be needed in
     * Tcl_HideCommand code too (until the common parts are extracted out).

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

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

    if (objc < 0) {
	objc = TCL_INDEX_NONE;
    }
    if (cmdPtr->objProc2 != NULL) {
	result = cmdPtr->objProc2(cmdPtr->objClientData2, interp, (size_t)objc, objv);
    } else {
	result = Tcl_NRCallObjProc2(interp, cmdPtr->nreProc2,
		cmdPtr->objClientData2, (size_t)objc, objv);
    }
    return result;
}

static int
cmdWrapper2Proc(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr = (Command *)clientData;
    if (objc < 0) {
	objc = -1;
    }
    return cmdPtr->objProc2(cmdPtr->objClientData2, interp, (size_t)objc, objv);
}
#endif

	    cmdPtr->nreProc2 = NULL;
	    cmdPtr->objProc2 = infoPtr->objProc2;
	}
	cmdPtr->objClientData2 = infoPtr->objClientData2;
    }
#ifndef TCL_NO_DEPRECATED
    if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
	CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
	if (infoPtr->objProc == NULL) {
	    info->proc = invokeObj2Command;
	    info->clientData = cmdPtr;
	   	info->nreProc = NULL;
	} else {
	    if (infoPtr->objProc != info->proc) {
	   	info->nreProc = NULL;

     */

    cmdPtr->nsPtr->refCount++;

    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	/* CallCommandTraces() does not cmdPtr, that's
	 * done just before Tcl_DeleteCommandFromToken() returns  */
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
	 */

	tracePtr = cmdPtr->tracePtr;

    /*
     * Has the current script in progress for this interpreter been canceled
     * or is the stack being unwound due to the previous script cancellation?
     */

    if (!TclCanceled(iPtr)) {
        return TCL_OK;
    }

    /*
     * The CANCELED flag is a one-shot flag that is reset immediately upon
     * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will
     * continue to report that the script in progress has been canceled
     * thereby allowing the evaluation stack for the interp to be fully
     * unwound.
     */

    iPtr->flags &= ~CANCELED;

    /*
     * The CANCELED flag was detected and reset; however, if the caller
     * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR
     * (indicating that the script in progress has been canceled) if the
     * evaluation stack for the interp is being fully unwound.
     */

    if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
        return TCL_OK;
    }

    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        Tcl_Size length;

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

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

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
                message = "eval unwound";
            }
        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.
     */

int
Tcl_CancelEval(
    Tcl_Interp *interp,		/* Interpreter in which to cancel the
				 * script. */
    Tcl_Obj *resultObjPtr,	/* The script cancellation error message or
				 * NULL for a default error message. */
    void *clientData,	/* Passed to CancelEvalProc. */
    int flags)			/* Collection of OR-ed bits that control
				 * the cancellation of the script. Only
				 * TCL_CANCEL_UNWIND is currently
				 * supported. */
{
    Tcl_HashEntry *hPtr;
    CancelInfo *cancelInfo;

     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;

     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
     * command redirectors (imports, alias, ensembles) so that tailcall skips
     * this callback (that marks the end of the target command) and goes back
     * to the end of the source command.
     */

    if (iPtr->deferredCallbacks) {
        iPtr->deferredCallbacks = NULL;
    } else {
	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    }

    iPtr->numLevels++;
    TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
	    INT2PTR(objc), objv);

     * Lookup the Command to dispatch.
     */

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

	if (!(preCmdPtr->flags & CMD_DEAD)) {
	    /*
             * 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.
	     */

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

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

    TclNRAddCallback(interp, Dispatch,
	    cmdPtr->nreProc2 ? cmdPtr->nreProc2 : cmdPtr->objProc2,
	    cmdPtr->objClientData2, INT2PTR(objc), objv);
    return TCL_OK;
}

    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
    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;
}

static int
NRCommand(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;

    iPtr->numLevels--;

     /*
      * If there is a tailcall, schedule it next
      */

    if (data[1] && (data[1] != INT2PTR(1))) {
	listPtr = (Tcl_Obj *)data[1];
	data[1] = NULL;

	TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL);
    }

     * to increment the reference count of all the handler arguments anyway.
     */

    for (i = 0; i < handlerObjc; ++i) {
	newObjv[i] = handlerObjv[i];
	Tcl_IncrRefCount(newObjv[i]);
    }
    memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);

    /*
     * Look up and invoke the handler (by recursive call to this function). If
     * there is no handler at all, instead of doing the recursive call we just
     * generate a generic error message; it would be an infinite-recursion
     * nightmare otherwise.
     *
     * In this case we worry a bit less about recursion for now, and call the
     * "blocking" interface.
     */

    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid command name \"%s\"", TclGetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
                TclGetString(objv[0]), (char *)NULL);

	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */

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

int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    Tcl_Size count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
}

/*

    Tcl_Size numBytes,		/* Number of bytes in script. If -1, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    Tcl_Size line,		/* The line the script starts on. */
    Tcl_Size *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is referred to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of

    Tcl_Size i, objectsUsed = 0;
				/* These variables keep track of how much
				 * state has been allocated while evaluating
				 * the script, so that it can be freed
				 * properly if an error occurs. */
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)
	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
    int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
    Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
				/* TIP #280 Structures for tracking of command
				 * locations. */
    Tcl_Size *clNext = NULL;		/* Pointer for the tracking of invisible
				 * continuation lines. Initialized only if the
				 * caller gave us a table of locations to
				 * track, via scriptCLLocPtr. It always refers
				 * to the table entry holding the location of
				 * the next invisible continuation line to
				 * look for, while parsing the script. */

	    Tcl_Size numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    (int *)Tcl_Alloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));

		lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));

	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
		    objectsUsed < numWords;
		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
		/*
		 * TIP #280. Track lines to current word. Save the information
		 * on a per-word basis, signaling dynamic words as needed.
		 * Make the information available to the recursively called
		 * evaluator as well, including the type of context (source
		 * vs. eval).
		 */

		TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
		TclAdvanceContinuations(&wordLine, &wordCLNext,
			tokenPtr->start - outerScript);
		wordStart = tokenPtr->start;

		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
			? wordLine : -1;

		if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
		    iPtr->evalFlags |= TCL_EVAL_FILE;
		}

		code = TclSubstTokens(interp, tokenPtr+1,
			tokenPtr->numComponents, NULL, wordLine,
			wordCLNext, outerScript);

		iPtr->evalFlags = 0;

		if (code != TCL_OK) {
		    break;

		Tcl_Obj **copy = objvSpace;
		Tcl_Size *lcopy = lineSpace;
		Tcl_Size wordIdx = numWords;
		Tcl_Size objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			Tcl_Size numElements;

			Tcl_DecrRefCount(temp);
		    } else {
			lines[objIdx] = lcopy[wordIdx];
			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    Tcl_Free(copy);
		}
		if (lcopy != linesStack) {
		    Tcl_Free(lcopy);
		}

    Tcl_Size objc)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Size i;

    for (i = 1; i < objc; i++) {
	CFWord *cfwPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]);

	if (!hPtr) {
	    continue;
	}
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {

    Tcl_Size pc)
{
    ExtCmdLoc *eclPtr;
    Tcl_Size word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
	    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

    if (!hePtr) {
	return;
    }
    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
    ePtr = &eclPtr->loc[cmd];

     * evaluation are not supposed to get compiled, because a command
     * such as [info level] in the script can expose some of the dispatch
     * shenanigans.  This means that we don't have to tend to the
     * housekeeping, and can escape now.
     */

    if (ePtr->nline != objc) {
        return;
    }

    /*
     * Having disposed of the ensemble cases, we can state...
     * A few truths ...
     * (1) ePtr->nline == objc
     * (2) (ePtr->line[word] < 0) => !literal, for all words
     * (3) (word == 0) => !literal
     *
     * Item (2) is why we can use objv to get the literals, and do not
     * have to save them at compile time.
     */

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isNew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isNew);
	    CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;

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

int
Tcl_EvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
{
    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
}

int
TclEvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{
    int result = TCL_OK;
    NRE_callback *rootPtr = TOP_CB(interp);

    result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
    return TclNRRunCallbacks(interp, result, rootPtr);
}

int
TclNREvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{

	    iPtr->cmdFramePtr = eoFramePtr;

	    flags |= TCL_EVAL_SOURCE_IN_FRAME;
	}

	TclMarkTailcall(interp);
        TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
		objPtr, NULL);

	TclListObjGetElements(NULL, listPtr, &objc, &objv);
	return TclNREvalObjv(interp, objc, objv, flags, NULL);
    }

    if (!(flags & TCL_EVAL_DIRECT)) {
	/*
	 * Let the compiler/engine subsystem do the evaluation.
	 *
	 * TIP #280 The invoker provides us with the context for the script.
	 * We transfer this to the byte code compiler.
	 */

	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
	ByteCode *codePtr;
	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
						 * iPtr->varFramePtr in case
						 * TCL_EVAL_GLOBAL was set. */

        if (TclInterpReady(interp) != TCL_OK) {
            return TCL_ERROR;
        }
	if (flags & TCL_EVAL_GLOBAL) {
	    savedVarFramePtr = iPtr->varFramePtr;
	    iPtr->varFramePtr = iPtr->rootFramePtr;
	}
	Tcl_IncrRefCount(objPtr);
	codePtr = TclCompileObj(interp, objPtr, invoker, word);

	TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
		objPtr, INT2PTR(allowExceptions), NULL);
        return TclNRExecuteByteCode(interp, codePtr);
    }

    {
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).

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

int
Tcl_ExprLongObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Expression to evaluate. */
    long *ptr)			/* Where to store long result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    double d;
    void *internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
	return TCL_ERROR;
    }

    switch (type) {
    case TCL_NUMBER_DOUBLE: {
	mp_int big;

    return result;
}

int
Tcl_ExprDoubleObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Expression to evaluate. */
    double *ptr)		/* Where to store double result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    void *internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);

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

int
TclObjInvokeNamespace(
    Tcl_Interp *interp,		/* Interpreter in which command is to be
				 * invoked. */
    Tcl_Size objc,			/* Count of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
				 * name of the command to invoke. */
    Tcl_Namespace *nsPtr,	/* The namespace to use. */
    int flags)			/* Combination of flags controlling the call:
				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
				 * or TCL_INVOKE_NO_TRACEBACK. */
{

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

int
TclObjInvoke(
    Tcl_Interp *interp,		/* Interpreter in which command is to be
				 * invoked. */
    Tcl_Size objc,			/* Count of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
				 * name of the command to invoke. */
    int flags)			/* Combination of flags controlling the call:
				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
				 * or TCL_INVOKE_NO_TRACEBACK. */
{
    if (interp == NULL) {
	return TCL_ERROR;
    }
    if ((objc < 1) || (objv == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "illegal argument vector", TCL_INDEX_NONE));
	return TCL_ERROR;
    }
    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }
    return Tcl_NRCallObjProc2(interp, TclNRInvoke, NULL, objc, objv);
}

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                (char *)NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

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

	}
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
    }
    return TCL_OK;

  negarg:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "square root of negative argument", TCL_INDEX_NONE));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
	    "domain error: argument not in valid range", (char *)NULL);
    return TCL_ERROR;
}

static int
ExprSqrtFunc(

	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
    }
    return TCL_OK;
}

static int
ExprUnaryFunc(
    void *clientData,	/* Contains the address of a function that
				 * takes one double argument and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    Tcl_Size objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    int code;
    double d;
    double (*func)(double) = (double (*)(double)) clientData;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN

    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprBinaryFunc(
    void *clientData,	/* Contains the address of a function that
				 * takes two double arguments and returns a
				 * double result. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    Tcl_Size objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    int code;
    double d1, d2;
    double (*func)(double, double) = (double (*)(double, double)) clientData;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN

		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
			return TCL_OK;
		    }
		    bytes++; numBytes--;

		}
	    }
	    goto unChanged;
	} else if (l == WIDE_MIN) {
	    if (sizeof(Tcl_WideInt) > sizeof(int64_t)) {
		Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN;
		if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1,

    if (objc < 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    res = objv[1];
    for (i = 1; i < objc; i++) {
        if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
            return TCL_ERROR;
        }
        if (type == TCL_NUMBER_NAN) {
            /*
             * Get the error message for NaN.
             */

            Tcl_GetDoubleFromObj(interp, objv[i], &d);
            return TCL_ERROR;
        }
        if (TclCompareTwoNumbers(objv[i], res) == op)  {
            res = objv[i];
        }
    }

    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

static int

	iPtr->flags |= RAND_SEED_INITIALIZED;

	/*
	 * To ensure different seeds in different threads (bug #416643),
	 * take into consideration the thread this interp is running in.
	 */

	iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U;

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= 0x7FFFFFFFL;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFFL)) {

 *----------------------------------------------------------------------
 *
 * Double Classification Functions --
 *
 *	This page contains the functions that implement all of the built-in
 *	math functions for classifying IEEE doubles.
 *
 *      These have to be a little bit careful while Tcl_GetDoubleFromObj()
 *      rejects NaN values, which these functions *explicitly* accept.
 *
 * Results:
 *	Each function returns TCL_OK if it succeeds and pushes an Tcl object
 *	holding the result. If it fails it returns TCL_ERROR and leaves an
 *	error message in the interpreter's result.
 *
 * Side effects:

    return fpclassify(d);
#else /* TCL_FPCLASSIFY_MODE != 0 */
    /*
     * If we don't have fpclassify(), we also don't have the values it returns.
     * Hence we define those here.
     */
#ifndef FP_NAN
#   define FP_NAN          1	/* Value is NaN */
#   define FP_INFINITE     2	/* Value is an infinity */
#   define FP_ZERO         3	/* Value is a zero */
#   define FP_NORMAL       4	/* Value is a normal float */
#   define FP_SUBNORMAL    5	/* Value has lost accuracy */
#endif /* !FP_NAN */

#if TCL_FPCLASSIFY_MODE == 3
    return __builtin_fpclassify(
            FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d);
#elif TCL_FPCLASSIFY_MODE == 2
    /*
     * We assume this hack is only needed on little-endian systems.
     * Specifically, x86 running Windows.  It's fairly easy to enable for
     * others if they need it (because their libc/libm is broken) but we'll
     * jump that hurdle when requred.  We can solve the word ordering then.
     */

    union {
        double d;               /* Interpret as double */
        struct {
            unsigned int low;   /* Lower 32 bits */
            unsigned int high;  /* Upper 32 bits */
        } w;                    /* Interpret as unsigned integer words */
    } doubleMeaning;            /* So we can look at the representation of a
                                 * double directly. Platform (i.e., processor)
                                 * specific; this is for x86 (and most other
                                 * little-endian processors, but those are
                                 * untested). */
    unsigned int exponent, mantissaLow, mantissaHigh;
                                /* The pieces extracted from the double. */
    int zeroMantissa;           /* Was the mantissa zero? That's special. */

    /*
     * Shifts and masks to use with the doubleMeaning variable above.
     */

#define EXPONENT_MASK   0x7FF   /* 11 bits (after shifting) */
#define EXPONENT_SHIFT  20      /* Moves exponent to bottom of word */
#define MANTISSA_MASK   0xFFFFF /* 20 bits (plus 32 from other word) */

    /*
     * Extract the exponent (11 bits) and mantissa (52 bits).  Note that we
     * totally ignore the sign bit.
     */

    doubleMeaning.d = d;
    exponent = (doubleMeaning.w.high >> EXPONENT_SHIFT) & EXPONENT_MASK;
    mantissaLow = doubleMeaning.w.low;
    mantissaHigh = doubleMeaning.w.high & MANTISSA_MASK;
    zeroMantissa = (mantissaHigh == 0 && mantissaLow == 0);

    /*
     * Look for the special cases of exponent.
     */

    switch (exponent) {
    case 0:
        /*
         * When the exponent is all zeros, it's a ZERO or a SUBNORMAL.
         */

        return zeroMantissa ? FP_ZERO : FP_SUBNORMAL;
    case EXPONENT_MASK:
        /*
         * When the exponent is all ones, it's an INF or a NAN.
         */

        return zeroMantissa ? FP_INFINITE : FP_NAN;
    default:
        /*
         * Everything else is a NORMAL double precision float.
         */

        return FP_NORMAL;
    }
#elif TCL_FPCLASSIFY_MODE == 1
    switch (_fpclass(d)) {
    case _FPCLASS_NZ:
    case _FPCLASS_PZ:
        return FP_ZERO;
    case _FPCLASS_NN:
    case _FPCLASS_PN:
        return FP_NORMAL;
    case _FPCLASS_ND:
    case _FPCLASS_PD:
        return FP_SUBNORMAL;
    case _FPCLASS_NINF:
    case _FPCLASS_PINF:
        return FP_INFINITE;
    default:
        Tcl_Panic("result of _fpclass() outside documented range!");
    case _FPCLASS_QNAN:
    case _FPCLASS_SNAN:
        return FP_NAN;
    }
#else /* TCL_FPCLASSIFY_MODE not in (0..3) */
#error "unknown or unexpected TCL_FPCLASSIFY_MODE"
#endif /* TCL_FPCLASSIFY_MODE */
#endif /* !fpclassify */
}

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        type = ClassifyDouble(d);
        result = (type != FP_INFINITE && type != FP_NAN);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsInfinityFunc(

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_INFINITE);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNaNFunc(

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_NAN);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNormalFunc(

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_NORMAL);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsSubnormalFunc(

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_SUBNORMAL);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsUnorderedFunc(

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        result = 1;
    } else {
        d = *((const double *) ptr);
        result = (ClassifyDouble(d) == FP_NAN);
    }

    if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        result |= 1;
    } else {
        d = *((const double *) ptr);
        result |= (ClassifyDouble(d) == FP_NAN);
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
FloatClassifyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    Tcl_Size objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    Tcl_Obj *objPtr;
    void *ptr;
    int type;

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

    if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        goto gotNaN;
    } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
        return TCL_ERROR;
    }
    switch (ClassifyDouble(d)) {
    case FP_INFINITE:
        TclNewLiteralStringObj(objPtr, "infinite");
        break;
    case FP_NAN:
    gotNaN:
        TclNewLiteralStringObj(objPtr, "nan");
        break;
    case FP_NORMAL:
        TclNewLiteralStringObj(objPtr, "normal");
        break;
    case FP_SUBNORMAL:
        TclNewLiteralStringObj(objPtr, "subnormal");
        break;
    case FP_ZERO:
        TclNewLiteralStringObj(objPtr, "zero");
        break;
    default:
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unable to classify number: %f", d));
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

    int expected,		/* Formal parameter count. */
    int found,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    const char *name = TclGetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
	tail--;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s arguments for math function \"%s\"",
	    (found < expected ? "not enough" : "too many"), name));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);

static int
wrapperNRObjProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
    clientData = info->clientData;
    Tcl_ObjCmdProc *proc = info->proc;
    Tcl_Free(info);
    return proc(clientData, interp, (int)objc, objv);
}

int

static int
cmdWrapperNreProc(
    void *clientData,
    Tcl_Interp *interp,
    Tcl_Size objc,
    Tcl_Obj *const objv[])
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;

    return info->nreProc(info->clientData, interp, objc, objv);
}

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

    info->proc = proc;
    info->clientData = clientData;
    info->nreProc = nreProc;
    info->deleteProc = deleteProc;
    info->deleteData = clientData;
    return Tcl_NRCreateCommand2(interp, cmdName,
	    (proc ? cmdWrapperProc : NULL),
	    (nreProc ? cmdWrapperNreProc : NULL),
	    info, cmdWrapperDeleteProc);
}
#endif /* TCL_NO_DEPRECATED */


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

    cmdPtr->nreProc2 = nreProc;
    return (Tcl_Command) cmdPtr;
}

Tcl_Command
TclNRCreateCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,
    Tcl_Namespace *nsPtr,
    Tcl_ObjCmdProc2 *proc,
    Tcl_ObjCmdProc2 *nreProc,
    void *clientData,
    Tcl_CmdDeleteProc *deleteProc)
{
    Command *cmdPtr = (Command *)
            TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
                    deleteProc);

    cmdPtr->nreProc2 = nreProc;
    return (Tcl_Command) cmdPtr;
}

/****************************************************************************
 * Stuff for the public api

    return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}

int
Tcl_NREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    Tcl_Size objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{

 *   3. when the NRCommand callback runs, it schedules the tailcall callback
 *      to run immediately after it returns
 *
 *   One delicate point is to properly define the NRCommand where the tailcall
 *   will execute. There are functions whose purpose is to help define the
 *   precise spot:
 *     TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
 *         should continue right here
 *     TclSkipTailcall:  if the NEXT command to be pushed tailcalls, execution
 *         should continue after the CURRENT command is fully returned ("skip
 *         the next command: we are redirecting to it, tailcalls should run
 *         after WE return")
 *     TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
 *         this point. This is special for OO, as some of the oo constructs
 *         that behave like commands may not push an NRCommand callback.
 */

void
TclMarkTailcall(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->deferredCallbacks == NULL) {
	TclNRAddCallback(interp, NRCommand, NULL, NULL,
                NULL, NULL);
        iPtr->deferredCallbacks = TOP_CB(interp);
    }
}

void
TclSkipTailcall(
    Tcl_Interp *interp)
{

     * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
     * (used by command redirectors).
     */

    NRE_callback *runPtr;

    for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
        if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
            break;
        }
    }
    if (!runPtr) {
        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
    }
    runPtr->data[1] = listPtr;
}

/*
 *----------------------------------------------------------------------
 *

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
	return TCL_ERROR;
    }

    if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.
     */

    if (iPtr->varFramePtr->tailcallPtr) {
        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
        iPtr->varFramePtr->tailcallPtr = NULL;
    }

    /*
     * Create the callback to actually evaluate the tailcalled
     * command, then set it in the varFrame so that PopCallFrame can use it
     * 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, TCL_INDEX_NONE);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
    return TCL_RETURN;
}

/*
 *----------------------------------------------------------------------
 *

    nsObjPtr = objv[0];

    if (result == TCL_OK) {
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    }

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

	Tcl_DecrRefCount(listPtr);
        return result;
    }

    /*
     * Perform the tailcall
     */

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

int
TclNRReleaseValues(
    void *data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yield can only be called in a coroutine", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL);
	return TCL_ERROR;
    }

    if (objc == 2) {
	Tcl_SetObjResult(interp, objv[1]);
    }

    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            clientData, NULL, NULL);
    return TCL_OK;
}

int
TclNRYieldToObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,

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

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", TCL_INDEX_NONE));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL);
	return TCL_ERROR;
    }

    if (((Namespace *) nsPtr)->flags & NS_DYING) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"yieldto called in deleted namespace", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		(char *)NULL);
        return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineActivateCallback --
 *
 *      This is the workhorse for coroutines: it implements both yield and
 *      resume.
 *
 *      It is important that both be implemented in the same callback: the
 *      detection of the impossibility to suspend due to a busy C-stack relies
 *      on the precise position of a local variable in the stack. We do not
 *      want the compiler to play tricks on us, either by moving things around
 *      or inlining.
 *
 *----------------------------------------------------------------------
 */

int
TclNRCoroutineActivateCallback(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    void *stackLevel = TclGetCStackPtr();

    if (!corPtr->stackLevel) {
        /*
         * -- Coroutine is suspended --
         * Push the callback to restore the caller's context on yield or
         * return.
         */

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

        /*
         * Record the stackLevel at which the resume is happening, then swap
         * the interp's environment to make it suitable to run this coroutine.
         */

        corPtr->stackLevel = stackLevel;
        Tcl_Size numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = iPtr->numLevels;

        SAVE_CONTEXT(corPtr->caller);
        corPtr->callerEEPtr = iPtr->execEnvPtr;
        RESTORE_CONTEXT(corPtr->running);
        iPtr->execEnvPtr = corPtr->eePtr;
        iPtr->numLevels += numLevels;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != stackLevel) {
	    NRE_callback *runPtr;

	    iPtr->execEnvPtr = corPtr->callerEEPtr;
	    if (corPtr->yieldPtr) {
		for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
		    if (runPtr->data[1] == corPtr->yieldPtr) {
			Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]);
			runPtr->data[1] = NULL;
			corPtr->yieldPtr = NULL;
			break;
		    }
		}
	    }
	    iPtr->execEnvPtr = corPtr->eePtr;


            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "cannot yield: C stack busy", TCL_INDEX_NONE));
            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    (char *)NULL);
            return TCL_ERROR;
        }

        void *type = data[1];
        if (type == CORO_ACTIVATE_YIELD) {
            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
        } else if (type == CORO_ACTIVATE_YIELDM) {
            corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }

	corPtr->yieldPtr = NULL;
        corPtr->stackLevel = NULL;

        Tcl_Size numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNREvalList --
 *
 *      Callback to invoke command as list, used in order to delayed
 *	processing of canonical list command in sane environment.
 *
 *----------------------------------------------------------------------
 */

static int
TclNREvalList(

}

/*
 *----------------------------------------------------------------------
 *
 * CoroTypeObjCmd --
 *
 *      Implementation of [::tcl::unsupported::corotype] command.
 *
 *----------------------------------------------------------------------
 */

static int
CoroTypeObjCmd(
    TCL_UNUSED(void *),

    /*
     * Look up the coroutine.
     */

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

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

    corPtr = (CoroutineData *)cmdPtr->objClientData2;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE));
        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", TCL_INDEX_NONE));
        return TCL_OK;
    case COROUTINE_ARGUMENTS_ARBITRARY:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE));
        return TCL_OK;
    default:
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unknown coroutine type", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL);
        return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd --
 *
 *      Implementation of [coroinject] and [coroprobe] commands.
 *
 *----------------------------------------------------------------------
 */

static inline CoroutineData *
GetCoroutineFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const char *errMsg)
{
    /*
     * How to get a coroutine from its handle.
     */

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

    if ((!cmdPtr) || (cmdPtr->nreProc2 != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objPtr), (char *)NULL);
        return NULL;
    }
    return (CoroutineData *)cmdPtr->objClientData2;
}

static int
TclNRCoroInjectObjCmd(
    TCL_UNUSED(void *),

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    iPtr->execEnvPtr = corPtr->eePtr;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

static int
TclNRCoroProbeObjCmd(

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a probe command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a probe command into a suspended coroutine",
                -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    iPtr->execEnvPtr = corPtr->eePtr;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr);
    iPtr->execEnvPtr = savedEEPtr;

    /*
     * Now we immediately transfer control to the coroutine to run our probe.
     * TRICKY STUFF copied from the [yield] implementation.
     *
     * Push the callback to restore the caller's context on yield back.
     */

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

    /*
     * Record the stackLevel at which the resume is happening, then swap
     * the interp's environment to make it suitable to run this coroutine.
     */

    corPtr->stackLevel = &corPtr;

}

/*
 *----------------------------------------------------------------------
 *
 * InjectHandler, InjectHandlerPostProc --
 *
 *      Part of the implementation of [coroinject] and [coroprobe]. These are
 *      run inside the context of the coroutine being injected/probed into.
 *
 *      InjectHandler runs a script (possibly adding arguments) in the context
 *      of the coroutine. The script is specified as a one-shot list (with
 *      reference count equal to 1) in data[1]. This function also arranges
 *      for InjectHandlerPostProc to be the part that runs after the script
 *      completes.
 *
 *      InjectHandlerPostProc cleans up after InjectHandler (deleting the
 *      list) and, for the [coroprobe] command *only*, yields back to the
 *      caller context (i.e., where [coroprobe] was run).
 *s
 *----------------------------------------------------------------------
 */

static int
InjectHandler(
    void *data[],

    /*
     * Call the user's script; we're in the right place.
     */

    Tcl_IncrRefCount(listPtr);
    TclMarkTailcall(interp);
    TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr,
            INT2PTR(nargs), isProbe);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}

static int
InjectHandlerPostCall(
    void *data[],

     * If we were doing a probe, splice ourselves back out of the stack
     * cleanly here. General injection should instead just look after itself.
     *
     * Code from guts of [yield] implementation.
     */

    if (isProbe) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp,
                    "\n    (injected coroutine probe command)");
        }
        corPtr->nargs = nargs;
        corPtr->stackLevel = NULL;
        Tcl_Size numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NRInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRInjectObjCmd(
    TCL_UNUSED(void *),

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", TCL_INDEX_NONE));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    iPtr->execEnvPtr = corPtr->eePtr;
    TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
	NULL, NULL, NULL);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

int
TclNRInterpCoroutine(
    void *clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Size objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = (CoroutineData *)clientData;

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

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

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        if (objc == 2) {
            Tcl_SetObjResult(interp, objv[1]);
        } else if (objc > 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
            return TCL_ERROR;
        }
        break;
    default:
        if (corPtr->nargs + 1 != objc) {
            Tcl_SetObjResult(interp,
                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
                    "not implemented!", TCL_INDEX_NONE));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL);
            return TCL_ERROR;
        }
        /* fallthrough */
    case COROUTINE_ARGUMENTS_ARBITRARY:
        if (objc > 1) {
            Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
        }
        break;
    }

    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineObjCmd --
 *
 *      Implementation of [coroutine] command; see documentation for
 *      description of what this does.
 *
 *----------------------------------------------------------------------
 */

int
TclNRCoroutineObjCmd(
    TCL_UNUSED(void *),

    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": unknown namespace",
                procName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": bad procedure name",
                procName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL);
	return TCL_ERROR;
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;

    /*
     * Now just resume the coroutine.
     */

    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}

/*
 * This is used in the [info] ensemble
 */

	}
	SET_BYTEARRAY(&ir, byteArrayPtr);
	Tcl_StoreInternalRep(objPtr, &properByteArrayType, &ir);
    }
    Tcl_IncrRefCount(objPtr);
    return objPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * SetByteArrayFromAny --
 *
 *	Generate the ByteArray internal rep from the string rep.

    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Alloc, et al. --
 *
 *	These functions are defined in terms of the debugging versions when

				 * added */
{
    TclInitDbCkalloc();
    Tcl_CreateObjCommand2(interp, "memory", MemoryCmd, NULL, NULL);
    Tcl_CreateObjCommand2(interp, "checkmem", CheckmemCmd, NULL, NULL);
}


#else	/* TCL_MEM_DEBUG */

/* This is the !TCL_MEM_DEBUG case */

#undef Tcl_InitMemory
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Alloc --
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check

 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclAllocElemsEx(
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	NULL, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to allocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,

 *    Pointer to allocated memory block which is at least as large
 *    as the requested size or NULL if allocation failed.
 *
 *------------------------------------------------------------------------
 */
void *
TclAttemptReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate or
			     * NULL to indicate this is a new allocation */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr;
    Tcl_Size limit;
    Tcl_Size attempt;

    assert(elemCount > 0);
    assert(elemSize > 0);

 *    Panics if memory of at least the requested size could not be
 *    allocated.
 *
 *------------------------------------------------------------------------
 */
void *
TclReallocElemsEx(
    void *oldPtr,	    /* Pointer to memory block to reallocate */
    Tcl_Size elemCount,     /* Allocation will store at least these many... */
    Tcl_Size elemSize,	    /* ...elements of this size */
    Tcl_Size leadSize,      /* Additional leading space in bytes */
    Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored
			       here if non-NULL. Only modified on success */
{
    void *ptr = TclAttemptReallocElemsEx(
	oldPtr, elemCount, elemSize, leadSize, capacityPtr);
    if (ptr == NULL) {
	Tcl_Panic("Failed to reallocate %" TCL_SIZE_MODIFIER
		  "d elements of size %" TCL_SIZE_MODIFIER "d bytes.",
		  elemCount,

	}
	ltzoc->localSeconds = fields->localSeconds;
	ltzoc->rangesVal[0] = rangesVal[0];
	ltzoc->rangesVal[1] = rangesVal[1];
	ltzoc->tzOffset = fields->tzOffset;
    }


    /* check DST-hole: if retrieved seconds is out of range */
    if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) {
    dstHole:
#if 0
	printf("given local-time is outside the time-zone (in DST-hole): "
		"%d - offs %d => %d <= %d < %d\n",
		(int)fields->localSeconds, fields->tzOffset,

 *
 * Side effects:
 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */


void
GetJulianDayFromEraYearDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    Tcl_WideInt year, ym1;

	    yydate.julianDay -= 7;
	}
	info->flags |= CLF_ASSEMBLE_DATE|CLF_ASSEMBLE_SECONDS;
    }

    return TCL_OK;
}


/*----------------------------------------------------------------------
 *
 * ClockWeekdaysOffs --
 *
 *	Get offset in days for the number of week days corresponding the
 *	given day of week (skipping Saturdays and Sundays).

    /* adjust if we end up on a weekend */
    if (resDayOfWeek > 5) {
	offs += 2;
    }

    return offs;
}



/*----------------------------------------------------------------------
 *
 * ClockAddObjCmd -- , clock add --
 *
 *	Adds an offset to a given time.
 *

	} else {
	    tokcnt += tokcnt;
	}
    }
    return ++tokcnt;
}

#define AllocTokenInChain(tok, chain, tokCnt, type) \
    if (++(tok) >= (chain) + (tokCnt)) {				\
	chain = (type)Tcl_AttemptRealloc((char *)(chain),		\
	    (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \
	if ((chain) == NULL) { 						\
	    goto done;							\
	}								\
	(tok) = (chain) + (tokCnt);					\
	(tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE;			\
    }									\
    memset(tok, 0, sizeof(*(tok)));

/*
 *----------------------------------------------------------------------
 */
ClockFmtScnStorage *
ClockGetOrParseScanFormat(

		/* next token */
		AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *);
		tokCnt++;
		p++;
		continue;
	    }
	    default:
		if (*p == ' ' || isspace(UCHAR(*p))) {
		    tok->map = &ScnSpaceTokenMap;
		    tok->tokWord.start = p++;
		    while (p < e && isspace(UCHAR(*p))) {
			p++;
		    }
		    tok->tokWord.end = p;
		    /* increase space count used in format */
		    fss->scnSpaceCount++;
		    /* next token */
		    AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *);
		    tokCnt++;
		    continue;
		}
	    word_tok:
	    {

		ClockScanToken *wordTok = tok;

		if (tok > scnTok && (tok - 1)->map == &ScnWordTokenMap) {

		    wordTok = tok - 1;


		}
		/* new word token */

		if (wordTok == tok) {




		    wordTok->tokWord.start = p;
		    wordTok->map = &ScnWordTokenMap;

		    AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *);
		    tokCnt++;
		}
		if (isspace(UCHAR(*p))) {
		    fss->scnSpaceCount++;
		}
		p = Tcl_UtfNext(p);
		wordTok->tokWord.end = p;
		break;
	    }
	    }
	}

	/* calculate end distance value for each tokens */
	if (tok > scnTok) {
	    unsigned endDist = 0;
	    ClockScanToken *prevTok = tok - 1;

	    }
	}

	/* now we're ready - assign now to storage (note the threaded race condition) */
	fss->scnTok = scnTok;
	fss->scnTokC = tokCnt;
    }
  done:
    Tcl_MutexUnlock(&ClockFmtMutex);

    return fss;
}

/*
 *----------------------------------------------------------------------
 */
int

		/* next token */
		AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *);
		tokCnt++;
		p++;
		continue;
	    }
	    default:
	    word_tok: {


		ClockFormatToken *wordTok = tok;

		if (tok > fmtTok && (tok - 1)->map == &FmtWordTokenMap) {

		    wordTok = tok - 1;


		}

		if (wordTok == tok) {

		    wordTok->tokWord.start = p;
		    wordTok->map = &FmtWordTokenMap;

		    AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *);
		    tokCnt++;
		}
		p = Tcl_UtfNext(p);
		wordTok->tokWord.end = p;
		break;
	    }

	    }
	}

	/* correct count of real used tokens and free mem if desired
	 * (1 is acceptable delta to prevent memory fragmentation) */
	if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) {
	    if ((tok = (ClockFormatToken *)
		    Tcl_AttemptRealloc(fmtTok, tokCnt * sizeof(*tok))) != NULL) {
		fmtTok = tok;
	    }
	}

	/* now we're ready - assign now to storage (note the threaded race condition) */
	fss->fmtTok = fmtTok;
	fss->fmtTokC = tokCnt;
    }
  done:
    Tcl_MutexUnlock(&ClockFmtMutex);
    return fss;
}

/*
 *----------------------------------------------------------------------
 */

{
    Tcl_MutexLock(&ClockFmtMutex);
    /* clear caches ... */
    Tcl_MutexUnlock(&ClockFmtMutex);
}

void
ClockFrmScnFinalize()
{
    if (!initialized) {
	return;
    }
    Tcl_MutexLock(&ClockFmtMutex);
#if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0
    /* clear GC */

	    /*
	     * Once an error has occurred, skip any future comparisons so as
	     * to preserve the error message in sortInterp->result.
	     */

	    return 0;
	}


	objPtr1 = elemPtr1->collationKey.objValuePtr;
	objPtr2 = elemPtr2->collationKey.objValuePtr;

	paramObjv[0] = objPtr1;
	paramObjv[1] = objPtr2;

	/* drop the script */
	dropScript = 1;
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    ExceptionRangeEnds(envPtr, range);


    /*
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
     * and jump around the "error case" code.
     */

    TclCheckStackDepth(depth+1, envPtr);
    PushStringLiteral(envPtr, "0");
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Emit the "error case" epilogue. Push the interpreter result and the
     * return code.
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclSetStackDepth(depth + dropScript, envPtr);

    if (dropScript) {
	TclEmitOpcode(		INST_POP,			envPtr);
    }


    /* Stack at this point is empty */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: result returnCode */

	    return TCL_ERROR;
	}
    default:
	return TCL_ERROR;
    }
    return TCL_OK;
}


/*----------------------------------------------------------------------
 *
 * TclCompileClockReadingCmd --
 *
 *	Procedure called to compile the "tcl::clock::microseconds",
 *	"tcl::clock::milliseconds" and "tcl::clock::seconds" commands.

	infoPtr->numLists++;

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


	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
		code = TCL_ERROR;
		goto done;

    TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define LOAD(idx) \
    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
#define INVOKE(name) \
    TclEmitInvoke(envPtr,INST_##name)


/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.

static Tcl_Size
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    Tcl_Size numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int ch;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {

    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a catch
				 * command. Errors in the range cause a jump
				 * to a catch PC offset. */
} ExceptionRangeType;

typedef struct {
    ExceptionRangeType type;	/* The kind of ExceptionRange. */
    Tcl_Size nestingLevel;		/* Static depth of the exception range. Used
				 * to find the most deeply-nested range
				 * surrounding a PC at runtime. */
    Tcl_Size codeOffset;		/* Offset of the first instruction byte of the
				 * code range. */
    Tcl_Size numCodeBytes;		/* Number of bytes in the code range. */
    Tcl_Size breakOffset;		/* If LOOP_EXCEPTION_RANGE, the target PC
				 * offset for a break command in the range. */
    Tcl_Size continueOffset;		/* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the
				 * target PC offset for a continue command in
				 * the code range. Otherwise, ignore this
				 * range when processing a continue
				 * command. */
    Tcl_Size catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
				 * offset for any "exception" in range. */
} ExceptionRange;

/*
 * Auxiliary data used when issuing (currently just loop) exception ranges,
 * but which is not required during execution.
 */

typedef struct ExceptionAux {
    int supportsContinue;	/* Whether this exception range will have a
				 * continueOffset created for it; if it is a
				 * loop exception range that *doesn't* have
				 * one (see [for] next-clause) then we must
				 * not pick up the range when scanning for a
				 * target to continue to. */
    Tcl_Size stackDepth;		/* The stack depth at the point where the
				 * exception range was created. This is used
				 * to calculate the number of POPs required to
				 * restore the stack to its prior state. */
    Tcl_Size expandTarget;		/* The number of expansions expected on the
				 * auxData stack at the time the loop starts;
				 * we can't currently discard them except by
				 * doing INST_INVOKE_EXPANDED; this is a known
				 * problem. */
    Tcl_Size expandTargetDepth;	/* The stack depth expected at the outermost
				 * expansion within the loop. Not meaningful
				 * if there are no open expansions between the
				 * looping level and the point of jump
				 * issue. */
    Tcl_Size numBreakTargets;	/* The number of [break]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    TCL_HASH_TYPE *breakTargets;	/* The offsets of the INST_JUMP4 instructions
				 * issued by the [break]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numBreakTargets==0, this is NULL. */
    Tcl_Size allocBreakTargets;	/* The size of the breakTargets array. */
    Tcl_Size numContinueTargets;	/* The number of [continue]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions

				 * issued by the [continue]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numContinueTargets==0, this is NULL. */
    Tcl_Size allocContinueTargets;	/* The size of the continueTargets array. */

} ExceptionAux;

/*
 * Structure used to map between instruction pc and source locations. It
 * defines for each compiled Tcl command its code's starting offset and its
 * source's starting offset and length. Note that the code offset increases
 * monotonically: that is, the table is sorted in code offset order. The
 * source offset is not monotonic.
 */

typedef struct {
    Tcl_Size codeOffset;		/* Offset of first byte of command code. */
    Tcl_Size numCodeBytes;		/* Number of bytes for command's code. */
    Tcl_Size srcOffset;		/* Offset of first char of the command. */
    Tcl_Size numSrcBytes;		/* Number of command source chars. */
} CmdLocation;

/*
 * TIP #280
 * Structure to record additional location information for byte code. This
 * information is internal and not saved. i.e. tbcload'ed code will not have
 * this information. It records the lines for all words of all commands found
 * in the byte code. The association with a ByteCode structure BC is done
 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
 * Also recorded is information coming from the context, i.e. type of the
 * frame and associated information, like the path of a sourced file.
 */

typedef struct {
    Tcl_Size srcOffset;		/* Command location to find the entry. */
    Tcl_Size nline;			/* Number of words in the command */
    Tcl_Size *line;			/* Line information for all words in the
				 * command. */
    Tcl_Size **next;			/* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;

typedef struct {
    int type;			/* Context type. */
    Tcl_Size start;		/* Starting line for compiled script. Needed
				 * for the extended recompile check in
				 * tclCompileObj. */
    Tcl_Obj *path;		/* Path of the sourced file the command is
				 * in. */
    ECL *loc;			/* Command word locations (lines). */
    Tcl_Size nloc;			/* Number of allocated entries in 'loc'. */
    Tcl_Size nuloc;			/* Number of used entries in 'loc'. */
} ExtCmdLoc;

/*
 * CompileProcs need the ability to record information during compilation that
 * can be used by bytecode instructions during execution. The AuxData
 * structure provides this "auxiliary data" mechanism. An arbitrary number of
 * these structures can be stored in the ByteCode record (during compilation
 * they are stored in a CompileEnv structure). Each AuxData record holds one
 * word of client-specified data (often a pointer) and is given an index that
 * instructions can later use to look up the structure and its data.
 *
 * The following definitions declare the types of procedures that are called
 * to duplicate or free this auxiliary data when the containing ByteCode
 * objects are duplicated and freed. Pointers to these procedures are kept in
 * the AuxData structure.
 */

typedef void *(AuxDataDupProc)  (void *clientData);
typedef void	   (AuxDataFreeProc) (void *clientData);
typedef void	   (AuxDataPrintProc)(void *clientData,
			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
			    TCL_HASH_TYPE pcOffset);

/*
 * We define a separate AuxDataType struct to hold type-related information
 * for the AuxData structure. This separation makes it possible for clients
 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
 * example, it makes it possible to pickle and unpickle AuxData structs.
 */

 * during compilation by CompileProcs and used by instructions during
 * execution.
 */

typedef struct AuxData {
    const AuxDataType *type;	/* Pointer to the AuxData type associated with
				 * this ClientData. */
    void *clientData;	/* The compilation data itself. */
} AuxData;

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */

				 * compiled. Commands and their compile procs
				 * are specific to an interpreter so the code
				 * emitted will depend on the interpreter. */
    const char *source;		/* The source string being compiled by
				 * SetByteCodeFromAny. This pointer is not
				 * owned by the CompileEnv and must not be
				 * freed or changed by it. */
    Tcl_Size numSrcBytes;		/* Number of bytes in source. */
    Proc *procPtr;		/* If a procedure is being compiled, a pointer
				 * to its Proc structure; otherwise NULL. Used
				 * to compile local variables. Set from
				 * information provided by ObjInterpProc in
				 * tclProc.c. */
    Tcl_Size numCommands;		/* Number of commands compiled. */
    Tcl_Size exceptDepth;		/* Current exception range nesting level; TCL_INDEX_NONE

				 * if not in any range currently. */
    Tcl_Size maxExceptDepth;		/* Max nesting level of exception ranges; TCL_INDEX_NONE
				 * if no ranges have been compiled. */

    Tcl_Size maxStackDepth;		/* Maximum number of stack elements needed to
				 * execute the code. Set by compilation
				 * procedures before returning. */
    Tcl_Size currStackDepth;		/* Current stack depth. */
    LiteralTable localLitTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects referenced by this compiled code.
				 * Indexed by the string representations of
				 * the literals. Used to avoid creating
				 * duplicate objects. */
    unsigned char *codeStart;	/* Points to the first byte of the code. */
    unsigned char *codeNext;	/* Points to next code array byte to use. */

    ExceptionRange *exceptArrayPtr;
    				/* Points to start of the ExceptionRange
				 * array. */
    Tcl_Size exceptArrayNext;	/* Next free ExceptionRange array index.
				 * exceptArrayNext is the number of ranges and
				 * (exceptArrayNext-1) is the index of the
				 * current range's array entry. */
    Tcl_Size exceptArrayEnd;		/* Index after the last ExceptionRange array
				 * entry. */
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE
				 * exceptions. Must be the same size as the
				 * exceptArrayPtr. */
    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.

    CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
				/* Initial storage for cmd location map. */
    AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
				/* Initial storage for aux data array. */
    /* TIP #280 */
    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
				 * 'info frame'. */
    Tcl_Size line;			/* First line of the script, based on the
				 * invoking context, then the line of the
				 * command currently compiled. */
    int atCmdStart;		/* Flag to say whether an INST_START_CMD
				 * should be issued; they should never be
				 * issued repeatedly, as that is significantly
				 * inefficient. If set to 2, that instruction
				 * should not be issued at all (by the generic
				 * part of the command compiler). */
    Tcl_Size expandCount;		/* Number of INST_EXPAND_START instructions
				 * encountered that have not yet been paired
				 * with a corresponding
				 * INST_INVOKE_EXPANDED. */
    Tcl_Size *clNext;	/* If not NULL, it refers to the next slot in
				 * clLoc to check for an invisible
				 * continuation line. */
} CompileEnv;

/*
 * The structure defining the bytecode instructions resulting from compiling a
 * Tcl script. Note that this structure is variable length: a single heap

typedef struct ByteCode {
    TclHandle interpHandle;	/* Handle for interpreter containing the
				 * compiled code. Commands and their compile
				 * procs are specific to an interpreter so the
				 * code emitted will depend on the
				 * interpreter. */
    Tcl_Size compileEpoch;		/* Value of iPtr->compileEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when, e.g., commands with compile
				 * procs are redefined. */
    Namespace *nsPtr;		/* Namespace context in which this code was
				 * compiled. If the code is executed if a
				 * different namespace, it must be
				 * recompiled. */

				 * Proc structure; otherwise NULL. This
				 * pointer is also not owned by the ByteCode
				 * and must not be freed by it. */
    size_t structureSize;	/* Number of bytes in the ByteCode structure
				 * itself. Does not include heap space for
				 * literal Tcl objects or storage referenced
				 * by AuxData entries. */
    Tcl_Size numCommands;		/* Number of commands compiled. */
    Tcl_Size numSrcBytes;		/* Number of source bytes compiled. */
    Tcl_Size numCodeBytes;		/* Number of code bytes. */
    Tcl_Size numLitObjects;		/* Number of objects in literal array. */
    Tcl_Size numExceptRanges;	/* Number of ExceptionRange array elems. */
    Tcl_Size numAuxDataItems;	/* Number of AuxData items. */
    Tcl_Size numCmdLocBytes;		/* Number of bytes needed for encoded command
				 * location information. */
    Tcl_Size maxExceptDepth;		/* Maximum nesting level of ExceptionRanges;
				 * TCL_INDEX_NONE if no ranges were compiled. */
    Tcl_Size maxStackDepth;		/* Maximum number of stack elements needed to
				 * execute the code. */
    unsigned char *codeStart;	/* Points to the first byte of the code. This
				 * is just after the final ByteCode member
				 * cmdMapPtr. */
    Tcl_Obj **objArrayPtr;	/* Points to the start of the literal object
				 * array. This is just after the last code
				 * byte. */

				 * variables. */
#ifdef TCL_COMPILE_STATS
    Tcl_Time createTime;	/* Absolute time when the ByteCode was
				 * created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;

#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr)			\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (codePtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), (typePtr), &ir);			\
    } while (0)



#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr)			\
    do {								\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), (typePtr));			\
	(codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * Opcodes for the Tcl bytecode instructions. These must correspond to the
 * entries in the table of instruction descriptions, tclInstructionTable, in
 * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
 * INST_BITOR) must match the entries in the array operatorStrings in

    INST_LAPPEND_LIST_ARRAY_STK,
    INST_LAPPEND_LIST_STK,

    INST_CLOCK_READ,

    INST_DICT_GET_DEF,

	/* TIP 461 */
	INST_STR_LT,
	INST_STR_GT,
	INST_STR_LE,
	INST_STR_GE,

    INST_LREPLACE4,

    /* TIP 667: const */
    INST_CONST_IMM,
    INST_CONST_STK,

				 * to 5 bytes. */
} JumpFixup;

#define JUMPFIXUP_INIT_ENTRIES	10

typedef struct JumpFixupArray {
    JumpFixup *fixup;		/* Points to start of jump fixup array. */
    Tcl_Size next;			/* Index of next free array entry. */
    Tcl_Size end;			/* Index of last usable entry in array. */
    int mallocedArray;		/* 1 if array was expanded and fixups points
				 * into the heap, else 0. */
    JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES];
				/* Initial storage for jump fixup array. */
} JumpFixupArray;

/*
 * The structure describing one variable list of a foreach command. Note that
 * only foreach commands inside procedure bodies are compiled inline so a
 * ForeachVarList structure always describes local variables. Furthermore,
 * only scalar variables are supported for inline-compiled foreach loops.
 */

typedef struct ForeachVarList {
    Tcl_Size numVars;		/* The number of variables in the list. */
    Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")

				 * for each variable in the procedure's array
				 * of local variables. Only scalar variables
				 * are supported. The actual size of this
				 * field will be large enough to numVars
				 * indexes. THIS MUST BE THE LAST FIELD IN THE
				 * STRUCTURE! */
} ForeachVarList;

/*
 * Structure used to hold information about a foreach command that is needed
 * during program execution. These structures are stored in CompileEnv and
 * ByteCode structures as auxiliary data.
 */

typedef struct ForeachInfo {
    Tcl_Size numLists;		/* The number of both the variable and value
				 * lists of the foreach command. */
    Tcl_Size firstValueTemp;		/* Index of the first temp var in a proc frame
				 * used to point to a value list. */
    Tcl_Size loopCtTemp;		/* Index of temp var in a proc frame holding
				 * the loop's iteration count. Used to
				 * determine next value list element to assign
				 * each loop var. */
    ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList

				 * structures describing each var list. The
				 * actual size of this field will be large
				 * enough to numVars indexes. THIS MUST BE THE
				 * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

/*

 * Structure used to hold information about a [dict update] command that is
 * needed during program execution. These structures are stored in CompileEnv
 * and ByteCode structures as auxiliary data.
 */

typedef struct {
    Tcl_Size length;		/* Size of array */
    Tcl_Size varIndices[TCLFLEXARRAY];		/* Array of variable indices to manage when

				 * processing the start and end of a [dict
				 * update]. There is really more than one
				 * entry, and the structure is allocated to
				 * take account of this. MUST BE LAST FIELD IN
				 * STRUCTURE. */
} DictUpdateInfo;

#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    Tcl_Size length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, Tcl_Size objc,
			    Tcl_Obj *const objv[], int isLambda);

/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution

    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02
#define LITERAL_UNSHARED	0x04

/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *

 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);

 */

#define TclAdjustStackDepth(delta, envPtr) \
    do {								\
	if ((delta) < 0) {						\
	    if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) {	\
		(envPtr)->maxStackDepth = (envPtr)->currStackDepth;	\
	    }								\
	}								\


	(envPtr)->currStackDepth += (delta);				\
    } while (0)


#define TclGetStackDepth(envPtr)		\
    ((envPtr)->currStackDepth)

#define TclSetStackDepth(depth, envPtr)		\
    (envPtr)->currStackDepth = (depth)






#define TclCheckStackDepth(depth, envPtr)				\
    do {								\
	size_t _dd = (depth);						\


	if (_dd != (size_t)(envPtr)->currStackDepth) {				\
	    Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \

		    (size_t)(envPtr)->currStackDepth, _dd);		\
	}								\
    } while (0)



/*
 * Macro used to update the stack requirements. It is called by the macros
 * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
 * Remark that the very last instruction of a bytecode always reduces the
 * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
 * updated.
 *

 * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);


 */

#define TclUpdateStackReqs(op, i, envPtr) \
    do {							\
	int _delta = tclInstructionTable[(op)].stackEffect;	\
	if (_delta) {						\
	    if (_delta == INT_MIN) {				\
		_delta = 1 - (i);				\
	    }							\

	    TclAdjustStackDepth(_delta, envPtr);			\
	}							\
    } while (0)



/*
 * Macros used to update the flag that indicates if we are at the start of a
 * command, based on whether the opcode is INST_START_COMMAND.
 *
 * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
 */

#define TclUpdateAtCmdStart(op, envPtr) \
    if ((envPtr)->atCmdStart < 2) {				     \
	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
    }

/*
 * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
 * "prototype" for this macro is:
 *
 * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
 */

#define TclEmitOpcode(op, envPtr) \
    do {							\
	if ((envPtr)->codeNext == (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, 0, envPtr);			\
    } while (0)

/*
 * Macros to emit an integer operand. The ANSI C "prototype" for these macros
 * are:
 *
 * void TclEmitInt1(int i, CompileEnv *envPtr);

	*(envPtr)->codeNext++ = (unsigned char) (op);			\
	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
	TclUpdateAtCmdStart(op, envPtr);				\
	TclUpdateStackReqs(op, i, envPtr);				\
    } while (0)

#define TclEmitInstInt4(op, i, envPtr) \
    do {							\
	if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) {	\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 24);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 16);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >>  8);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i)      );	\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, i, envPtr);			\
    } while (0)

/*
 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
 * object's one or four byte array index into the CompileEnv's code array.
 * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
 * CompileEnv. The ANSI C "prototype" for this macro is:
 *
 * void	TclEmitPush(int objIndex, CompileEnv *envPtr);
 */

#define TclEmitPush(objIndex, envPtr) \
    do {							 \
	int _objIndexCopy = (objIndex);			 \
	if (_objIndexCopy <= 255) {				 \
	    TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \
	} else {						 \
	    TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \
	}							 \
    } while (0)

/*
 * Macros to update a (signed or unsigned) integer starting at a pointer. The
 * two variants depend on the number of bytes. The ANSI C "prototypes" for
 * these macros are:
 *
 * void TclStoreInt1AtPtr(int i, unsigned char *p);
 * void TclStoreInt4AtPtr(int i, unsigned char *p);
 */

#define TclStoreInt1AtPtr(i, p) \
    *(p)   = (unsigned char) ((unsigned int) (i))

#define TclStoreInt4AtPtr(i, p) \
    do {							\
	*(p)   = (unsigned char) ((unsigned int) (i) >> 24);	\
	*(p+1) = (unsigned char) ((unsigned int) (i) >> 16);	\
	*(p+2) = (unsigned char) ((unsigned int) (i) >>  8);	\
	*(p+3) = (unsigned char) ((unsigned int) (i)      );	\
    } while (0)

/*
 * Macros to update instructions at a particular pc with a new op code and a
 * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
 * are:
 *
 * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
 * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
 */

#define TclUpdateInstInt1AtPc(op, i, pc) \
    do {					\
	*(pc) = (unsigned char) (op);		\
	TclStoreInt1AtPtr((i), ((pc)+1));	\
    } while (0)

#define TclUpdateInstInt4AtPc(op, i, pc) \
    do {					\
	*(pc) = (unsigned char) (op);		\
	TclStoreInt4AtPtr((i), ((pc)+1));	\
    } while (0)

/*
 * Macro to fix up a forward jump to point to the current code-generation
 * position in the bytecode being created (the most common case). The ANSI C
 * "prototypes" for this macro is:
 *

#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
#   define TclGetInt1AtPtr(p) \
    ((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0)))
#endif

#define TclGetInt4AtPtr(p) \
    ((int) ((TclGetUInt1AtPtr(p) << 24) |			\
		       (*((p)+1) << 16) |			\
		       (*((p)+2) <<  8) |			\
		       (*((p)+3))))

#define TclGetUInt1AtPtr(p) \
    ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \
    ((unsigned int) ((*(p)     << 24) |				\
		     (*((p)+1) << 16) |				\
		     (*((p)+2) <<  8) |				\
		     (*((p)+3))))

/*
 * Macros used to compute the minimum and maximum of two values. The ANSI C
 * "prototypes" for these macros are:
 *
 * size_t TclMin(size_t i, size_t j);
 * size_t TclMax(size_t i, size_t j);
 */

#define TclMin(i, j)	((((size_t) i) + 1 < ((size_t) j) + 1 )? (i) : (j))
#define TclMax(i, j)	((((size_t) i) + 1 > ((size_t) j) + 1 )? (i) : (j))

/*
 * Convenience macros for use when compiling bodies of commands. The ANSI C
 * "prototype" for these macros are:
 *
 * static void		BODY(Tcl_Token *tokenPtr, int word);
 */

#define BODY(tokenPtr, word)						\
    SetLineInformation((word));						\
    TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents,	\
	    envPtr)

/*
 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
 * "prototype" for this macro is:

MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
MODULE_SCOPE FILE *tclDTraceDebugLog;
MODULE_SCOPE void TclDTraceOpenDebugLog(void);
MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi);

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	char n[35];						\
	snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \
		(size_t) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }

#define TclDTraceDbgMsg(p, m, ...) \
    do {								\
	if (tclDTraceDebugEnabled) {					\
	    int _l, _t = 0;						\
	    if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); }	\

#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    1
#define TCL_DTRACE_PROC_RETURN_ENABLED()    1
#define TCL_DTRACE_PROC_RESULT_ENABLED()    1
#define TCL_DTRACE_PROC_ARGS_ENABLED()	    1
#define TCL_DTRACE_PROC_INFO_ENABLED()	    1
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2)
#define TCL_DTRACE_PROC_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
		a2, a3, a4, a5, a6, a7)

#define TCL_DTRACE_CMD_ENTRY_ENABLED()	    1
#define TCL_DTRACE_CMD_RETURN_ENABLED()	    1
#define TCL_DTRACE_CMD_RESULT_ENABLED()	    1
#define TCL_DTRACE_CMD_ARGS_ENABLED()	    1
#define TCL_DTRACE_CMD_INFO_ENABLED()	    1
#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2)
#define TCL_DTRACE_CMD_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \

    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};

#define InstNameSetInternalRep(objPtr, inst)				\
    do {							\
	Tcl_ObjInternalRep ir;					\
	ir.wideValue = (inst);					\
	Tcl_StoreInternalRep((objPtr), &instNameType, &ir);		\
    } while (0)

#define InstNameGetInternalRep(objPtr, inst)				\
    do {							\
	const Tcl_ObjInternalRep *irPtr;				\
	irPtr = TclFetchInternalRep((objPtr), &instNameType);	\
	assert(irPtr != NULL);					\
	(inst) = irPtr->wideValue;			\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * GetLocationInformation --
 *
 *	This procedure looks up the information about where a procedure was

static Tcl_EncodingConvertProc	Utf16ToUtfProc;
static Tcl_EncodingConvertProc	UtfToUtf16Proc;
static Tcl_EncodingConvertProc	UtfToUcs2Proc;
static Tcl_EncodingConvertProc	UtfToUtfProc;
static Tcl_EncodingConvertProc	Iso88591FromUtfProc;
static Tcl_EncodingConvertProc	Iso88591ToUtfProc;


/*
 * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
 * of the internalrep. This should help the lifetime of encodings be more useful.
 * See concerns raised in [Bug 1077262].
 */

static const Tcl_ObjType encodingType = {
    "encoding",
    FreeEncodingInternalRep,
    DupEncodingInternalRep,
    NULL,
    NULL,
    TCL_OBJTYPE_V0
};

#define EncodingSetInternalRep(objPtr, encoding)				\
    do {								\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (encoding);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreInternalRep((objPtr), &encodingType, &ir);			\
    } while (0)

#define EncodingGetInternalRep(objPtr, encoding)				\
    do {								\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep ((objPtr), &encodingType);		\
	(encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingFromObj --
 *
 *	Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), if

    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_ExternalToUtfDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ExternalToUtfDStringEx --
 *
 *	Convert a source buffer from the specified encoding into UTF-8.

int
Tcl_ExternalToUtfDStringEx(
    Tcl_Interp *interp,         /* For error messages. May be NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    Tcl_Size srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_DString *dstPtr,	/* Uninitialized or free DString in which the
				 * converted string is stored. */
    Tcl_Size *errorLocPtr)      /* Where to store the error location
                                   (or TCL_INDEX_NONE if no error). May
				   be NULL. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result;
    Tcl_Size dstLen, soFar;
    const char *srcStart = src;

    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    Tcl_UtfToExternalDStringEx(
	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
    return Tcl_DStringValue(dstPtr);
}


/*
 *-------------------------------------------------------------------------
 *
 * Tcl_UtfToExternalDStringEx --
 *
 *	Convert a source buffer from UTF-8 to the specified encoding.

    const char *src,		/* Source string in UTF-8. */
    Tcl_Size srcLen,		/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_DString *dstPtr,	/* Uninitialized or free DString in which the
				 * converted string is stored. */
    Tcl_Size *errorLocPtr)      /* Where to store the error location
                                   (or TCL_INDEX_NONE if no error). May
				   be NULL. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int result;
    const char *srcStart = src;
    Tcl_Size dstLen, soFar;