#    else /* !__LP64__ */
#	undef TCL_WIDE_INT_IS_LONG
#	undef TCL_CFG_DO64BIT
#    endif /* __LP64__ */
#    undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */


/* Cross-compiling 32-bit on a 64-bit platform? Then our
 * configure script does the wrong thing. Correct that here.
 */
#if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__)
#   undef TCL_WIDE_INT_IS_LONG
#endif

/*

 * 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 {
#if TCL_MAJOR_VERSION > 8
    Tcl_Size start;			/* Character offset of first character in
				 * match. */
    Tcl_Size end;			/* Character offset of first character after
				 * the match. */
#else
    long start;
    long end;
#endif
} 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. */
#if TCL_MAJOR_VERSION > 8
    Tcl_Size extendStart;		/* The offset at which a subsequent match
				 * might begin. */
#else
    long extendStart;
    long reserved;		/* Reserved for later use. */
#endif
} Tcl_RegExpInfo;

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

/*

				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
#if TCL_MAJOR_VERSION > 8
    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 */
#endif
} Tcl_ObjType;

#if TCL_MAJOR_VERSION > 8
#   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), \

				 * 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

 * Type values returned by Tcl_GetNumberFromObj
 *	TCL_NUMBER_INT		Representation is a Tcl_WideInt
 *	TCL_NUMBER_BIG		Representation is an mp_int
 *	TCL_NUMBER_DOUBLE	Representation is a double
 *	TCL_NUMBER_NAN		Value is NaN.
 */

#define TCL_NUMBER_INT          2
#define TCL_NUMBER_BIG          3
#define TCL_NUMBER_DOUBLE       4
#define TCL_NUMBER_NAN          5

/*
 * Flag values passed to Tcl_ConvertElement.
 * TCL_DONT_USE_BRACES forces it not to enclose the element in braces, but to
 *	use backslash quoting instead.
 * TCL_DONT_QUOTE_HASH disables the default quoting of the '#' character. It
 *	is safe to leave the hash unquoted when the element is not the first
 *	element of a list, and this flag can be used by the caller to indicate
 *	that condition.
 */

#define TCL_DONT_USE_BRACES	1
#define TCL_DONT_QUOTE_HASH	8

/*
 * Flags that may be passed to Tcl_GetIndexFromObj.
 * TCL_EXACT disallows abbreviated strings.
 * TCL_NULL_OK allows the empty string or NULL to return TCL_OK.
 *      The returned value will be -1;
 * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is
 *      a table that will not live long enough to make it worthwhile.
 */

#define TCL_EXACT		1
#define TCL_NULL_OK		32
#define TCL_INDEX_TEMP_TABLE	64

/*

 */

#define TCL_NO_EVAL		0x010000
#define TCL_EVAL_GLOBAL		0x020000
#define TCL_EVAL_DIRECT		0x040000
#define TCL_EVAL_INVOKE		0x080000
#define TCL_CANCEL_UNWIND	0x100000
#define TCL_EVAL_NOERR          0x200000

/*
 * Special freeProc values that may be passed to Tcl_SetResult (see the man
 * page for details):
 */

#define TCL_VOLATILE		((Tcl_FreeProc *) 1)

 *				There are some things, pointers for example
 *				which don't hash well because they do not use
 *				the lower bits. If this flag is set then the
 *				hash table will attempt to rectify this by
 *				randomising the bits and then using the upper
 *				N bits as the index into the table.
 * TCL_HASH_KEY_SYSTEM_HASH -	If this flag is set then all memory internally
 *                              allocated for the hash table that is not for an
 *                              entry will use the system heap.
 * TCL_HASH_KEY_DIRECT_COMPARE -
 * 	                        Allows fast comparison for hash keys directly
 *                              by compare of their key.oneWordValue values,
 *                              before call of compareKeysProc (much slower
 *                              than a direct compare, so it is speed-up only
 *                              flag). Don't use it if keys contain values rather
 *                              than pointers.
 */

#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
#define TCL_HASH_KEY_SYSTEM_HASH    0x2
#define TCL_HASH_KEY_DIRECT_COMPARE 0x4

/*

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)

    TclBounceRefCount(objPtr);

static inline void
TclBounceRefCount(
    Tcl_Obj* objPtr)
{
    if (objPtr) {
        if ((objPtr)->refCount == 0) {
            Tcl_DecrRefCount(objPtr);
	}
    }
}

#endif

/*

 * 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

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

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

#undef TclpAlloc
void *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
{
    return malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *

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

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)

			    int *boolResult);
static int		TclArithSeriesObjStep(Tcl_Obj *arithSeriesObj,
			    Tcl_Obj **stepObj);

/* ------------------------ ArithSeries object type -------------------------- */

static const Tcl_ObjType arithSeriesType = {
    "arithseries",			/* name */
    FreeArithSeriesInternalRep,		/* freeIntRepProc */
    DupArithSeriesInternalRep,		/* dupIntRepProc */
    UpdateStringOfArithSeries,		/* updateStringProc */
    SetArithSeriesFromAny,		/* setFromAnyProc */
    TCL_OBJTYPE_V2(
    ArithSeriesObjLength,
    TclArithSeriesObjIndex,
    TclArithSeriesObjRange,
    TclArithSeriesObjReverse,
    TclArithSeriesGetElements,
    NULL, // SetElement
    NULL, // Replace
    ArithSeriesInOperation) // "in" operator
};

/*
 * Helper functions
 *
 * - power10 -- Fast version of pow(10, (int) n) for common cases.
 * - ArithRound -- Round doubles to the number of significant fractional

 * TclNewArithSeriesObj --
 *
 *	Creates a new ArithSeries object. Some arguments may be NULL and will
 *	be computed based on the other given arguments.
 *      refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	An empty Tcl_Obj if the range is invalid.
 *
 * Side Effects:
 *
 * 	None.

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

int
TclNewArithSeriesObj(
    Tcl_Interp *interp,       /* For error reporting */
    Tcl_Obj **arithSeriesObj, /* return value */
    int useDoubles,           /* Flag indicates values start,
			      ** end, step, are treated as doubles */
    Tcl_Obj *startObj,        /* Starting value */
    Tcl_Obj *endObj,          /* Ending limit */
    Tcl_Obj *stepObj,         /* increment value */
    Tcl_Obj *lenObj)          /* Number of elements */
{
    double dstart, dend, dstep;
    Tcl_WideInt start, end, step;
    Tcl_WideInt len = -1;

    if (startObj) {
	assignNumber(useDoubles, &start, &dstart, startObj);

 *	Returns the element with the specified index in the list
 *	represented by the specified Arithmetic Sequence object.
 *	If the index is out of range, TCL_ERROR is returned,
 *	otherwise TCL_OK is returned and the integer value of the
 *	element is stored in *element.
 *
 * Results:
 *
 * 	TCL_OK on success.
 *
 * Side Effects:
 *
 * 	On success, the integer pointed by *element is modified.
 * 	An empty string ("") is assigned if index is out-of-bounds.
 *
 *----------------------------------------------------------------------
 */
int
TclArithSeriesObjIndex(

 *----------------------------------------------------------------------
 *
 * ArithSeriesObjLength
 *
 *	Returns the length of the arithmetic series.
 *
 * Results:
 *
 * 	The length of the series as Tcl_WideInt.
 *
 * Side Effects:
 *
 * 	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Size
ArithSeriesObjLength(
    Tcl_Obj *arithSeriesObj)

 *
 * TclArithSeriesObjStep --
 *
 *	Return a Tcl_Obj with the step value from the give ArithSeries Obj.
 *	refcount = 0.
 *
 * Results:
 *
 * 	A Tcl_Obj pointer to the created ArithSeries object.
 * 	A NULL pointer of the range is invalid.
 *
 * Side Effects:
 *
 * 	None.

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

int
TclArithSeriesObjStep(
    Tcl_Obj *arithSeriesObj,
    Tcl_Obj **stepObj)
{
    ArithSeries *arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

 * 	The Arithmetic Series object is just an way to optimize
 * 	Lists space complexity, so no one should try to convert
 * 	a string to an Arithmetic Series object.
 *
 * 	This function is here just to populate the Type structure.
 *
 * Results:
 *
 * 	The result is always TCL_ERROR. But see Side Effects.
 *
 * Side effects:
 *
 * 	Tcl Panic if called.
 *
 *----------------------------------------------------------------------
 */

static int
SetArithSeriesFromAny(
    TCL_UNUSED(Tcl_Interp *),		/* Used for error reporting if not NULL. */
    TCL_UNUSED(Tcl_Obj *))		/* The object to convert. */
{
    Tcl_Panic("SetArithSeriesFromAny: should never be called");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclArithSeriesObjRange --
 *
 *	Makes a slice of an ArithSeries value.
 *      *arithSeriesObj must be known to be a valid list.
 *
 * Results:
 *	Returns a pointer to the sliced series.
 *      This may be a new object or the same object if not shared.
 *
 * Side effects:
 *	?The possible conversion of the object referenced by listPtr?
 *	?to a list object.?
 *
 *----------------------------------------------------------------------
 */

int
TclArithSeriesObjRange(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to take a range from. */
    Tcl_Size fromIdx,		/* Index of first element to include. */
    Tcl_Size toIdx,		/* Index of last element to include. */
    Tcl_Obj **newObjPtr)        /* return value */
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;

    (void)interp; /* silence compiler */

    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);

 * Side effects:
 *      The ogiginal obj will be modified and returned if it is not Shared.
 *
 *----------------------------------------------------------------------
 */
int
TclArithSeriesObjReverse(
    Tcl_Interp *interp,         /* For error message(s) */
    Tcl_Obj *arithSeriesObj,	/* List object to reverse. */
    Tcl_Obj **newObjPtr)
{
    ArithSeries *arithSeriesRepPtr;
    Tcl_Obj *startObj, *endObj, *stepObj;
    Tcl_Obj *resultObj;
    Tcl_WideInt start, end, step, len;

 *	Boolean true or false (1/0)
 *
 * Side effects:
 *      None
 *
 *----------------------------------------------------------------------
 */

static int
ArithSeriesInOperation(
    Tcl_Interp *interp,
    Tcl_Obj *valueObj,
    Tcl_Obj *arithSeriesObjPtr,
    int *boolResult)
{

    /*
     * Vector on the type of instruction being processed.
     */

    instType = TalInstructionTable[tblIdx].instType;
    switch (instType) {

    case ASSEM_PUSH:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;

				 * invoked in the next call to
				 * Tcl_AsyncInvoke. */
    struct AsyncHandler *nextPtr, *prevPtr;
				/* Next, previous in list of all handlers
				 * for the process. */
    Tcl_AsyncProc *proc;	/* Procedure to call when handler is
				 * invoked. */
    void *clientData;	/* Value to pass to handler when it is
				 * invoked. */
    struct ThreadSpecificData *originTsd;
				/* Used in Tcl_AsyncMark to modify thread-
				 * specific data from outside the thread it is
				 * associated to. */
    Tcl_ThreadId originThrdId;	/* Origin thread where this token was created
				 * and where it will be yielded. */
    void *notifierData;	/* Platform notifier data or NULL. */
} AsyncHandler;

typedef struct ThreadSpecificData {
    int asyncReady;		/* This is set to 1 whenever a handler becomes
				 * ready and it is cleared to zero whenever
				 * Tcl_AsyncInvoke is called. It can be
				 * checked elsewhere in the application by

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

Tcl_AsyncHandler
Tcl_AsyncCreate(
    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
				 * invoked. */
    void *clientData)	/* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    asyncPtr = (AsyncHandler*)Tcl_Alloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;

 *	The handler gets marked for invocation later.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncMark(
    Tcl_AsyncHandler async)		/* Token for handler. */
{
    AsyncHandler *token = (AsyncHandler *) async;

    Tcl_MutexLock(&asyncMutex);
    token->ready = 1;
    if (!token->originTsd->asyncActive) {
	token->originTsd->asyncReady = 1;
	Tcl_ThreadAlert(token->originThrdId);
    }
    Tcl_MutexUnlock(&asyncMutex);

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncMarkFromSignal --
 *

 *	The handler gets marked for invocation later.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AsyncMarkFromSignal(
    Tcl_AsyncHandler async,		/* Token for handler. */
    int sigNumber)			/* Signal number. */
{
#if TCL_THREADS
    AsyncHandler *token = (AsyncHandler *) async;

    return TclAsyncNotifier(sigNumber, token->originThrdId,
	    token->notifierData, &token->ready, -1);
#else

 *	deleted by some other thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AsyncDelete(
    Tcl_AsyncHandler async)		/* Token for handler to delete. */
{
    AsyncHandler *asyncPtr = (AsyncHandler *) async;

    /*
     * Assure early handling of the constraint
     */

 *	1  - _fpclass
 *	2  - simulate
 *	3  - __builtin_fpclassify
 *
 * Not directly used; handled by preprocessor.
 */
enum ClassifyModes {
    MODE_FPCLASSIFY = 0,
    MODE_FPCLASS = 1,
    MODE_SIMULATE = 2,
    MODE_BUILTIN = 3
};

#ifndef TCL_FPCLASSIFY_MODE
#if defined(__MINGW32__) && defined(_X86_) /* mingw 32-bit */
/*
 * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify,
 * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to using a
 * version using a compiler built-in.
 */
#define TCL_FPCLASSIFY_MODE 1
#elif defined(fpclassify)		/* fpclassify */
/*
 * This is the C99 standard.
 */
#include <float.h>
#define TCL_FPCLASSIFY_MODE 0
#elif defined(_FPCLASS_NN)		/* _fpclass */
/*
 * This case handles newer MSVC on Windows, which doesn't have the standard
 * operation but does have something that can tell us the same thing.
 */
#define TCL_FPCLASSIFY_MODE 1
#else	/* !fpclassify && !_fpclass (older MSVC), simulate */
/*

    const char *name;		/* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
    CompileProc *compileProc;	/* Function called to compile command. */
    Tcl_ObjCmdProc *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 int

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

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

	}

	Tcl_MutexUnlock(&cancelLock);
    }

#undef TclObjInterpProc
    if (commandTypeInit == 0) {
        TclRegisterCommandTypeName(TclObjInterpProc, "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->objProc = cmdInfoPtr->objProc;
	    cmdPtr->objClientData = 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->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

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

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

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

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

    Tcl_ObjCmdProc *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_ObjCmdProc *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    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_CreateObjCommand(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(int) /*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];

 */

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

     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", -1));
        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

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

 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

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

static int
cmdWrapperProc(
    void *clientData,
    Tcl_Interp *interp,

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

				 * 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. */
)
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr;
    const char *tail;

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

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

    return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
	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_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. */
{
    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);

 *	InvokeStringCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */

int
InvokeStringCommand(
    void *clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr = (Command *)clientData;
    int i, result;
    const char **argv = (const char **)
	    TclStackAlloc(interp, (objc + 1) * sizeof(char *));

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

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

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

 *	Transfers a message from the cancellation message to the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
CancelEvalProc(
    void *clientData,	/* Interp to cancel the script in progress. */
    TCL_UNUSED(Tcl_Interp *),
    int code)			/* Current return code from command. */
{
    CancelInfo *cancelInfo = (CancelInfo *)clientData;
    Interp *iPtr;

    if (cancelInfo != NULL) {

 *	deleted or when the last ByteCode referring to it is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupCommand(
    Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    if (cmdPtr->refCount-- <= 1) {
	Tcl_Free(cmdPtr);
    }
}


    /*
     * 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, -1));
        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;

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

    }

    /*
     * Configure evaluation context to match the requested flags.
     */

    if (iPtr->lookupNsPtr) {

	/*
	 * Capture the namespace we should do command name resolution in, as
	 * instructed by our caller sneaking it in to us in a private interp
	 * field.  Clear that field right away so we cannot possibly have its
	 * use leak where it should not.  The sneaky message pass is done.
	 *
	 * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
	 * TODO: Is that a bug?
	 */

	lookupNsPtr = iPtr->lookupNsPtr;
	iPtr->lookupNsPtr = NULL;
    } else if (flags & TCL_EVAL_INVOKE) {
	lookupNsPtr = iPtr->globalNsPtr;
    } else {

	/*
	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
	 */

	TclResetRewriteEnsemble(interp, 1);

	if (flags & TCL_EVAL_GLOBAL) {
	    TEOV_SwitchVarFrame(interp);
	    lookupNsPtr = iPtr->globalNsPtr;
	}
    }

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

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

     * 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_Token *tokenPtr;
    int expandRequested, code = TCL_OK;
    Tcl_Size bytesLeft, commandLength;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
				 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    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_DecrRefCount(objv[objectsUsed]);
			break;
		    }
		    expandRequested = 1;
		    expand[objectsUsed] = 1;

		    additionalObjsCount = (numElements ? numElements : 1);

		} else {
		    expand[objectsUsed] = 0;
		    additionalObjsCount = 1;
		}

		/* Currently max command words in INT_MAX */
		if (additionalObjsCount > INT_MAX ||

     * 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

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

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;

    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", -1));
	return TCL_ERROR;
    }
    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }
    return Tcl_NRCallObjProc(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", -1));
    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. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{

    }
    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. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{

    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

    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. */
    int 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;
}

/*
 *----------------------------------------------------------------------

				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc2 *proc,	/* Object-based function to associate with
				 * name, provides direct access for direct
				 * calls. */
    Tcl_ObjCmdProc2 *nreProc,	/* Object-based function to associate with
				 * name, provides NR implementation */
    void *clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo));
    info->proc = proc;

				 * 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. */
{
    Command *cmdPtr = (Command *)
	    Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
                    deleteProc);

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

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

    cmdPtr->nreProc = 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. */
{

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", -1));
        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, -1);
        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);

    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", -1));
	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", -1));
	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", -1));
        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
     */

    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", -1));
            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;
}

/*
 *----------------------------------------------------------------------

    /*
     * Look up the coroutine.
     */

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

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

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

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

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
        return TCL_OK;
    case COROUTINE_ARGUMENTS_ARBITRARY:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
        return TCL_OK;
    default:
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unknown coroutine type", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL);
        return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd --

    /*
     * How to get a coroutine from its handle.
     */

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

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

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

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

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

    int 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!", -1));
            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 --

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

    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes))
#define BYTEARRAY_SIZE(len) \
        ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \
	? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \
	: (offsetof(ByteArray, bytes) + (len)) )
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)

int

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

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    Tcl_Size numBytes)		/* Number of bytes in resized array
                                 * Must be >= 0 */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjInternalRep *irPtr;

    assert(numBytes >= 0);
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");

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

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

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

TclDumpMemoryInfo(
    void *clientData,
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
        return 0;
    }
    snprintf(buf, sizeof(buf),
	    "total mallocs             %10" TCL_Z_MODIFIER "u\n"
	    "total frees               %10" TCL_Z_MODIFIER "u\n"
	    "current packets allocated %10" TCL_Z_MODIFIER "u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10" TCL_Z_MODIFIER "u\n"

	Tcl_Panic("Memory validation failure");
    }

    if (nukeGuards) {
	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
	memset(hiPtr, 0, HIGH_GUARD_SIZE);
    }

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ValidateAllMemory --
 *

	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
                    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
	Tcl_WideInt value;
	if (objc != 3) {

	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "cannot open output file: %s",
                    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }

	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "bad option \"%s\": should be active, break_on_malloc, info, "
            "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
            TclGetString(objv[1])));
    return TCL_ERROR;

  argError:
    Tcl_WrongNumArgs(interp, 2, objv, "count");
    return TCL_ERROR;

  bad_suboption:

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

 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static void
ClockDeleteCmdProc(
    void *clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);

ClockMCDict(
    ClockFmtScnCmdArgs *opts)
{
    ClockClientData *dataPtr = opts->dataPtr;

    /* if dict not yet retrieved */
    if (opts->mcDictObj == NULL) {

	/* if locale was not yet used */
	if (!(opts->flags & CLF_LOCALE_USED)) {
	    opts->localeObj = NormLocaleObj(dataPtr, opts->interp,
		    opts->localeObj, &opts->mcDictObj);

	    if (opts->localeObj == NULL) {
		Tcl_SetObjResult(opts->interp, Tcl_NewStringObj(

	    && (!(dataPtr->lastBase.date.flags & CLF_CTZ)
	    || dataPtr->lastTZEpoch == TzsetIfNecessary())) {
	memcpy(date, &dataPtr->lastBase.date, ClockCacheableDateFieldsSize);
    } else {
	/* extact fields from base */
	date->seconds = baseVal;
	if (ClockGetDateFields(dataPtr, interp, date, opts->timezoneObj,
	      GREGORIAN_CHANGE_DATE) != TCL_OK) {
	    /* TODO - GREGORIAN_CHANGE_DATE should be locale-dependent */
	    return TCL_ERROR;
	}
	/* cache last base */
	memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize);
	TclSetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj);
    }

ClockSafeCatchCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    typedef struct {
        int status;			/* return code status */
        int flags;			/* Each remaining field saves the */
        int returnLevel;		/* corresponding field of the Interp */
        int returnCode;			/* struct. These fields taken together are */
        Tcl_Obj *errorInfo;		/* the "state" of the interp. */
        Tcl_Obj *errorCode;
        Tcl_Obj *returnOpts;
        Tcl_Obj *objResult;
        Tcl_Obj *errorStack;
        int resetErrorStack;
    } InterpState;

	/* regards all possible spaces here (because they are optional) */
	end = p + tok->lookAhMax + yySpaceCount + 1;
	if (end > info->dateEnd) {
	    end = info->dateEnd;
	}
	p += tok->lookAhMin;
	if (laTok->map && p < end) {

	    /* try to find laTok between [lookAhMin, lookAhMax] */
	    while (minLen < maxLen) {
		const char *f = FindTokenBegin(p, end, laTok,
				    TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT);
		/* if found (not below lookAhMax) */
		if (f < end) {
		    break;

     * Invalidate result
     */
    flags |= info->flags;

    /* seconds token (%s) take precedence over all other tokens */
    if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) {
	if (flags & CLF_DATE) {

	    if (!(flags & CLF_JULIANDAY)) {
		info->flags |= CLF_ASSEMBLE_SECONDS|CLF_ASSEMBLE_JULIANDAY;

		/* dd precedence below ddd */
		switch (flags & (CLF_MONTH|CLF_DAYOFYEAR|CLF_DAYOFMONTH)) {
		case (CLF_DAYOFYEAR | CLF_DAYOFMONTH):
		    /* miss month: ddd over dd (without month) */

 *    - *failVarPtr is set to -failindex option value or NULL
 *    On error, all of the above are uninitialized.
 *
 *------------------------------------------------------------------------
 */
static int
EncodingConvertParseOptions(
    Tcl_Interp *interp,    /* For error messages. May be NULL */
    int objc,		   /* Number of arguments */
    Tcl_Obj *const objv[], /* Argument objects as passed to command. */
    Tcl_Encoding *encPtr,  /* Where to store the encoding */
    Tcl_Obj **dataObjPtr,  /* Where to store ptr to Tcl_Obj containing data */
    int *profilePtr,         /* Bit mask of encoding option profile */
    Tcl_Obj **failVarPtr   /* Where to store -failindex option value */
)
{
    static const char *const options[] = {"-profile", "-failindex", NULL};
    enum convertfromOptions { PROFILE, FAILINDEX } optIndex;
    Tcl_Encoding encoding;
    Tcl_Obj *dataObj;
    Tcl_Obj *failVarObj;
    int profile = TCL_ENCODING_PROFILE_STRICT;

    *encPtr = encoding;
    *dataObjPtr = dataObj;
    *profilePtr = profile;
    *failVarPtr = failVarObj;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
 *	Tcl string

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    Tcl_Size length = 0;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */
    int flags;
    int result;
    Tcl_Obj *failVarObj;
    Tcl_Size errorLocation;

    if (EncodingConvertParseOptions(interp, objc, objv, &encoding, &data,

    Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds));

    /* We're done with the encoding */

    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConverttoObjCmd --
 *

	    Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

    /* We're done with the encoding */

    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * EncodingDirsObjCmd --
 *

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

int
EncodingNamesObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,	    /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetEncodingNames(interp);
    return TCL_OK;

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

int
EncodingProfilesObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,	    /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    TclGetEncodingProfiles(interp);
    return TCL_OK;

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

int
EncodingSystemObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,     /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp,

{
    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
	TclNewObj(result);
	Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
        Tcl_DictObjPut(NULL, result,            \
            Tcl_NewStringObj((key), -1),        \
            (objValue));
	DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
	DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
	DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
	DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
	DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
	DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
	DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
	DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
	DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
	DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
	mode = (unsigned short) statPtr->st_mode;
	DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
	DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef DOBJPUT
	Tcl_SetObjResult(interp, result);
	Tcl_DecrRefCount(result);
	return TCL_OK;
    }

    /*

	/* Variables */
	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
	if (statePtr->vCopyList[i] == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	result = TclListObjLength(interp, statePtr->vCopyList[i],
	    &statePtr->varcList[i]);
	if (result != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
	if (statePtr->varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s varlist is empty",
		(statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		(statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		"NEEDVARS", (void *)NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
	    &statePtr->varcList[i], &statePtr->varvList[i]);

	/* Values */
	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
	    /* Special case for AbstractList */
	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
	    if (statePtr->aCopyList[i] == NULL) {
		result = TCL_ERROR;

Tcl_Obj *
TclInfoFrame(
    Tcl_Interp *interp,		/* Current interpreter. */
    CmdFrame *framePtr)		/* Frame to get info for. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *tmpObj;
    Tcl_Obj *lv[20] = {NULL};		/* Keep uptodate when more keys are added to
				 * the dict. */
    int lc = 0;
    /*
     * This array is indexed by the TCL_LOCATION_... values, except
     * for _LAST.
     */
    static const char *const typeString[TCL_LOCATION_LAST] = {

	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	Tcl_Size i;

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

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

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

int
Tcl_LinsertObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    Tcl_Size len, index;
    int copied = 0, result;

    if (objc < 3) {

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

int
Tcl_ListObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise set the interpreter's result object to be a list object.
     */

    if (objc > 1) {

 */

int
Tcl_LlengthObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Size listLen;
    int result;
    Tcl_Obj *objPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");

 */

int
Tcl_LpopObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Size listLen;
    int copied = 0, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr;

    if (objc < 2) {

 */

int
Tcl_LrangeObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int result;
    Tcl_Size listLen, first, last;
    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

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

int
Tcl_LrepeatObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    Tcl_WideInt elementCount, i;
    Tcl_Size totalElems;
    Tcl_Obj *listPtr, **dataArray = NULL;

    /*
     * Check arguments for legality:

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

	Tcl_SetObjResult(interp, resultObj);
    } else {

	/*
	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
	 * returning a pointer to the live array of Tcl_Obj values.
	 */

	for (i=0,j=elemc-1 ; i<j ; i++,j--) {
	    Tcl_Obj *tmp = elemv[i];

    /*
     * Create a decoding key by looping through the arguments and identify
     * what kind of argument each one is.  Encode each argument as a decimal
     * digit.
     */
    if (objc > 6) {
	 /* Too many arguments */
	 arg_key=0;
    } else for (i=1; i<objc; i++) {
	 arg_key = (arg_key * 10);
	 numValues[value_i] = NULL;
	 decoded = SequenceIdentifyArgument(interp, objv[i], &numberObj, &keyword);
	 switch (decoded) {

	 case NoneArg:
	      /*
	       * Unrecognizable argument
	       * Reproduce operation error message
	       */
	      status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations,
		           "operation", 0, &opmode);
	      goto done;

	 case NumericArg:
	      arg_key += NumericArg;
	      numValues[value_i] = numberObj;
	      Tcl_IncrRefCount(numValues[value_i]);
	      values[value_i] = keyword;  // This is the TCL_NUMBER_* value
	      useDoubles = useDoubles ? useDoubles : keyword == TCL_NUMBER_DOUBLE;
	      value_i++;
	      break;

	 case RangeKeywordArg:
	      arg_key += RangeKeywordArg;
	      values[value_i] = keyword;
	      value_i++;
	      break;

	 case ByKeywordArg:
	      arg_key += ByKeywordArg;
	      values[value_i] = keyword;
	      value_i++;
	      break;

	 default:
	      arg_key += 9; // Error state
	      value_i++;
	      break;
	 }
    }

    /*
     * The key encoding defines a valid set of arguments, or indicates an
     * error condition; process the values accordningly.
     */
    switch (arg_key) {

/*    No argument */
    case 0:
	 Tcl_WrongNumArgs(interp, 1, objv,
	     "n ??op? n ??by? n??");
	 goto done;
	 break;

	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    if (TclObjTypeHasProc(objv[1], getElementsProc)) {
	sortInfo.resultCode =
	    TclObjTypeGetElements(interp, listObj, &length, &listObjPtrs);
    } else {
	sortInfo.resultCode = TclListObjGetElements(interp, listObj,
	    &length, &listObjPtrs);
    }
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }

    /*
     * Check for sanity when grouping elements of the overall list together

    const char *left, const char *right)	/* The strings to compare. */
{
    int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
    int diff, zeros;
    int secondaryDiff = 0;

    while (1) {
		if (isdigit(UCHAR(*right))		/* INTL: digit */
		&& isdigit(UCHAR(*left))) {	/* INTL: digit */
	    /*
	     * There are decimal numbers embedded in the two strings. Compare
	     * them as numbers, rather than strings. If one number has more
	     * leading zeros than the other, the number with more leading
	     * zeros sorts later, but only as a secondary choice.
	     */

     * case where the regexp pattern can match the empty string - this is
     * useful when doing, say, 'regsub -- ^ $str ...' when $str might be
     * empty.
     */

    numMatches = 0;
    for ( ; offset <= wlen; ) {

	/*
	 * The flags argument is set if string is part of a larger string, so
	 * that "^" won't match.
	 */

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
		10 /* matches */, ((offset > 0 &&

		Tcl_SetHashValue(hPtr, objPtr);
	    } else {
		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	    }
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	}
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	const char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one Unicode char is > 1
	 * byte in length.

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

    if ((last < 0) ||	/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */
	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

    /*
     * Can only handle the case where we are appending to a local scalar when
     * there are multiple values to append.  Fortunately, this is common.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (localIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Definitely appending to a local scalar; generate the words and append
     * them.

	 * a non-local variable: upvar from a local one! This consumes the
	 * variable name that was left at stacktop.
	 */

	localIndex = TclFindCompiledLocal(varTokenPtr->start,
		varTokenPtr->size, 1, envPtr);
	PushStringLiteral(envPtr, "0");
	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
	TclEmitOpcode(INST_POP,          			envPtr);
    }

    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);

     */

    resultIndex = optsIndex = -1;
    cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if ((int)parsePtr->numWords >= 3) {
	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
	/* DGP */
	resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
	if (resultIndex < 0) {
	    return TCL_ERROR;
	}

	/* DKF */
	if (parsePtr->numWords == 4) {
	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
	    optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
	    if (optsIndex < 0) {
		return TCL_ERROR;
	    }
	}
    }

    /*

	    &localIndex, &isScalar, 1);

    /*
     * If the user specified an array element, we don't bother handling
     * that.
     */
    if (!isScalar) {
        return TCL_ERROR;
    }

    /*
     * We are doing an assignment to set the value of the constant. This will
     * need to be extended to push a value for each argument.
     */

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }

    /*
     * Remaining words (key path and value to set) can be handled normally.
     */

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Emit the key and the code to actually do the increment.
     */

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Remaining words (the key path) can be handled normally.
     */

    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	Tcl_Free((void *)argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    Tcl_Free((void *)argv);

    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
    if (dictIndex < 0) {
	goto issueFallback;
    }

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices

	tokenPtr = TokenAfter(tokenPtr);

	/*
	 * Stash the index in the auxiliary data (if it is indeed a local
	 * scalar that is resolvable at compile-time).
	 */

	duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr);
	if (duiPtr->varIndices[i] == TCL_INDEX_NONE) {
	    goto failedUpdateInfoAssembly;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	goto failedUpdateInfoAssembly;

    }

    /*
     * Get the index of the local variable that we will be working with.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
    }

    /*
     * Produce the string to concatenate onto the dictionary entry.
     */

    /*
     * Parse the arguments.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    keyTokenPtr = TokenAfter(varTokenPtr);
    valueTokenPtr = TokenAfter(keyTokenPtr);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Issue the implementation.
     */

    }

    /*
     * Determine if we're manipulating a dict in a simple local variable.
     */

    gotPath = ((int)parsePtr->numWords > 3);
    dictVar = LocalScalarFromToken(varTokenPtr, envPtr);

    /*
     * Special case: an empty body means we definitely have no need to issue
     * try-finally style code or to allocate local variable table entries for
     * storing temporaries. Still need to do both INST_DICT_EXPAND and
     * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
     * of traces.

	    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;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);

 *	the new ForeachInfo record.
 *
 *----------------------------------------------------------------------
 */

static void *
DupForeachInfo(
    void *clientData)	/* The foreach command's compilation auxiliary
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

 *	ForeachInfo structure.
 *
 *----------------------------------------------------------------------
 */

static void
FreeForeachInfo(
    void *clientData)	/* The foreach command's compilation auxiliary
				 * data to free. */
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    size_t i, numLists = infoPtr->numLists;

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

    i = 0;			/* The count of things to concat. */
    j = 2;			/* The index into the argument tokens, for
				 * TIP#280 handling. */
    start = TclGetString(formatObj);
				/* The start of the currently-scanned literal
				 * in the format string. */
    TclNewObj(tmpObj);	/* The buffer used to accumulate the literal
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {

TclLocalScalar(
    const char *bytes,
    size_t numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] = {
	{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
        {TCL_TOKEN_TEXT, NULL, 0, 0}
    };

    token[1].start = bytes;
    token[1].size = numBytes;
    return TclLocalScalarFromToken(token, envPtr);
}


	    name = varTokenPtr[1].start;
	    nameLen = p - varTokenPtr[1].start;
	    elName = p + 1;
	    remainingLen = (varTokenPtr[2].start - p) - 1;
	    elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;

	    if (!(flags & TCL_NO_ELEMENT)) {
	      if (remainingLen) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */

		memcpy(elemTokenPtr+1, varTokenPtr+2,
			(n-1) * sizeof(Tcl_Token));
	      } else {
		/*
		 * Use the already available tokens.
		 */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;
	      }
	    }
	}
    }

    if (simpleVarName) {
	/*
	 * See whether name has any namespace separators (::'s).

	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (isScalar) {	/* Simple scalar variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
	    }

    localTokenPtr = tokenPtr;
    for (i=2; i<numWords; i+=2) {
	otherTokenPtr = TokenAfter(localTokenPtr);
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*

     * be called at runtime.
     */

    for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
    }

    /*

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

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

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

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

     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

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

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

    if (parsePtr->numWords == 5) {
    /*
     * When we have a string replacement, we have to take care about
     * not replacing empty substrings that [string replace] promises
     * not to replace
     *
     * The remaining index values might be suitable for conventional
     * string replacement, but only if they cannot possibly meet the
     * conditions described above at runtime. If there's a chance they
     * might, we would have to emit bytecode to check and at that point
     * we're paying more in bytecode execution time than would make
     * things worthwhile. Trouble is we are very limited in
     * how much we can detect that at compile time. After decoding,
     * we need, first:
     *
     *		(first <= end)
     *
     * The encoded indices (first <= TCL_INDEX END) and
     * (first == TCL_INDEX_NONE) always meets this condition, but
     * any other encoded first index has some list for which it fails.
     *
     * We also need, second:
     *
     *		(last >= 0)
     *
     * The encoded index (last >= TCL_INDEX_START) always meet this
     * condition but any other encoded last index has some list for
     * which it fails.
     *
     * Finally we need, third:
     *
     *		(first <= last)
     *
     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */

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

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

	/* FLOW THROUGH TO genericReplace */

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

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

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

    genericReplace:
	tokenPtr = TokenAfter(valueTokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 3);
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	} else {
	    PUSH(	"");
	}
	OP(		STR_REPLACE);
	return TCL_OK;
}

int
TclCompileStringTrimLCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */

/*
    if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) {
	toSubst = objv[numOpts];
	Tcl_IncrRefCount(toSubst);
    }
*/


    /* TODO: Figure out expansion to cover WordKnownAtCompileTime
     *	The difficulty is that WKACT makes a copy, and if TclSubstParse
     *	below parses the copy of the original source string, some deep
     *	parts of the compile machinery get upset.  They want all pointers
     *	stored in Tcl_Tokens to point back to the same original string.
     */
    if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	code = TclSubstOptions(NULL, numOpts, objv, &flags);
    }

  cleanup:
    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (/*toSubst == NULL*/ code != TCL_OK) {
	return TCL_ERROR;
    }

    SetLineInformation(numArgs);
    TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);

/*    TclDecrRefCount(toSubst);*/
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,

    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int mode,			/* Exact, Glob or Regexp */
    int noCase,			/* Case-insensitivity flag. */
    Tcl_Size numBodyTokens,	/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    Tcl_Size *bodyLines,		/* Array of line numbers for body list
				 * items. */
    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
{
    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */

IssueSwitchJumpTable(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    Tcl_Size *bodyLines,		/* Array of line numbers for body list
				 * items. */
    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
{
    JumptableInfo *jtPtr;
    int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
    int mustGenerate, foundDefault, jumpToDefault, i;
    Tcl_DString buffer;

		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		Tcl_Size len;
		const char *varname = TclGetStringFromObj(objv[0], &len);

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

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

 * The four category values are LEAF, UNARY, and BINARY, explained below, and
 * "uncategorized", which is used either temporarily, until context determines
 * which of the other three categories is correct, or for lexemes like
 * INVALID, which aren't really lexemes at all, but indicators of a parsing
 * error. Note that the codes must be distinct to distinguish categories, but
 * need not take the form of a bit array.
 */

#define BINARY		0x40	/* This lexeme is a binary operator. An OpNode
				 * representing it should go into the parse
				 * tree, and two operands should be parsed for
				 * it in the expression. */
#define UNARY		0x80	/* This lexeme is a unary operator. An OpNode
				 * representing it should go into the parse
				 * tree, and one operand should be parsed for
				 * it in the expression. */
#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
				 * tree. No OpNode will be placed in the tree
				 * for it. Either a literal value will be
				 * appended to the list of literals in this
				 * expression, or appropriate Tcl_Tokens will
				 * be appended in a Tcl_Parse struct to
				 * represent those leaves that require some
				 * form of substitution. */



/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#define BAREWORD	3	/* Ambiguous. Resolves to BOOLEAN or to
				 * FUNCTION or a parse error according to
				 * context and value. */
#define INCOMPLETE	4	/* A parse error. Used only when the single
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
				 * appears that's not a supported operator. */
#define COMMENT		6	/* Comment. Lasts to end of line or end of
				 * expression, whichever comes first. */

/* Leaf lexemes */

#define NUMBER		(LEAF | 1)
				/* For literal numbers */
#define SCRIPT		(LEAF | 2)
				/* Script substitution; [foo] */
#define BOOLEAN		(LEAF | BAREWORD)
				/* For literal booleans */
#define BRACED		(LEAF | 4)
				/* Braced string; {foo bar} */
#define VARIABLE	(LEAF | 5)
				/* Variable substitution; $x */
#define QUOTED		(LEAF | 6)
				/* Quoted string; "foo $bar [soom]" */
#define EMPTY		(LEAF | 7)
				/* Used only for an empty argument list to a
				 * function. Represents the empty string
				 * within parens in the expression: rand() */

/* Unary operator lexemes */

#define UNARY_PLUS	(UNARY | PLUS)
#define UNARY_MINUS	(UNARY | MINUS)
#define FUNCTION	(UNARY | BAREWORD)
				/* This is a bit of "creative interpretation"
				 * on the part of the parser. A function call
				 * is parsed into the parse tree according to
				 * the perspective that the function name is a
				 * unary operator and its argument list,
				 * enclosed in parens, is its operand. The
				 * additional requirements not implied
				 * generally by treatment as a unary operator
				 * -- for example, the requirement that the
				 * operand be enclosed in parens -- are hard
				 * coded in the relevant portions of
				 * ParseExpr(). We trade off the need to
				 * include such exceptional handling in the
				 * code against the need we would otherwise
				 * have for more lexeme categories. */
#define START		(UNARY | 4)
				/* This lexeme isn't parsed from the
				 * expression text at all. It represents the
				 * start of the expression and sits at the
				 * root of the parse tree where it serves as
				 * the start/end point of traversals. */
#define OPEN_PAREN	(UNARY | 5)
				/* Another bit of creative interpretation,
				 * where we treat "(" as a unary operator with
				 * the sub-expression between it and its
				 * matching ")" as its operand. See
				 * CLOSE_PAREN below. */
#define NOT		(UNARY | 6)
#define BIT_NOT		(UNARY | 7)

/* Binary operator lexemes */

#define BINARY_PLUS	(BINARY |  PLUS)
#define BINARY_MINUS	(BINARY |  MINUS)
#define COMMA		(BINARY |  3)
				/* The "," operator is a low precedence binary
				 * operator that separates the arguments in a
				 * function call. The additional constraint
				 * that this operator can only legally appear
				 * at the right places within a function call
				 * argument list are hard coded within
				 * ParseExpr().  */
#define MULT		(BINARY |  4)
#define DIVIDE		(BINARY |  5)
#define MOD		(BINARY |  6)
#define LESS		(BINARY |  7)
#define GREATER		(BINARY |  8)
#define BIT_AND		(BINARY |  9)
#define BIT_XOR		(BINARY | 10)
#define BIT_OR		(BINARY | 11)
#define QUESTION	(BINARY | 12)
				/* These two lexemes make up the */
#define COLON		(BINARY | 13)
				/* ternary conditional operator, $x ? $y : $z.
				 * We treat them as two binary operators to
				 * avoid another lexeme category, and code the
				 * additional constraints directly in
				 * ParseExpr(). For instance, the right
				 * operand of a "?" operator must be a ":"
				 * operator. */
#define LEFT_SHIFT	(BINARY | 14)
#define RIGHT_SHIFT	(BINARY | 15)
#define LEQ		(BINARY | 16)
#define GEQ		(BINARY | 17)
#define EQUAL		(BINARY | 18)
#define NEQ		(BINARY | 19)
#define AND		(BINARY | 20)
#define OR		(BINARY | 21)
#define STREQ		(BINARY | 22)
#define STRNEQ		(BINARY | 23)
#define EXPON		(BINARY | 24)
				/* Unlike the other binary operators, EXPON is
				 * right associative and this distinction is
				 * coded directly in ParseExpr(). */
#define IN_LIST		(BINARY | 25)
#define NOT_IN_LIST	(BINARY | 26)
#define CLOSE_PAREN	(BINARY | 27)
				/* By categorizing the CLOSE_PAREN lexeme as a
				 * BINARY operator, the normal parsing rules
				 * for binary operators assure that a close
				 * paren will not directly follow another
				 * operator, and the machinery already in
				 * place to connect operands to operators
				 * according to precedence performs most of
				 * the work of matching open and close parens
				 * for us. In the end though, a close paren is
				 * not really a binary operator, and some
				 * special coding in ParseExpr() make sure we
				 * never put an actual CLOSE_PAREN node in the
				 * parse tree. The sub-expression between
				 * parens becomes the single argument of the
				 * matching OPEN_PAREN unary operator. */
#define STR_LT		(BINARY | 28)
#define STR_GT		(BINARY | 29)
#define STR_LEQ		(BINARY | 30)
#define STR_GEQ		(BINARY | 31)
#define END		(BINARY | 32)
				/* This lexeme represents the end of the
				 * string being parsed. Treating it as a
				 * binary operator follows the same logic as
				 * the CLOSE_PAREN lexeme and END pairs with
				 * START, in the same way that CLOSE_PAREN
				 * pairs with OPEN_PAREN. */


/*
 * When ParseExpr() builds the parse tree it must choose which operands to
 * connect to which operators.  This is done according to operator precedence.
 * The greater an operator's precedence the greater claim it has to link to an
 * available operand.  The Precedence enumeration lists the precedence values
 * used by Tcl expression operators, from lowest to highest claim.  Each

		     * name, and there's no place in the parse tree to store
		     * it, so we keep a separate list of all the function
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    /*
		     * Tricky case: see test expr-62.10
		     */

		    int scanned2 = scanned;
		    do {

		scanned = 0;
		insertMark = 1;

		/*
		 * Free any literal to avoid a memleak.
		 */

		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		/*
		 * TODO: Consider using a dict or hash to collapse all
		 * duplicate literals into a single representative value.
		 * (Like what is done with [split $s {}]).
		 * Pro:	~75% memory saving on expressions like
		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
		 *	to "pointer" cost only)

		Tcl_DecrRefCount(literal);
	    }
	    complete = lastParsed = OT_TOKENS;
	    break;
	} /* case LEAF */

	case UNARY:

	    /*
	     * A unary operator appearing just after something that's not an
	     * operator is a syntax error -- something trying to be the left
	     * operand of an operator that doesn't take one.
	     */

	    if (NotOperator(lastParsed)) {

	/*
	 * Handle next child node or leaf.
	 */

	switch (next) {
	case OT_EMPTY:

	    /* No tokens and no characters for the OT_EMPTY leaf. */
	    break;

	case OT_LITERAL:

	    /*
	     * Skip any white space that comes before the literal.
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    numBytes -= scanned;

	    start += scanned;
	    numBytes -= scanned;
	    tokenPtr += toCopy;
	    break;
	}

	default:

	    /*
	     * Advance to the child node, which is an operator.
	     */

	    nodePtr = nodes + next;

	    /*

	     * Generate tokens for the operator / subexpression...
	     */

	    switch (nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/*
		 * Historical practice has been to have no Tcl_Tokens for
		 * these operators.
		 */

		break;

	    default: {

		/*
		 * Remember the index of the last subexpression we were
		 * working on -- that of our parent. We'll stack it later.
		 */

		parentIdx = subExprTokenIdx;

		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means
		 * we can make other use of this field for now to track the
		 * stack of subexpressions we have pending.
		 */

		subExprTokenPtr[1].numComponents = parentIdx;
		break;
	    }
	    }
	    break;
	}

	/* Determine which way to exit the node on this pass. */
    router:
	switch (nodePtr->mark) {

	    start += scanned;
	    numBytes -= scanned;
	    break;

	case MARK_PARENT:
	    switch (nodePtr->lexeme) {
	    case START:

		/* When we get back to the START node, we're done. */
		return;

	    case COMMA:
	    case COLON:

		/* No tokens for these lexemes -> nothing to do. */
		break;

	    case OPEN_PAREN:

		/*
		 * Skip past matching close paren.
		 */

		scanned = TclParseAllWhiteSpace(start, numBytes);
		start += scanned;
		numBytes -= scanned;

				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList;	/* List to hold the literals. */
    Tcl_Obj *funcList;	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);

	break;
    }

    TclNewObj(literal);
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !TclIsBareword(*end)) {

	number:
	    *lexemePtr = NUMBER;
	    if (literalPtr) {
		TclInitStringRep(literal, start, end-start);
		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);

{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
	Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
		2 * (objc-2) * sizeof(Tcl_Obj *));

	OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
	unsigned char lexeme;
	int i, lastAnd = 1;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);

	litObjv[0] = objv[1];

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

static void		CleanupByteCode(ByteCode *codePtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    Tcl_Size cmdNumber, Tcl_Size numSrcBytes, Tcl_Size numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,

    "substcode",		/* name */
    FreeSubstCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
    TCL_OBJTYPE_V0
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2


/*

 * Helper macros.
 */





#define TclIncrUInt4AtPtr(ptr, delta) \
    TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr))


/*
 *----------------------------------------------------------------------
 *
 * TclSetByteCodeFromAny --
 *
 *	Part of the bytecode Tcl object type implementation. Attempts to

int
TclSetByteCodeFromAny(
    Tcl_Interp *interp,		/* The interpreter for which the code is being
				 * compiled. Must not be NULL. */
    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
    void *clientData)	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    Tcl_Size length;
    int result = TCL_OK;
    const char *stringPtr;

 *	delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    ByteCode *codePtr;

    ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);

    /* Just dropped to refcount==0.  Clean up. */
    CleanupByteCode(codePtr);
}

static void
CleanupByteCode(
    ByteCode *codePtr)	/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    Tcl_Obj **objArrayPtr, *objPtr;
    const AuxData *auxDataPtr;

     * of an interpreter being deleted, which is signaled by interp == NULL.
     * Also, as the interp deletion will remove the global literal table
     * anyway, avoid the extra cost of updating it for each literal being
     * released.
     */

    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {

	objArrayPtr = codePtr->objArrayPtr;
	for (i = 0;  i < numLitObjects;  i++) {
	    objPtr = *objArrayPtr;
	    if (objPtr) {
		Tcl_DecrRefCount(objPtr);
	    }
	    objArrayPtr++;

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

static ByteCode *
CompileSubstObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int flags)
{
    Interp *iPtr = (Interp *) interp;
    ByteCode *codePtr = NULL;

    ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr);

    if (codePtr != NULL) {
	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;

	if (flags != PTR2INT(SubstFlags(objPtr))
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    Tcl_StoreInternalRep(objPtr, &substCodeType, NULL);

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

	TclEmitOpcode(INST_DONE, &compEnv);
	codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
	TclFreeCompileEnv(&compEnv);

	SubstFlags(objPtr) = INT2PTR(flags);
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 2) {
	    TclPrintByteCodeObj(interp, objPtr);

 *	the cleanup is delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeSubstCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    ByteCode *codePtr;

    ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);

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

void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    CompileEnv *envPtr,/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    size_t numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{

 */

void
TclCompileCmdWord(
    Tcl_Interp *interp,		/* Used for error and status reporting. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens for
				 * a command word to compile inline. */
    size_t count1,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    int count = count1;

    if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) {
	/*

ByteCode *
TclInitByteCodeObj(
    Tcl_Obj *objPtr,		/* Points object that should be initialized,
				 * and whose string rep contains the source
				 * code. */
    const Tcl_ObjType *typePtr,
    CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    ByteCode *codePtr;

    PreventCycle(objPtr, envPtr);

    codePtr = TclInitByteCode(envPtr);

 *	variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Size
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    Tcl_Size nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
{

EnterCmdStartData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose start data is
				 * being set. */
    Tcl_Size srcOffset,		/* Offset of first char of the command. */
    Tcl_Size codeOffset)		/* Offset of first byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

static void
EnterCmdExtentData(
    CompileEnv *envPtr,		/* Points to the compilation environment
				 * structure in which to enter command
				 * location information. */
    Tcl_Size cmdIndex,		/* Index of the command whose source and code
				 * length data is being set. */
    Tcl_Size numSrcBytes,		/* Number of command source chars. */
    Tcl_Size numCodeBytes)		/* Offset of last byte of command code. */
{
    CmdLocation *cmdLocPtr;

    if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) {
	Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
    }

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

Tcl_Size
TclCreateExceptRange(
    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
    CompileEnv *envPtr)/* Points to CompileEnv for which to create a
				 * new ExceptionRange structure. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    Tcl_Size index = envPtr->exceptArrayNext;

    if (index >= envPtr->exceptArrayEnd) {

	rangePtr--; i--;

	if (CurrentOffset(envPtr) >= (int)rangePtr->codeOffset &&
		(rangePtr->numCodeBytes == TCL_INDEX_NONE || CurrentOffset(envPtr) <
			(int)rangePtr->codeOffset+(int)rangePtr->numCodeBytes) &&
		(returnCode != TCL_CONTINUE ||
			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {

	    if (auxPtrPtr) {
		*auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
	    }
	    return rangePtr;
	}
    }
    return NULL;

 *	If there is not enough room in the CompileEnv's AuxData array, its size
 *	is doubled.
 *----------------------------------------------------------------------
 */

Tcl_Size
TclCreateAuxData(
    void *clientData,	/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
				 * AuxData */
    CompileEnv *envPtr)/* Points to the CompileEnv for which a new
				 * aux data structure is to be allocated. */
{
    Tcl_Size index;		/* Index for the new AuxData structure. */
    AuxData *auxDataPtr;
				/* Points to the new AuxData structure */

    index = envPtr->auxDataArrayNext;

 */

#ifndef _TCLCOMPILATION
#define _TCLCOMPILATION 1

#include "tclInt.h"



struct ByteCode;		/* Forward declaration. */


/*
 *------------------------------------------------------------------------
 * Variables related to compilation. These are used in tclCompile.c,
 * tclExecute.c, tclBasic.c, and their clients.
 *------------------------------------------------------------------------
 */

 * break command is executed, the ExceptionRange structure for the most deeply
 * nested loop, if any, is found and used. These structures are also generated
 * for the "next" subcommands of for loops since a break there terminates the
 * for command. This means a for command actually generates two LoopInfo
 * structures.
 */

typedef enum {
    LOOP_EXCEPTION_RANGE,	/* Exception's range is part of a loop. Break
				 * and continue "exceptions" cause jumps to
				 * appropriate PC offsets. */
    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. */
#if TCL_MAJOR_VERSION < 9
    int mallocedExceptArray;
#endif
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE

    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

				 * 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 switch command that is needed
 * during program execution. These structures are stored in CompileEnv and
 * ByteCode structures as auxiliary data.
 */

typedef struct JumptableInfo {
    Tcl_HashTable hashTable;	/* Hash that maps strings to signed ints (PC
				 * offsets). */
} JumptableInfo;

MODULE_SCOPE const AuxDataType tclJumptableInfoType;



#define JUMPTABLEINFO(envPtr, index) \




    ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))


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

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);
#endif /* TCL_MAJOR_VERSION > 8 */


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *

 * void *TclFetchAuxData(CompileEng *envPtr, int index);
 */


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


enum LiteralFlags {
    LITERAL_ON_HEAP = 0x01,
    LITERAL_CMD_NAME = 0x02,
    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);

 * void TclEmitInt4(int i, CompileEnv *envPtr);
 */


#define TclEmitInt1(i, envPtr) \



    do {								\
	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\

    } while (0)

#define TclEmitInt4(i, envPtr) \
    do {								\
	if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(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)      );		\
    } while (0)


/*
 * Macros to emit an instruction with signed or unsigned integer operands.
 * Four byte integers are stored in "big-endian" order with the high order
 * byte stored at the lowest address. The ANSI C "prototypes" for these macros
 * are:
 *
 * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
 * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
 */


#define TclEmitInstInt1(op, i, envPtr) \

    do {								\


	if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(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:
 *

 * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,


 *				 int threshold);
 */

#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
    TclFixupForwardJump((envPtr), (fixupPtr),				\
	    (envPtr)->codeNext-(envPtr)->codeStart-(int)(fixupPtr)->codeOffset, \
	    (threshold))


/*
 * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
 * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
 * that depend on the number of bytes fetched. The ANSI C "prototypes" for
 * these macros are:
 *
 * int TclGetInt1AtPtr(unsigned char *p);
 * int TclGetInt4AtPtr(unsigned char *p);
 * unsigned int TclGetUInt1AtPtr(unsigned char *p);
 * unsigned int TclGetUInt4AtPtr(unsigned char *p);
 */

/*
 * The TclGetInt1AtPtr macro is tricky because we want to do sign extension on
 * the 1-byte value. Unfortunately the "char" type isn't signed on all
 * platforms so sign-extension doesn't always happen automatically. Sometimes
 * we can explicitly declare the pointer to be signed, but other times we have
 * to explicitly sign-extend the value in software.
 */





#ifndef __CHAR_UNSIGNED__
#   define TclGetInt1AtPtr(p) ((int) *((char *) p))
#elif defined(HAVE_SIGNED_CHAR)
#   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:
 *
 * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);
 */

#define CompileTokens(envPtr, tokenPtr, interp) \
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr));

/*
 * Convenience macros for use when pushing literals. The ANSI C "prototype" for
 * these macros are:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, Tcl_Size length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */


#define PushLiteral(envPtr, string, length) \




    TclEmitPush(TclRegisterLiteral((envPtr), (string), (length), 0), (envPtr))


#define PushStringLiteral(envPtr, string) \
    PushLiteral((envPtr), (string), sizeof(string "") - 1)

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


 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TokenAfter(tokenPtr) \
    ((tokenPtr) + ((tokenPtr)->numComponents + 1))


/*
 * Macro to get the offset to the next instruction to be issued. The ANSI C
 * "prototype" for this macro is:
 *


 * static ptrdiff_t	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)


/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
 * maximal depth of nested CATCH ranges in order to alloc runtime
 * memory. These macros should compute precisely that? OTOH, the nesting depth
 * of LOOP ranges is an interesting datum for debugging purposes, and that is
 * what we compute now.
 *
 * static int	ExceptionRangeStarts(CompileEnv *envPtr, Tcl_Size index);
 * static void	ExceptionRangeEnds(CompileEnv *envPtr, Tcl_Size index);
 * static void	ExceptionRangeTarget(CompileEnv *envPtr, Tcl_Size index, LABEL);
 */


#define ExceptionRangeStarts(envPtr, index) \




    (((envPtr)->exceptDepth++),						\
    ((envPtr)->maxExceptDepth =						\
	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)),	\
    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))





#define ExceptionRangeEnds(envPtr, index) \



    (((envPtr)->exceptDepth--),						\
    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes =			\
	CurrentOffset(envPtr) - (int)(envPtr)->exceptArrayPtr[(index)].codeOffset))





#define ExceptionRangeTarget(envPtr, index, targetType) \
    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))

/*
 * Check if there is an LVT for compiled locals
 */




#define EnvHasLVT(envPtr) \
    (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)


/*
 * Macros for making it easier to deal with tokens and DStrings.
 */


#define TclDStringAppendToken(dsPtr, tokenPtr) \
    Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)






#define TclRegisterDStringLiteral(envPtr, dsPtr) \



    TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
	    Tcl_DStringLength(dsPtr), /*flags*/ 0)


/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);