Tcl Source Code

/*
 * tclAlloc.c --
 *
 *	This is a very fast storage allocator. It allocates blocks of a small
























 *	number of different sizes, and keeps free lists of each size. Blocks
 *	that don't exactly fit are passed up to the next larger size. Blocks































 *	over a certain size are directly allocated from the system.
 *
 * Copyright (c) 1983 Regents of the University of California.


 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */



/*



 * Windows and Unix use an alternative allocator when building with threads





 * that has significantly reduced lock contention.














 */







#include "tclInt.h"







#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)






#if USE_TCLALLOC







#ifdef TCL_DEBUG













#   define DEBUG



















/* #define MSTATS */

#   define RCHECK

#endif




































































/*



 * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait





 * until Tcl uses config.h properly.











 */













#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;











#endif


/*


 * The overhead on a block is at least 8 bytes. When free, this space contains




 * a pointer to the next free block, and the bottom two bits must be zero.

 * When in use, the first byte is set to MAGIC, and the second byte is the


 * size index. The remaining bytes are for alignment. If range checking is


 * 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 */
#ifdef RCHECK




	unsigned short rmagic;		/* range magic number */


	unsigned long size;		/* actual block size */
	unsigned short unused2;		/* padding to 8-byte align */








#endif

    } ovu;



#define overMagic0	ovu.magic0
#define overMagic1	ovu.magic1









#define bucketIndex	ovu.index
#define rangeCheckMagic	ovu.rmagic







#define realBlockSize	ovu.size






};







#define MAGIC		0xef	/* magic # on accounting info */



















#define RMAGIC		0x5555	/* magic # on range info */


















































#ifdef RCHECK
















#define	RSLOP		sizeof(unsigned short)








#else



#define	RSLOP		0













#endif







#define OVERHEAD (sizeof(union overhead) + RSLOP)


































/*




 * Macro to make it easier to refer to the end-of-block guard magic.








 */








#define BLOCK_END(overPtr) \



    (*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize))






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



























#define MINBLOCK	((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))















#define NBUCKETS	(13 - (MINBLOCK >> 4))










#define MAXMALLOC	(1<<(NBUCKETS+2))



static union overhead *nextf[NBUCKETS];



















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


 * to the system.
 */


























struct block {




    struct block *nextPtr;	/* Linked list. */



    struct block *prevPtr;	/* Linked list for big blocks, ensures 8-byte



				 * alignment for suballocated blocks. */







};















static struct block *blockList;	/* Tracks the suballocated blocks. */
static struct block bigBlocks={	/* Big blocks aren't suballocated. */






    &bigBlocks, &bigBlocks
};





































/*
 * The allocator is protected by a special mutex that must be explicitly


 * initialized. Futhermore, because Tcl_Alloc may be used before anything else




 * in Tcl, we make this module self-initializing after all with the allocInit

 * variable.




 */







#ifdef TCL_THREADS


static Tcl_Mutex *allocMutexPtr;








#endif



static int allocInit = 0;



























#ifdef MSTATS





































































/*














 * numMallocs[i] is the difference between the number of mallocs and frees for








 * a given block size.



 */






static	unsigned int numMallocs[NBUCKETS+1];
#endif












#if defined(DEBUG) || defined(RCHECK)















#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)







#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)








#else







#define	ASSERT(p)



#define RANGE_ASSERT(p)




#endif




























/*



 * Prototypes for functions used only in this file.

























 */








static void		MoreCore(int bucket);

















/*
 *-------------------------------------------------------------------------
 *
 * TclInitAlloc --
 *
 *	Initialize the memory system.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Initialize the mutex used to serialize allocations.
 *
 *-------------------------------------------------------------------------
 */

void
TclInitAlloc(void)
{
    if (!allocInit) {
	allocInit = 1;
#ifdef TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * TclFinalizeAllocSubsystem --
 *
 *	Release all resources being used by this subsystem, including
 *	aggressively freeing all memory allocated by TclpAlloc() that has not
 *	yet been released with TclpFree().
 *
 *	After this function is called, all memory allocated with TclpAlloc()
 *	should be considered unusable.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This subsystem is self-initializing, since memory can be allocated
 *	before Tcl is formally initialized. After this call, this subsystem
 *	has been reset to its initial state and is usable again.
 *
 *-------------------------------------------------------------------------
 */

void
TclFinalizeAllocSubsystem(void)
{
    unsigned int i;
    struct block *blockPtr, *nextPtr;

    Tcl_MutexLock(allocMutexPtr);
    for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
	nextPtr = blockPtr->nextPtr;
	TclpSysFree(blockPtr);
    }
    blockList = NULL;

    for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) {
	nextPtr = blockPtr->nextPtr;
	TclpSysFree(blockPtr);
	blockPtr = nextPtr;
    }
    bigBlocks.nextPtr = &bigBlocks;
    bigBlocks.prevPtr = &bigBlocks;

    for (i=0 ; i<NBUCKETS ; i++) {
	nextf[i] = NULL;
#ifdef MSTATS
	numMallocs[i] = 0;
#endif
    }
#ifdef MSTATS
    numMallocs[i] = 0;
#endif
    Tcl_MutexUnlock(allocMutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpAlloc --
 *
 *	Allocate more memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    register union overhead *overPtr;
    register long bucket;
    register unsigned amount;
    struct block *bigBlockPtr = NULL;

    if (!allocInit) {
	/*
	 * We have to make the "self initializing" because Tcl_Alloc may be
	 * used before any other part of Tcl. E.g., see main() for tclsh!
	 */

	TclInitAlloc();
    }
    Tcl_MutexLock(allocMutexPtr);

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
	bigBlockPtr->prevPtr = &bigBlocks;
	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;

	overPtr = (union overhead *) (bigBlockPtr + 1);
	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
	overPtr->bucketIndex = 0xff;
#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifdef RCHECK
	/*
	 * Record allocated size of block and bound space with magic numbers.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	overPtr->rangeCheckMagic = RMAGIC;
	BLOCK_END(overPtr) = RMAGIC;
#endif

	Tcl_MutexUnlock(allocMutexPtr);
	return (void *)(overPtr+1);
    }

    /*
     * Convert amount of memory requested into closest block size stored in
     * hash buckets which satisfies request. Account for space used per block
     * for accounting.
     */

    amount = MINBLOCK;		/* size of first bucket */
    bucket = MINBLOCK >> 4;

    while (numBytes + OVERHEAD > amount) {
	amount <<= 1;
	if (amount == 0) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bucket++;
    }
    ASSERT(bucket < NBUCKETS);

    /*
     * If nothing in hash bucket right now, request more memory from the
     * system.
     */

    if ((overPtr = nextf[bucket]) == NULL) {
	MoreCore(bucket);
	if ((overPtr = nextf[bucket]) == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
    }

    /*
     * Remove from linked list
     */

    nextf[bucket] = overPtr->next;
    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
    overPtr->bucketIndex = (unsigned char) bucket;

#ifdef MSTATS
    numMallocs[bucket]++;
#endif

#ifdef RCHECK
    /*
     * Record allocated size of block and bound space with magic numbers.
     */

    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    overPtr->rangeCheckMagic = RMAGIC;
    BLOCK_END(overPtr) = RMAGIC;
#endif

    Tcl_MutexUnlock(allocMutexPtr);
    return ((char *)(overPtr + 1));
}

/*
 *----------------------------------------------------------------------
 *
 * MoreCore --
 *
 *	Allocate more memory to the indicated bucket.
 *
 *	Assumes Mutex is already held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Attempts to get more memory from the system.
 *
 *----------------------------------------------------------------------
 */

static void
MoreCore(
    int bucket)			/* What bucket to allocat to. */
{
    register union overhead *overPtr;
    register long size;		/* size of desired block */
    long amount;		/* amount to allocate */
    int 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.
     */

    size = 1 << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc((unsigned)
	    (sizeof(struct block) + amount), 1);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;

    overPtr = (union overhead *) (blockPtr + 1);

    /*
     * Add new memory allocated to that on free list for this hash bucket.
     */

    nextf[bucket] = overPtr;
    while (--numBlocks > 0) {
	overPtr->next = (union overhead *)((caddr_t)overPtr + size);
	overPtr = (union overhead *)((caddr_t)overPtr + size);
    }
    overPtr->next = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    char *oldPtr)		/* Pointer to memory to free. */
{
    register long size;
    register union overhead *overPtr;
    struct block *bigBlockPtr;

    if (oldPtr == NULL) {
	return;
    }

    Tcl_MutexLock(allocMutexPtr);
    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));

    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
    ASSERT(overPtr->overMagic1 == MAGIC);
    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
	Tcl_MutexUnlock(allocMutexPtr);
	return;
    }

    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
    size = overPtr->bucketIndex;
    if (size == 0xff) {
#ifdef MSTATS
	numMallocs[NBUCKETS]--;
#endif

	bigBlockPtr = (struct block *) overPtr - 1;
	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
	TclpSysFree(bigBlockPtr);

	Tcl_MutexUnlock(allocMutexPtr);
	return;
    }
    ASSERT(size < NBUCKETS);
    overPtr->next = nextf[size];	/* also clobbers overMagic */
    nextf[size] = overPtr;

#ifdef MSTATS
    numMallocs[size]--;
#endif

    Tcl_MutexUnlock(allocMutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpRealloc --
 *
 *	Reallocate memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    unsigned long maxSize;

    if (oldPtr == NULL) {
	return TclpAlloc(numBytes);
    }

    Tcl_MutexLock(allocMutexPtr);

    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));

    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
    ASSERT(overPtr->overMagic1 == MAGIC);
    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
	Tcl_MutexUnlock(allocMutexPtr);
	return NULL;
    }

    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
    i = overPtr->bucketIndex;

    /*
     * If the block isn't in a bin, just realloc it.
     */

    if (i == 0xff) {
	struct block *prevPtr, *nextPtr;
	bigBlockPtr = (struct block *) overPtr - 1;
	prevPtr = bigBlockPtr->prevPtr;
	nextPtr = bigBlockPtr->nextPtr;
	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
		sizeof(struct block) + OVERHEAD + numBytes);
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}

	if (prevPtr->nextPtr != bigBlockPtr) {
	    /*
	     * If the block has moved, splice the new block into the list
	     * where the old block used to be.
	     */

	    prevPtr->nextPtr = bigBlockPtr;
	    nextPtr->prevPtr = bigBlockPtr;
	}

	overPtr = (union overhead *) (bigBlockPtr + 1);

#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifdef RCHECK
	/*
	 * Record allocated size of block and update magic number bounds.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	BLOCK_END(overPtr) = RMAGIC;
#endif

	Tcl_MutexUnlock(allocMutexPtr);
	return (char *)(overPtr+1);
    }
    maxSize = 1 << (i+3);
    expensive = 0;
    if (numBytes+OVERHEAD > maxSize) {
	expensive = 1;
    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
	expensive = 1;
    }

    if (expensive) {
	void *newPtr;

	Tcl_MutexUnlock(allocMutexPtr);

	newPtr = TclpAlloc(numBytes);
	if (newPtr == NULL) {
	    return NULL;
	}
	maxSize -= OVERHEAD;
	if (maxSize < numBytes) {
	    numBytes = maxSize;
	}
	memcpy(newPtr, oldPtr, (size_t) numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is


     */

#ifdef RCHECK
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif

    Tcl_MutexUnlock(allocMutexPtr);
    return(oldPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * mstats --
 *
 *	Prints two lines of numbers, one showing the length of the free list
 *	for each size category, the second showing the number of mallocs -
 *	frees for each size category.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef MSTATS
void
mstats(
    char *s)			/* Where to write info. */
{
    register int i, j;
    register union overhead *overPtr;
    int totalFree = 0, totalUsed = 0;

    Tcl_MutexLock(allocMutexPtr);

    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
    for (i = 0; i < NBUCKETS; i++) {
	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
	    fprintf(stderr, " %d", j);
	}
	totalFree += j * (1 << (i + 3));
    }

    fprintf(stderr, "\nused:\t");
    for (i = 0; i < NBUCKETS; i++) {
	fprintf(stderr, " %d", numMallocs[i]);
	totalUsed += numMallocs[i] * (1 << (i + 3));
    }

    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
	    totalUsed, totalFree);
    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
	    MAXMALLOC, numMallocs[NBUCKETS]);

    Tcl_MutexUnlock(allocMutexPtr);
}
#endif

#else	/* !USE_TCLALLOC */

/*
 *----------------------------------------------------------------------
 *
 * TclpAlloc --
 *
 *	Allocate more memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpAlloc(
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    return (char *) malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    char *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpRealloc --
 *
 *	Reallocate memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

static AssemblyEnv*
NewAssemblyEnv(
    CompileEnv* envPtr,		/* Compilation environment being used for code
				 * generation*/
    int flags)			/* Compilation flags (TCL_EVAL_DIRECT) */
{
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
				/* Assembler environment under construction */
    Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Parse of one line of assembly code */

    assemEnvPtr->envPtr = envPtr;
    assemEnvPtr->parsePtr = parsePtr;
    assemEnvPtr->cmdLine = envPtr->line;
    assemEnvPtr->clNext = envPtr->clNext;

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

static void
FreeAssemblyEnv(
    AssemblyEnv* assemEnvPtr)	/* Environment to free */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment being used for code
				 * generation */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* thisBB;		/* Pointer to a basic block being deleted */
    BasicBlock* nextBB;		/* Pointer to a deleted basic block's
				 * successor */

    /*
     * Free all the basic block structures.
     */

	Tcl_DeleteHashEntry(hashEntry);
    }

    /*
     * Dispose what's left.
     */

    TclStackFree(interp, assemEnvPtr->parsePtr);
    TclStackFree(interp, assemEnvPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * AssembleOneLine --
 *

    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    /*
     * Create the core commands. Do it here, rather than calling
     * Tcl_CreateCommand, because it's faster (there's no need to check for a

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

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

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

    result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv);

    TclStackFree(interp, (void *) argv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeObjectCommand --

    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    register const char **argv)	/* Argument strings. */
{
    Command *cmdPtr = clientData;
    Tcl_Obj *objPtr;
    int i, length, result;
    Tcl_Obj **objv =
	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));

    for (i = 0; i < argc; i++) {
	length = strlen(argv[i]);
	TclNewStringObj(objPtr, argv[i], length);
	Tcl_IncrRefCount(objPtr);
	objv[i] = objPtr;
    }

     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0; i < argc; i++) {
	objPtr = objv[i];
	Tcl_DecrRefCount(objPtr);
    }
    TclStackFree(interp, objv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclRenameCommand --

     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);

    /*
     * Copy command prefix from unknown handler and add on the real command's
     * full argument list. Note that we only use memcpy() once because we have
     * to increment the reference count of all the handler arguments anyway.
     */

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

	for (i = 0; i < handlerObjc; ++i) {
	    Tcl_DecrRefCount(newObjv[i]);
	}
	TclStackFree(interp, newObjv);
	return TCL_ERROR;
    }

    if (lookupNsPtr) {
	savedNsPtr = varFramePtr->nsPtr;
	varFramePtr->nsPtr = lookupNsPtr;
    }

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

    for (i = 0; i < objc; ++i) {
	Tcl_DecrRefCount(objv[i]);
    }
    TclStackFree(interp, objv);

    return result;
}

static int
TEOV_RunEnterTraces(
    Tcl_Interp *interp,

    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    unsigned int 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 = TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray =
	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
    int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
				/* TIP #280 Structures for tracking of command
				 * locations. */
    int *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

     * TIP #280. Release the local CmdFrame, and its contents.
     */

    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
    }
    TclStackFree(interp, linesStack);
    TclStackFree(interp, expandStack);
    TclStackFree(interp, stackObjArray);
    TclStackFree(interp, eeFramePtr);
    TclStackFree(interp, parsePtr);

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

	     * and TclInitCompileEnv), are special-cased to use the proper
	     * line number directly instead of accessing the 'line' array.
	     *
	     * Note that we use (word==INTMIN) to signal that no command frame
	     * should be pushed, as needed by alias and ensemble redirections.
	     */

	    eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    eoFramePtr->nline = 0;
	    eoFramePtr->line = NULL;

	    eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
		    1 : iPtr->cmdFramePtr->level + 1);
	    eoFramePtr->numLevels = iPtr->numLevels;

	     *
	     * First see if the word exists and is a literal. If not we go
	     * through the easy dynamic branch. No need to perform more
	     * complex invokations.
	     */

	    int pc = 0;
	    CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));

	    *ctxPtr = *invoker;
	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctxPtr->data.eval.path is not used.
		 * ctxPtr->data.tebc.codePtr is used instead.
		 */

	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
		/*
		 * Death of SrcInfo reference.
		 */

		Tcl_DecrRefCount(ctxPtr->data.eval.path);
	    }
	    TclStackFree(interp, ctxPtr);
	}

	/*
	 * Now release the lock on the continuation line information, if any,
	 * and restore the caller's settings.
	 */

    /*
     * Remove the cmdFrame
     */

    if (eoFramePtr) {
	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
	TclStackFree(interp, eoFramePtr);
    }
    TclDecrRefCount(listPtr);

    return result;
}

/*

	TclpFree((char *) curTagPtr);
	curTagPtr = NULL;
    }
    allocHead = NULL;

    Tcl_MutexUnlock(ckallocMutexPtr);
#endif

#if USE_TCLALLOC
    TclFinalizeAllocSubsystem();
#endif
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

    ForIterData *iterPtr;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
	return TCL_ERROR;
    }

    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
    iterPtr->cond = objv[2];
    iterPtr->body = objv[4];
    iterPtr->next = objv[3];
    iterPtr->msg  = "\n    (\"for\" body line %d)";
    iterPtr->word = 4;

    TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);

{
    ForIterData *iterPtr = data[0];

    if (result != TCL_OK) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
	}
	TclSmallFreeEx(interp, iterPtr);
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return TCL_OK;
}

int

	result = TCL_OK;
	Tcl_ResetResult(interp);
	break;
    case TCL_ERROR:
	Tcl_AppendObjToErrorInfo(interp,
		Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
    }
    TclSmallFreeEx(interp, iterPtr);
    return result;
}

static int
ForCondCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = data[0];
    Tcl_Obj *boolObj = data[1];
    int value;

    if (result != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFreeEx(interp, iterPtr);
	return result;
    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFreeEx(interp, iterPtr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(boolObj);

    if (value) {
	/* TIP #280. */
	if (iterPtr->next) {
	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
		    NULL);
	} else {
	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
		    NULL, NULL);
	}
	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
		iterPtr->word);
    }
    TclSmallFreeEx(interp, iterPtr);
    return result;
}

static int
ForNextCallback(
    ClientData data[],
    Tcl_Interp *interp,

    int result)
{
    ForIterData *iterPtr = data[0];

    if ((result != TCL_BREAK) && (result != TCL_OK)) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
	    TclSmallFreeEx(interp, iterPtr);
	}
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return result;
}


     *		statePtr->argvList[i].
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;

	if (statePtr->vCopyList[i]) {
	    TclDecrRefCount(statePtr->vCopyList[i]);
	}
	if (statePtr->aCopyList[i]) {
	    TclDecrRefCount(statePtr->aCopyList[i]);
	}
    }
    TclStackFree(interp, statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FormatObjCmd --
 *

	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */

	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));

	*fPtr = *framePtr;

	/*
	 * Note:
	 * Type BC => f.data.eval.path	  is not used.
	 *	      f.data.tebc.codePtr is used instead.

	     */

	    Tcl_DecrRefCount(fPtr->data.eval.path);
	}

	ADD_PAIR("cmd",
		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
	TclStackFree(interp, fPtr);
	break;
    }

    case TCL_LOCATION_SOURCE:
	/*
	 * Evaluation of a script file.
	 */

	    }
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    int j;

	    if (sortInfo.indexc > 1) {
		TclStackFree(interp, sortInfo.indexv);
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_AppendResult(interp,
			"\"-index\" option must be followed by list index",

		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv =
			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
	    }

	    /*
	     * Fill the array by parsing each index. We don't know whether
	     * their scale is sensible yet, but we at least perform the
	     * syntactic check here.
	     */

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

	if (offset > listc-1) {
	    if (sortInfo.indexc > 1) {
		TclStackFree(interp, sortInfo.indexv);
	    }
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    }
	    return TCL_OK;

    /*
     * Cleanup the index list array.
     */

  done:
    if (sortInfo.indexc > 1) {
	TclStackFree(interp, sortInfo.indexv);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

            sortInfo.indexv = NULL;
            break;
        case 1:
            sortInfo.indexv = &sortInfo.singleIndex;
            break;
        default:
            sortInfo.indexv =
		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
            allocatedIndexVector = 1;	/* Cannot use indexc field, as it
                                         * might be decreased by 1 later. */
        }
        for (j=0 ; j<sortInfo.indexc ; j++) {
            TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
		    &sortInfo.indexv[j]);
        }

		sortInfo.indexv = NULL;
	    } else {
		sortInfo.indexc--;

		/*
		 * Do not shrink the actual memory block used; that doesn't
		 * work with TclStackAlloc-allocated memory. [Bug 2918962]

		 */

		for (i = 0; i < sortInfo.indexc; i++) {
		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
		}
	    }
	}

    }

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

    elementArray = TclStackAlloc(interp, length * sizeof(SortElement));

    for (i=0; i < length; i++){
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */

	    }
	}
	listRepPtr->elemCount = i;
	Tcl_SetObjResult(interp, resultPtr);
    }

  done1:
    TclStackFree(interp, elementArray);

  done:
    if (sortInfo.sortMode == SORTMODE_COMMAND) {
	TclDecrRefCount(sortInfo.compareCmdPtr);
	TclDecrRefCount(listObj);
	sortInfo.compareCmdPtr = NULL;
    }
  done2:
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    }
    return sortInfo.resultCode;
}

/*
 *----------------------------------------------------------------------
 *

	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }

		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }
	}
	if (nocase) {
	    TclStackFree(interp, u2lc);
	}
	TclStackFree(interp, mapLens);
	TclStackFree(interp, mapStrings);
    }
    if (p != ustring1) {
	/*
	 * Put the rest of the unmapped chars onto result.
	 */

	Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
    }
    Tcl_SetObjResult(interp, resultPtr);
  done:
    if (mapWithDict) {
	TclStackFree(interp, mapElemv);
    }
    if (copySource) {
	Tcl_DecrRefCount(sourceObj);
    }
    return TCL_OK;
}


    /*
     * We've got a match. Find a body to execute, skipping bodies that are
     * "-".
     */

  matchFound:
    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
    *ctxPtr = *iPtr->cmdFramePtr;

    if (splitObjs) {
	/*
	 * We have to perform the GetSrc and other type dependent handling of
	 * the frame here because we are munging with the line numbers,
	 * something the other commands like if, etc. are not doing. Them are

	int overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(overflow ? limit : patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ThrowObjCmd --

	return TCL_ERROR;
    }

    /*
     * We reuse [for]'s callback, passing a NULL for the 'next' script.
     */

    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
    iterPtr->cond = objv[1];
    iterPtr->body = objv[2];
    iterPtr->next = NULL;
    iterPtr->msg  = "\n    (\"while\" body line %d)";
    iterPtr->word = 2;

    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,

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

    duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = TclStackAlloc(interp,
	    sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.
	 */

	    goto failedUpdateInfoAssembly;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
    failedUpdateInfoAssembly:
	ckfree(duiPtr);
	TclStackFree(interp, keyTokenPtrs);
	return TCL_ERROR;
    }
    bodyTokenPtr = tokenPtr;

    /*
     * The list of variables to bind is stored in auxiliary data so that it
     * can't be snagged by literal sharing and forced to shimmer dangerously.

    TclEmitInt4(     infoIndex,					envPtr);
    TclEmitOpcode(   INST_RETURN_STK,				envPtr);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;
}

int
TclCompileDictAppendCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command

    bodyIndex = i-1;

    /*
     * Allocate storage for the varcList and varvList arrays if necessary.
     */

    numLists = (numWords - 2)/2;
    varcList = TclStackAlloc(interp, numLists * sizeof(int));
    memset(varcList, 0, numLists * sizeof(int));
    varvList = (const char ***) TclStackAlloc(interp,
	    numLists * sizeof(const char **));
    memset((char*) varvList, 0, numLists * sizeof(const char **));

    /*
     * Break up each var list and set the varcList and varvList arrays. Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
     */

  done:
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	if (varvList[loopIndex] != NULL) {
	    ckfree(varvList[loopIndex]);
	}
    }
    TclStackFree(interp, (void *)varvList);
    TclStackFree(interp, varcList);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DupForeachInfo --

	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     */

    }
    status = TclMergeReturnOptions(interp, objc, objv,
	    &returnOpts, &code, &level);
  cleanup:
    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (TCL_ERROR == status) {
	/*
	 * Something was bogus in the return options. Clear the error message,
	 * and report back to the compiler that this must be interpreted at
	 * runtime.
	 */

	    if ((elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

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

	    if (remainingChars) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

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

	CompileTokens(envPtr, varTokenPtr, interp);
    }

    if (removedParen) {
	varTokenPtr[removedParen].size++;
    }
    if (allocedTokens) {
	TclStackFree(interp, elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}


    int code = TCL_ERROR;
    DefineLineInformation;	/* TIP #280 */

    if (numArgs == 0) {
	return TCL_ERROR;
    }

    objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));

    for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    goto cleanup;

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

    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    contFixCount = 0;
    fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens);
    memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<numBodyTokens ; i+=2) {
	nextArmFixupIndex = -1;
	envPtr->currStackDepth = savedStackDepth + 1;
	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||

	    for (j=i-1 ; j>=0 ; j--) {
		if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
		    fixupTargetArray[j] += 3;
		}
	    }
	}
    }
    TclStackFree(interp, fixupTargetArray);
    TclStackFree(interp, fixupArray);

    envPtr->currStackDepth = savedStackDepth + 1;
}

/*
 *----------------------------------------------------------------------
 *

     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = ckalloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty). Note that

		envPtr->codeStart+finalFixups[i]+1);
    }

    /*
     * Clean up all our temporary space and return.
     */

    TclStackFree(interp, finalFixups);
}

/*
 *----------------------------------------------------------------------
 *
 * DupJumptableInfo, FreeJumptableInfo --
 *

    /*
     * Extract information about what handlers there are.
     */

    numHandlers = numWords >> 2;
    numWords -= numHandlers * 4;
    if (numHandlers > 0) {
	handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
	matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    int objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;

  failedToCompile:
    if (numHandlers > 0) {
	for (i=0 ; i<numHandlers ; i++) {
	    if (matchClauses[i]) {
		TclDecrRefCount(matchClauses[i]);
	    }
	}
	TclStackFree(interp, optionVarIndices);
	TclStackFree(interp, resultVarIndices);
	TclStackFree(interp, matchCodes);
	TclStackFree(interp, matchClauses);
	TclStackFree(interp, handlerTokens);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     * For us to be here, there must be at least one handler.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PUSH(				buf);
	OP(				EQ);
	JUMP(notCodeJumpSource,		JUMP_FALSE4);

     * Fix all the jumps from taken clauses to here (which is the end of the
     * [try]).
     */

    for (i=0 ; i<numHandlers ; i++) {
	FIXJUMP(addrsToFix[i]);
    }
    TclStackFree(interp, forwardsToFix);
    TclStackFree(interp, addrsToFix);
    return TCL_OK;
}

static int
IssueTryFinallyInstructions(
    Tcl_Interp *interp,
    CompileEnv *envPtr,

     */

    if (numHandlers) {
	/*
	 * Slight overallocation, but reduces size of this function.
	 */

	addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
	forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    sprintf(buf, "%d", matchCodes[i]);
	    OP(				DUP);
	    PUSH(			buf);
	    OP(				EQ);
	    JUMP(notCodeJumpSource,	JUMP_FALSE4);

	 * Fix all the jumps from taken clauses to here (the start of the
	 * finally clause).
	 */

	for (i=0 ; i<numHandlers-1 ; i++) {
	    FIXJUMP(addrsToFix[i]);
	}
	TclStackFree(interp, forwardsToFix);
	TclStackFree(interp, addrsToFix);
    }

    /*
     * Drop the result code.
     */

    OP(					POP);

	    if ((elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

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

	    if (remainingChars) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

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

	CompileTokens(envPtr, varTokenPtr, interp);
    }

    if (removedParen) {
	varTokenPtr[removedParen].size++;
    }
    if (allocedTokens) {
	TclStackFree(interp, elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}


		    goto error;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT: {
		Tcl_Parse *nestedPtr =
			TclStackAlloc(interp, sizeof(Tcl_Parse));

		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->start = start;
		tokenPtr->numComponents = 0;

		end = start + numBytes;

			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
			parsePtr->incomplete = 1;
			code = TCL_ERROR;
			errCode = "UNBALANCED";
			break;
		    }
		}
		TclStackFree(interp, nestedPtr);
		end = start;
		start = tokenPtr->start;
		scanned = end - start;
		tokenPtr->size = scanned;
		parsePtr->numTokens++;
		break;
	    }			/* SCRIPT case */

				 * 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 = Tcl_NewObj();	/* List to hold the literals. */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,

		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    ckfree(opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *

    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */

    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {
	/*

	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
		parsePtr->tokenPtr, envPtr, optimize);
    } else {
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    ckfree(opTree);
}

/*
 *----------------------------------------------------------------------

    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
    Tcl_DecrRefCount(byteCodeObj);
    return code;
}


	JumpList *freePtr, *newJump;

	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    switch (nodePtr->lexeme) {
	    case QUESTION:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		break;
	    }
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

		}
		TclFixupForwardJump(envPtr, &(jumpPtr->jump),
			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
		convert |= jumpPtr->convert;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
			&(jumpPtr->next->jump));

			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
			127);
		convert = 0;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;
		break;
	    }
	    if (nodePtr == rootPtr) {

{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = clientData;
	Tcl_Obj **litObjv = TclStackAlloc(interp,
		2 * (objc-2) * sizeof(Tcl_Obj *));
	OpNode *nodes = 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];

	nodes[2*(objc-2)-1].right = OT_LITERAL;

	nodes[0].right = lastAnd;
	nodes[lastAnd].p.parent = 0;

	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	TclStackFree(interp, nodes);
	TclStackFree(interp, litObjv);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *

	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	Tcl_Obj *const *litObjv = objv + 1;
	OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
	int i, lastOp = OT_LITERAL;

	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	if (lexeme == EXPON) {
	    for (i=objc-2; i>0; i--) {
		nodes[i].lexeme = lexeme;

	    }
	}
	nodes[0].right = lastOp;
	nodes[lastOp].p.parent = 0;

	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);

	TclStackFree(interp, nodes);
	return code;
    }
}

/*
 *----------------------------------------------------------------------
 *

	/*
	 * Initialize the compiler using the context, making counting absolute
	 * to that context. Note that the context can be byte code execution.
	 * In that case we have to fill out the missing pieces (line, path,
	 * ...) which may make change the type as well.
	 */

	CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	int pc = 0;

	*ctxPtr = *invoker;
	if (invoker->type == TCL_LOCATION_BC) {
	    /*
	     * Note: Type BC => ctx.data.eval.path    is not used.
	     *			ctx.data.tebc.codePtr is used instead.

		     */

		    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
		}
	    }
	}

	TclStackFree(interp, ctxPtr);
    }

    envPtr->extCmdMapPtr->start = envPtr->line;

    /*
     * Initialize the data about invisible continuation lines as empty, i.e.
     * not used. The caller (TclSetByteCodeFromAny) will set this up, if such

    Command *cmdPtr;
    Tcl_Token *tokenPtr;
    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
    Tcl_DString ds;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine, *clNext;
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));

    Tcl_DStringInit(&ds);

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

     */

    if (envPtr->codeNext == entryCodeNext) {
	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    }

    envPtr->numSrcBytes = p - script;
    TclStackFree(interp, parsePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --

	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetResult(interp, "must have exactly two variable names",
		TCL_STATIC);
	return TCL_ERROR;
    }
    searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
	    &done) != TCL_OK) {
	TclStackFree(interp, searchPtr);
	return TCL_ERROR;
    }
    if (done) {
	TclStackFree(interp, searchPtr);
	return TCL_OK;
    }
    TclListObjGetElements(NULL, objv[1], &varc, &varv);
    keyVarObj = varv[0];
    valueVarObj = varv[1];
    scriptObj = objv[3];

     */

  error:
    TclDecrRefCount(keyVarObj);
    TclDecrRefCount(valueVarObj);
    TclDecrRefCount(scriptObj);
    Tcl_DictObjDone(searchPtr);
    TclStackFree(interp, searchPtr);
    return TCL_ERROR;
}

static int
DictForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,

     */

  done:
    TclDecrRefCount(keyVarObj);
    TclDecrRefCount(valueVarObj);
    TclDecrRefCount(scriptObj);
    Tcl_DictObjDone(searchPtr);
    TclStackFree(interp, searchPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DictSetCmd --

	     * Initialize locks used by the memory allocators before anything
	     * interesting happens so we can use the allocators in the
	     * implementation of self-initializing locks.
	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for
					 * converting to/from double. */

    TclFinalizeSynchronization();

    /*
     * Close down the thread-specific object allocator.
     */

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAlloc();
#endif

    /*
     * We defer unloading of packages until very late to avoid memory access
     * issues. Both exit callbacks and synchronization variables may be stored
     * in packages.
     *
     * Note that TclFinalizeLoad unloads packages in the reverse of the order

 * Helpers for NR - non-recursive calls to TEBC
 * Minimal data required to fully reconstruct the execution state.
 */

typedef struct TEBCdata {
    ByteCode *codePtr;		/* Constant until the BC returns */
				/* -----------------------------------------*/

    const unsigned char *pc;	/* These fields are used on return TO this */
    ptrdiff_t *catchTop;	/* this level: they record the state when a */
    int cleanup;		/* new codePtr was received for NR */
    Tcl_Obj *auxObjList;	/* execution. */
    int checkInterp;
    CmdFrame cmdFrame;

    void * stack[1];            /* Start of the actual combined catch and obj
				 * stacks; the struct will be expanded as
				 * necessary */
} TEBCdata;

#define TEBC_YIELD()					\
    esPtr->tosPtr = tosPtr;				\
    TD->pc = pc;					\
    TD->cleanup = cleanup;				\
    TclNRAddCallback(interp, TEBCresume, TD,	\
	    INT2PTR(1), NULL, NULL)
    
#define TEBC_DATA_DIG()				\
    pc = TD->pc;				\
    cleanup = TD->cleanup;			\
    tosPtr = esPtr->tosPtr
    

#define PUSH_TAUX_OBJ(objPtr) \
    do {							\
	objPtr->internalRep.twoPtrValue.ptr2 = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

	    }							\
	    goto cleanupV_pushObjResultPtr;			\
	} else {						\
	    goto cleanupV;					\
	}							\
    } while (0)

/*
 * Macros used to cache often-referenced Tcl evaluation stack information
 * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
 * pair must surround any call inside TclNRExecuteByteCode (and a few other
 * procedures that use this scheme) that could result in a recursive call
 * to TclNRExecuteByteCode.
 */

#define CACHE_STACK_INFO() \
    checkInterp = 1

#define DECACHE_STACK_INFO() \
    esPtr->tosPtr = tosPtr

/*
 * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
 * increments the object's ref count since it makes the stack have another
 * reference pointing to the object. However, POP_OBJECT does not decrement
 * the ref count. This is because the stack may hold the only reference to the
 * object, so the object would be destroyed if its ref count were decremented
 * before the caller had a chance to, e.g., store it in a variable. It is the

static void		PrintByteCodeInfo(ByteCode *codePtr);
static const char *	StringForResultCode(int result);
static void		ValidatePcAndStackTop(ByteCode *codePtr,
			    const unsigned char *pc, int stackTop,
			    int stackLowerBound, int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		DeleteExecStack(ExecStack *esPtr);
static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
			    int opcode, Tcl_Obj **constants,
			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
			    Tcl_Obj *valuePtr);
static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
static const char *	GetSrcInfoForPc(const unsigned char *pc,
			    ByteCode *codePtr, int *lengthPtr,
			    const unsigned char **pcBeg);
static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
			    int move);
static void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);
static inline int	OFFSET(void *ptr);
static void		ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
static Tcl_NRPostProc	CopyCallback;
static Tcl_NRPostProc	ExprObjCallback;

static Tcl_NRPostProc   TEBCresume;

/*
 * The structure below defines a bytecode Tcl object type to hold the

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

    eePtr->execStackPtr = esPtr;
    TclNewBooleanObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewBooleanObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);
    eePtr->interp = interp;
    eePtr->callbackPtr = NULL;
    eePtr->corPtr = NULL;
    eePtr->rewind = 0;

    esPtr->prevPtr = NULL;
    esPtr->nextPtr = NULL;
    esPtr->markerPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[size-1];
    esPtr->tosPtr = &esPtr->stackWords[-1];

    Tcl_MutexLock(&execMutex);
    if (!execInitialized) {
	TclInitAuxDataTypeTable();
	InitByteCodeExecution(interp);
	execInitialized = 1;
    }
    Tcl_MutexUnlock(&execMutex);

 * Side effects:
 *	Storage for an ExecEnv and its contained storage (e.g. the evaluation
 *	stack) is freed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteExecStack(
    ExecStack *esPtr)
{
    if (esPtr->markerPtr) {
	Tcl_Panic("freeing an execStack which is still in use");
    }

    if (esPtr->prevPtr) {
	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
    }
    if (esPtr->nextPtr) {
	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
    }
    ckfree(esPtr);
}

void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{
    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;

    /*
     * Delete all stacks in this exec env.
     */

    while (esPtr->nextPtr) {
	esPtr = esPtr->nextPtr;
    }
    while (esPtr) {
	tmpPtr = esPtr;
	esPtr = tmpPtr->prevPtr;
	DeleteExecStack(tmpPtr);
    }

    TclDecrRefCount(eePtr->constants[0]);
    TclDecrRefCount(eePtr->constants[1]);
    if (eePtr->callbackPtr) {
	Tcl_Panic("Deleting execEnv with pending NRE callbacks!");
    }
    if (eePtr->corPtr) {
	Tcl_Panic("Deleting execEnv with existing coroutine");

TclFinalizeExecution(void)
{
    Tcl_MutexLock(&execMutex);
    execInitialized = 0;
    Tcl_MutexUnlock(&execMutex);
    TclFinalizeAuxDataTypeTable();
}

/*
 * Auxiliary code to insure that GrowEvaluationStack always returns correctly
 * aligned memory.
 *
 * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
 * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
 * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
 */

#define WALLOCALIGN \
    (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))

/*
 * OFFSET computes how many words have to be skipped until the next aligned
 * word. Note that we are only interested in the low order bits of ptr, so
 * that any possible information loss in PTR2INT is of no consequence.
 */

static inline int
OFFSET(
    void *ptr)
{
    int mask = TCL_ALLOCALIGN-1;
    int base = PTR2INT(ptr) & mask;
    return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
}

/*
 * Given a marker, compute where the following aligned memory starts.
 */

#define MEMSTART(markerPtr) \
    ((markerPtr) + OFFSET(markerPtr))

/*
 *----------------------------------------------------------------------
 *
 * GrowEvaluationStack --
 *
 *	This procedure grows a Tcl evaluation stack stored in an ExecEnv,
 *	copying over the words since the last mark if so requested. A mark is
 *	set at the beginning of the new area when no copying is requested.
 *
 * Results:
 *	Returns a pointer to the first usable word in the (possibly) grown
 *	stack.
 *
 * Side effects:
 *	The size of the evaluation stack may be grown, a marker is set
 *
 *----------------------------------------------------------------------
 */

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

    if (move) {
	if (!markerPtr) {
	    Tcl_Panic("STACK: Reallocating with no previous alloc");
	}
	if (needed <= 0) {
	    return MEMSTART(markerPtr);
	}
    } else {
	Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
	int offset = OFFSET(tmpMarkerPtr);

	if (needed + offset < 0) {
	    /*
	     * Put a marker pointing to the previous marker in this stack, and
	     * store it in esPtr as the current marker. Return a pointer to
	     * the start of aligned memory.
	     */

	    esPtr->markerPtr = tmpMarkerPtr;
	    memStart = tmpMarkerPtr + offset;
	    esPtr->tosPtr = memStart - 1;
	    *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
	    return memStart;
	}
    }

    /*
     * Reset move to hold the number of words to be moved to new stack (if
     * any) and growth to hold the complete stack requirements: add one for
     * the marker, (WALLOCALIGN-1) for the maximal possible offset.
     */

    if (move) {
	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
    }
    needed = growth + moveWords + WALLOCALIGN;

    /*
     * Check if there is enough room in the next stack (if there is one, it
     * should be both empty and the last one!)
     */

    if (esPtr->nextPtr) {
	oldPtr = esPtr;
	esPtr = oldPtr->nextPtr;
	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
	if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
	    Tcl_Panic("STACK: Stack after current is in use");
	}
	if (esPtr->nextPtr) {
	    Tcl_Panic("STACK: Stack after current is not last");
	}
	if (needed <= currElems) {
	    goto newStackReady;
	}
	DeleteExecStack(esPtr);
	esPtr = oldPtr;
    } else {
	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
    }

    /*
     * We need to allocate a new stack! It needs to store 'growth' words,
     * including the elements to be copied over and the new marker.
     */

    newElems = 2*currElems;
    while (needed > newElems) {
	newElems *= 2;
    }
    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = ckalloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:
    eePtr->execStackPtr = esPtr;

    /*
     * Store a NULL marker at the beginning of the stack, to indicate that
     * this is the first marker in this stack and that rewinding to here
     * should actually be a return to the previous stack.
     */

    esPtr->stackWords[0] = NULL;
    esPtr->markerPtr = &esPtr->stackWords[0];
    memStart = MEMSTART(esPtr->markerPtr);
    esPtr->tosPtr = memStart - 1;

    if (move) {
	memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
	esPtr->tosPtr += moveWords;
	oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
	oldPtr->tosPtr = markerPtr-1;
    }

    /*
     * Free the old stack if it is now unused.
     */

    if (!oldPtr->markerPtr) {
	DeleteExecStack(oldPtr);
    }

    return memStart;
}

/*
 *--------------------------------------------------------------
 *
 * TclStackAlloc, TclStackRealloc, TclStackFree --
 *
 *	Allocate memory from the execution stack; it has to be returned later
 *	with a call to TclStackFree.
 *
 * Results:
 *	A pointer to the first byte allocated, or panics if the allocation did
 *	not succeed.
 *
 * Side effects:
 *	The execution stack may be grown.
 *
 *--------------------------------------------------------------
 */

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

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

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

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

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

void
TclStackFree(
    Tcl_Interp *interp,
    void *freePtr)
{
    Interp *iPtr = (Interp *) interp;
    ExecEnv *eePtr;
    ExecStack *esPtr;
    Tcl_Obj **markerPtr, *marker;

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

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

    eePtr = iPtr->execEnvPtr;
    esPtr = eePtr->execStackPtr;
    markerPtr = esPtr->markerPtr;
    marker = *markerPtr;

    if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
	Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
		freePtr, MEMSTART(markerPtr));
    }

    esPtr->tosPtr = markerPtr - 1;
    esPtr->markerPtr = (Tcl_Obj **) marker;
    if (marker) {
	return;
    }

    /*
     * Return to previous active stack. Note that repeated expansions or
     * reallocs could have generated several unused intervening stacks: free
     * them too.
     */

    while (esPtr->nextPtr) {
	esPtr = esPtr->nextPtr;
    }
    esPtr->tosPtr = &esPtr->stackWords[-1];
    while (esPtr->prevPtr) {
	ExecStack *tmpPtr = esPtr->prevPtr;
	if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
	    DeleteExecStack(tmpPtr);
	} else {
	    break;
	}
    }
    if (esPtr->prevPtr) {
	eePtr->execStackPtr = esPtr->prevPtr;
    } else {
	eePtr->execStackPtr = esPtr;
    }	
}

void *
TclStackAlloc(
    Tcl_Interp *interp,
    int numBytes)
{
    Interp *iPtr = (Interp *) interp;
    int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);

    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
	return (void *) Tcl_Alloc(numBytes);
    }

    return (void *) StackAllocWords(interp, numWords);
}

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

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

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

    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
	Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
    }

    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
    return (void *) StackReallocWords(interp, numWords);
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_ExprObj --
 *
 *	Evaluate an expression in a Tcl_Obj.

		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	    if (hePtr) {
		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
		int redo = 0;

		if (invoker) {
		    CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
		    *ctxPtr = *invoker;

		    if (invoker->type == TCL_LOCATION_BC) {
			/*
			 * Note: Type BC => ctx.data.eval.path    is not used.
			 *		    ctx.data.tebc.codePtr used instead
			 */

			redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
				    && (eclPtr->start != ctxPtr->line[word]))
				|| ((eclPtr->type == TCL_LOCATION_BC)
				    && (ctxPtr->type == TCL_LOCATION_SOURCE));
		    }

		    TclStackFree(interp, ctxPtr);
		}

		if (redo) {
		    goto recompileObj;
		}
	    }
	}

 *
 * Side effects:
 *	Almost certainly, depending on the ByteCode's instructions.
 *
 *----------------------------------------------------------------------
 */
#define	bcFramePtr	(&TD->cmdFrame)
#define	initCatchTop	((ptrdiff_t *) (&TD->stack[-1]))
#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
#define esPtr           (iPtr->execEnvPtr->execStackPtr)

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

    /*
     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
     *
     * The execution uses a unified stack: first a TEBCdata, immediately
     * above it a CmdFrame, then the catch stack, then the execution stack.
     *
     * Make sure the catch stack is large enough to hold the maximum number of
     * catch commands that could ever be executing at the same time (this will
     * be no more than the exception range array's depth). Make sure the
     * execution stack is large enough to execute this ByteCode.
     */

    TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
    esPtr->tosPtr = initTosPtr;
    
    TD->codePtr     = codePtr;
    TD->pc          = codePtr->codeStart;
    TD->catchTop    = initCatchTop;
    TD->cleanup     = 0;
    TD->auxObjList  = NULL;
    TD->checkInterp = 0;

    
    /*
     * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
     * every time that we call out from this TD, popped when we return to it.
     */

    bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)

    /*
     * These macros are just meant to save some global variables that are not
     * used too frequently
     */

    TEBCdata *TD = data[0];
#define auxObjList	(TD->auxObjList)
#define catchTop	(TD->catchTop)
#define codePtr         (TD->codePtr)
#define checkInterp	(TD->checkInterp)
                        /* Indicates when a check of interp readyness
			 * is necessary. Set by CACHE_STACK_INFO() */

    /*
     * Globals: variables that store state, must remain valid at all times.
     */

    Tcl_Obj **tosPtr;	      /* Cached pointer to top of evaluation
			       * stack. */

	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
	}
	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
	}

	CACHE_STACK_INFO();
	if (result == TCL_OK) {
#ifndef TCL_COMPILE_DEBUG
	    if (*pc == INST_POP) {
		NEXT_INST_V(1, cleanup, 0);
	    }
#endif
	    /*

    /*
     * Check for asynchronous handlers [Bug 746722]; we do the check every
     * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
     */

    if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
	DECACHE_STACK_INFO();
	if (TclAsyncReady(iPtr)) {
	    result = Tcl_AsyncInvoke(interp, result);
	    if (result == TCL_ERROR) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
	}

	if (TclCanceled(iPtr)) {
	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
	}

	if (TclLimitReady(iPtr->limit)) {
	    if (Tcl_LimitCheck(interp) == TCL_ERROR) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
	}
	CACHE_STACK_INFO();
    }

    TCL_DTRACE_INST_NEXT();

    /*
     * These two instructions account for 26% of all instructions (according
     * to measurements on tclbench by Ben Vitale

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) CURR_DEPTH;
	PUSH_TAUX_OBJ(objPtr);
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

	/*
	 * Make sure that the element at stackTop is a list; if not, just
	 * leave with an error. Note that the element from the expand list
	 * will be removed at checkForCatch.
	 */

	objPtr = OBJ_AT_TOS;
	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
		    Tcl_GetObjResult(interp));
	    goto gotError;
	}
	(void) POP_OBJECT();

	/*
	 * Make sure there is enough room in the stack to expand this list
	 * *and* process the rest of the command (at least up to the next
	 * argument expansion or command end). The operand is the current
	 * stack depth, as seen by the compiler.
	 */



	length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
	DECACHE_STACK_INFO();
	moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
		- (Tcl_Obj **) TD;
	if (moved) {
	    /*
	     * Change the global data to point to the new stack: move the
	     * TEBCdataPtr TD, recompute the position of every other
	     * stack-allocated parameter, update the stack pointers.
	     */

	    esPtr = iPtr->execEnvPtr->execStackPtr;



	    TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);



	    catchTop += moved;
	    tosPtr += moved;

	}

	/*
	 * Expand the list at stacktop onto the stack; free the list. Knowing
	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
	 */

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

	Tcl_DecrRefCount(objPtr);
	NEXT_INST_F(5, 0, 0);
    }

    case INST_EXPR_STK: {
	ByteCode *newCodePtr;

	bcFramePtr->data.tebc.pc = (char *) pc;
	iPtr->cmdFramePtr = bcFramePtr;
	DECACHE_STACK_INFO();
	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
	CACHE_STACK_INFO();

	cleanup = 1;
	pc++;
	TEBC_YIELD();
	return TclNRExecuteByteCode(interp, newCodePtr);
    }

	/*

	iPtr->cmdFramePtr = bcFramePtr;

	if (iPtr->flags & INTERP_DEBUG_FRAME) {
	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
		    codePtr, bcFramePtr, pc - codePtr->codeStart);
	}

	DECACHE_STACK_INFO();

	pc += pcAdjustment;
	TEBC_YIELD();
	return TclNREvalObjv(interp, objc, objv,
		TCL_EVAL_NOERR, NULL);

#if TCL_SUPPORT_84_BYTECODE
    case INST_CALL_BUILTIN_FUNC1:

    doCallPtrGetVar:
	/*
	 * There are either errors or the variable is traced: call
	 * TclPtrGetVar to process fully.
	 */

	DECACHE_STACK_INFO();
	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
	CACHE_STACK_INFO();

	if (!objResultPtr) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_V(pcAdjustment, cleanup, 1);

	    varPtr = varPtr->value.linkPtr;
	}
	cleanup = 1;
	arrayPtr = NULL;
	part1Ptr = part2Ptr = NULL;

    doCallPtrSetVar:
	DECACHE_STACK_INFO();
	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
	CACHE_STACK_INFO();

	if (!objResultPtr) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
#ifndef TCL_COMPILE_DEBUG
	if (*(pc+pcAdjustment) == INST_POP) {
	    NEXT_INST_V((pcAdjustment+1), cleanup, 0);

		Tcl_DecrRefCount(incrPtr);
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	    Tcl_DecrRefCount(incrPtr);
	} else {
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();

	    Tcl_DecrRefCount(incrPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	}

	opnd = TclGetUInt4AtPtr(pc+1);
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (ReadTraced(varPtr)) {
	    DECACHE_STACK_INFO();
	    TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
		    TCL_TRACE_READS, 0, opnd);
	    CACHE_STACK_INFO();

	    if (TclIsVarUndefined(varPtr)) {
		TclCleanupVar(varPtr, NULL);
		varPtr = NULL;
	    }
	}

	/*

		goto doneExistArray;
	    }
	}
	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access",
		0, 1, arrayPtr, opnd);
	if (varPtr) {
	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
		DECACHE_STACK_INFO();
		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
			TCL_TRACE_READS, 0, opnd);
		CACHE_STACK_INFO();

	    }
	    if (TclIsVarUndefined(varPtr)) {
		TclCleanupVar(varPtr, arrayPtr);
		varPtr = NULL;
	    }
	}
    doneExistArray:

	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));

    doExistStk:
	varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, 0, "access",
		/*createPart1*/0, /*createPart2*/1, &arrayPtr);
	if (varPtr) {
	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
		DECACHE_STACK_INFO();
		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
			TCL_TRACE_READS, 0, -1);
		CACHE_STACK_INFO();

	    }
	    if (TclIsVarUndefined(varPtr)) {
		TclCleanupVar(varPtr, arrayPtr);
		varPtr = NULL;
	    }
	}
	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);

		goto slowUnsetScalar;
	    }
	    varPtr->value.objPtr = NULL;
	    NEXT_INST_F(6, 0, 0);
	}

    slowUnsetScalar:
	DECACHE_STACK_INFO();
	if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
		opnd) != TCL_OK && flags) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_F(6, 0, 0);

    case INST_UNSET_ARRAY:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	opnd = TclGetUInt4AtPtr(pc+2);
	part2Ptr = OBJ_AT_TOS;
	arrayPtr = LOCAL(opnd);

		 * Don't need to do anything here.
		 */

		NEXT_INST_F(6, 1, 0);
	    }
	}
    slowUnsetArray:
	DECACHE_STACK_INFO();
	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
		0, 0, arrayPtr, opnd);
	if (!varPtr) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		goto errorInUnset;
	    }
	} else if (TclPtrUnsetVar(interp, varPtr, arrayPtr, NULL, part2Ptr,
		flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_F(6, 1, 0);

    case INST_UNSET_ARRAY_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 2;
	part2Ptr = OBJ_AT_TOS;		/* element name */
	part1Ptr = OBJ_UNDER_TOS;	/* array name */
	TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
		O2S(part1Ptr), O2S(part2Ptr)));
	goto doUnsetStk;

    case INST_UNSET_STK:
	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
	cleanup = 1;
	part2Ptr = NULL;
	part1Ptr = OBJ_AT_TOS;		/* variable name */
	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));

    doUnsetStk:
	DECACHE_STACK_INFO();
	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
		&& (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
	CACHE_STACK_INFO();
	NEXT_INST_V(2, cleanup, 0);

    errorInUnset:
	CACHE_STACK_INFO();
	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	goto gotError;

	/*
	 * This is really an unset operation these days. Do not issue.
	 */

    case INST_DICT_DONE:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u\n", opnd));
	varPtr = LOCAL(opnd);
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
	    if (!TclIsVarUndefined(varPtr)) {
		TclDecrRefCount(varPtr->value.objPtr);
	    }
	    varPtr->value.objPtr = NULL;
	} else {
	    DECACHE_STACK_INFO();
	    TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
	    CACHE_STACK_INFO();

	}
	NEXT_INST_F(5, 0, 0);
    }

    /*
     *	   End of INST_UNSET instructions.
     * -----------------------------------------------------------------

	int i1, i2, iResult;

	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;
	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();	    

	    goto gotError;
	}

	if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    CACHE_STACK_INFO();	    

	    goto gotError;
	}

	if (*pc == INST_LOR) {
	    iResult = (i1 || i2);
	} else {
	    iResult = (i1 && i2);

	valuePtr = OBJ_UNDER_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) {
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (valuePtr->typePtr?
		    valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}

	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
		|| (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) {
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
		    O2S(value2Ptr), (value2Ptr->typePtr?
		    value2Ptr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}

	/*
	 * Check for common, simple case.
	 */

		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		    Tcl_SetResult(interp, "negative shift argument",
			    TCL_STATIC);
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);

		}

	    case INST_LSHIFT:
		if (l2 < 0) {
		    Tcl_SetResult(interp, "negative shift argument",
			    TCL_STATIC);
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    CACHE_STACK_INFO();
#endif
		    goto gotError;
		} else if (l1 == 0) {
		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
		    objResultPtr = TCONST(0);
		    TRACE(("%s\n", O2S(objResultPtr)));
		    NEXT_INST_F(1, 2, 1);
		} else if (l2 > (long) INT_MAX) {
		    /*
		     * Technically, we could hold the value (1 << (INT_MAX+1))
		     * in an mp_int, but since we're using mp_mul_2d() to do
		     * the work, and it takes only an int argument, that's a
		     * good place to draw the line.
		     */

		    Tcl_SetResult(interp,
			    "integer value too large to represent",
			    TCL_STATIC);
#if 0
		    DECACHE_STACK_INFO();
		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);
		    CACHE_STACK_INFO();

#endif
		    goto gotError;
		} else {
		    int shift = (int) l2;

		    /*
		     * Handle shifts within the native long range.

	valuePtr = OBJ_UNDER_TOS;

	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {
	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}

#ifdef ACCEPT_NAN
	if (type1 == TCL_NUMBER_NAN) {
	    /*
	     * NaN first argument -> result is also NaN.
	     */

	    NEXT_INST_F(1, 1, 0);
	}
#endif

	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
		|| IsErroringNaNType(type2)) {
	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
		    O2S(value2Ptr), O2S(valuePtr),
		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, value2Ptr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}

#ifdef ACCEPT_NAN
	if (type2 == TCL_NUMBER_NAN) {
	    /*
	     * NaN second argument -> result is also NaN.

	valuePtr = OBJ_AT_TOS;

	/* TODO - check claim that taking address of b harms performance */
	/* TODO - consider optimization search for constants */
	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}
	/* TODO: Consider peephole opt. */
	objResultPtr = TCONST(!b);
	NEXT_INST_F(1, 1, 1);
    }

   case INST_BITNOT:
	valuePtr = OBJ_AT_TOS;
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
	    /*
	     * ... ~$NonInteger => raise an error.
	     */

	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}
	if (type1 == TCL_NUMBER_LONG) {
	    l1 = *((const long *) ptr1);
	    if (Tcl_IsShared(valuePtr)) {
		TclNewLongObj(objResultPtr, ~l1);
		NEXT_INST_F(1, 1, 1);

    case INST_UMINUS:
	valuePtr = OBJ_AT_TOS;
	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
		|| IsErroringNaNType(type1)) {
	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
	    DECACHE_STACK_INFO();
	    IllegalExprOperandType(interp, pc, valuePtr);
	    CACHE_STACK_INFO();

	    goto gotError;
	}
	switch (type1) {
	case TCL_NUMBER_NAN:
	    /* -NaN => NaN */
	    NEXT_INST_F(1, 0, 0);
	case TCL_NUMBER_LONG:

	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();

		goto gotError;
	    }

	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
	    NEXT_INST_F(1, 0, 0);
	}
	if (IsErroringNaNType(type1)) {
	    if (*pc == INST_UPLUS) {
		/*
		 * ... +$NonNumeric => raise an error.
		 */

		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
		DECACHE_STACK_INFO();
		IllegalExprOperandType(interp, pc, valuePtr);
		CACHE_STACK_INFO();

	    } else {
		/*
		 * Numeric conversion of NaN -> error.
		 */

		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));
		DECACHE_STACK_INFO();
		TclExprFloatError(interp, *((const double *) ptr1));
		CACHE_STACK_INFO();

	    }
	    goto gotError;
	}

	/*
	 * Ensure that the numeric value has a string rep the same as the
	 * formatted version of its internal rep. This is used, e.g., to make

    /*
     *	   End of numeric operator instructions.
     * -----------------------------------------------------------------
     */

    case INST_BREAK:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();

	*/
	result = TCL_BREAK;
	cleanup = 0;
	goto processExceptionReturn;

    case INST_CONTINUE:
	/*
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();

	*/
	result = TCL_CONTINUE;
	cleanup = 0;
	goto processExceptionReturn;

    {
	ForeachInfo *infoPtr;

			    if (value2Ptr != NULL) {
				TclDecrRefCount(value2Ptr);
			    }
			    varPtr->value.objPtr = valuePtr;
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {
			DECACHE_STACK_INFO();
			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
			    CACHE_STACK_INFO();

			    TRACE_WITH_OBJ((
				    "%u => ERROR init. index temp %d: ",
				    opnd,varIndex), Tcl_GetObjResult(interp));
			    TclDecrRefCount(listPtr);
			    goto gotError;
			}
			CACHE_STACK_INFO();
		    }
		    valIndex++;
		}
		TclDecrRefCount(listPtr);
		listTmpIndex++;
	    }
	}

    case INST_BEGIN_CATCH4:
	/*
	 * Record start of the catch command with exception range index equal
	 * to the operand. Push the current stack depth onto the special catch
	 * stack.
	 */

	*(++catchTop) = CURR_DEPTH;
	TRACE(("%u => catchTop=%d, stackTop=%d\n",
		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
		(int) CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);

    case INST_END_CATCH:
	catchTop--;
	DECACHE_STACK_INFO();
	Tcl_ResetResult(interp);
	CACHE_STACK_INFO();

	result = TCL_OK;
	TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
	NEXT_INST_F(1, 0, 0);

    case INST_PUSH_RESULT:
	objResultPtr = Tcl_GetObjResult(interp);
	TRACE_WITH_OBJ(("=> "), objResultPtr);

	/*

    case INST_PUSH_RETURN_CODE:
	TclNewIntObj(objResultPtr, result);
	TRACE(("=> %u\n", result));
	NEXT_INST_F(1, 0, 1);

    case INST_PUSH_RETURN_OPTIONS:
	DECACHE_STACK_INFO();
	objResultPtr = Tcl_GetReturnOptions(interp, result);
	CACHE_STACK_INFO();

	TRACE_WITH_OBJ(("=> "), objResultPtr);
	NEXT_INST_F(1, 0, 1);

    case INST_RETURN_CODE_BRANCH: {
	int code;

	if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) {

	}
	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
		&objResultPtr) == TCL_OK) {
	    if (objResultPtr) {
		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_V(5, opnd+1, 1);
	    }
	    DECACHE_STACK_INFO();
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
		    "\" not known in dictionary", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), NULL);
	    CACHE_STACK_INFO();
	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
	} else {
	    TRACE_WITH_OBJ((
		    "%u => ERROR reading leaf dictionary key \"%s\": ",
		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
	}
	goto gotError;

	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u %u => ", opnd, opnd2));
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
	    dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);
	    CACHE_STACK_INFO();

	}
	if (dictPtr == NULL) {
	    TclNewObj(dictPtr);
	    allocateDict = 1;
	} else {
	    allocateDict = Tcl_IsShared(dictPtr);
	    if (allocateDict) {

		    TclDecrRefCount(value2Ptr);
		}
		varPtr->value.objPtr = dictPtr;
	    }
	    objResultPtr = dictPtr;
	} else {
	    Tcl_IncrRefCount(dictPtr);
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
	    CACHE_STACK_INFO();

	    TclDecrRefCount(dictPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	}

	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
	    CACHE_STACK_INFO();

	}
	if (dictPtr == NULL) {
	    TclNewObj(dictPtr);
	    allocateDict = 1;
	} else {
	    allocateDict = Tcl_IsShared(dictPtr);
	    if (allocateDict) {

		    TclDecrRefCount(value2Ptr);
		}
		varPtr->value.objPtr = dictPtr;
	    }
	    objResultPtr = dictPtr;
	} else {
	    Tcl_IncrRefCount(dictPtr);
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();

	    TclDecrRefCount(dictPtr);
	    if (objResultPtr == NULL) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	}

	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
		    TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();

	    if (dictPtr == NULL) {
		goto gotError;
	    }
	}
	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
		&keyPtrPtr) != TCL_OK) {
	    goto gotError;
	}
	if (length != duiPtr->length) {
	    Tcl_Panic("dictUpdateStart argument length mismatch");
	}
	for (i=0 ; i<length ; i++) {
	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
		    &valuePtr) != TCL_OK) {
		goto gotError;
	    }
	    varPtr = LOCAL(duiPtr->varIndices[i]);
	    while (TclIsVarLink(varPtr)) {
		varPtr = varPtr->value.linkPtr;
	    }
	    DECACHE_STACK_INFO();
	    if (valuePtr == NULL) {
		TclObjUnsetVar2(interp,
			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
			NULL, 0);
	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    valuePtr, TCL_LEAVE_ERR_MSG,
		    duiPtr->varIndices[i]) == NULL) {
		CACHE_STACK_INFO();
		goto gotError;
	    }
	    CACHE_STACK_INFO();
	}
	NEXT_INST_F(9, 0, 0);

    case INST_DICT_UPDATE_END:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	TRACE(("%u => ", opnd));
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
	    CACHE_STACK_INFO();

	}
	if (dictPtr == NULL) {
	    NEXT_INST_F(9, 1, 0);
	}
	if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK
		|| TclListObjGetElements(interp, OBJ_AT_TOS, &length,
			&keyPtrPtr) != TCL_OK) {

	    while (TclIsVarLink(var2Ptr)) {
		var2Ptr = var2Ptr->value.linkPtr;
	    }
	    if (TclIsVarDirectReadable(var2Ptr)) {
		valuePtr = var2Ptr->value.objPtr;
	    } else {
		DECACHE_STACK_INFO();
		valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
			duiPtr->varIndices[i]);
		CACHE_STACK_INFO();

	    }
	    if (valuePtr == NULL) {
		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
	    } else if (dictPtr == valuePtr) {
		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
			Tcl_DuplicateObj(valuePtr));
	    } else {
		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr);
	    }
	}
	if (TclIsVarDirectWritable(varPtr)) {
	    Tcl_IncrRefCount(dictPtr);
	    TclDecrRefCount(varPtr->value.objPtr);
	    varPtr->value.objPtr = dictPtr;
	} else {
	    DECACHE_STACK_INFO();
	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
	    CACHE_STACK_INFO();

	    if (objResultPtr == NULL) {
		if (allocdict) {
		    TclDecrRefCount(dictPtr);
		}
		goto gotError;
	    }
	}

	/*
	 * Division by zero in an expression. Control only reaches this point
	 * by "goto divideByZero".
	 */

    divideByZero:
	DECACHE_STACK_INFO();	
	Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
	CACHE_STACK_INFO();	

	goto gotError;

	/*
	 * Exponentiation of zero by negative number in an expression. Control
	 * only reaches this point by "goto exponOfZero".
	 */

    exponOfZero:
	DECACHE_STACK_INFO();	
	Tcl_SetResult(interp, "exponentiation of zero by negative power",
		TCL_STATIC);
	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
		"exponentiation of zero by negative power", NULL);
	CACHE_STACK_INFO();

	/*
	 * Almost all error paths feed through here rather than assigning to
	 * result themselves (for a small but consistent saving).
	 */

    gotError:

	if (iPtr->execEnvPtr->rewind) {
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;

	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();

	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

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

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

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

	    if (traceInstructions) {
		fprintf(stdout, "   ... limit exceeded, returning %s\n",
			StringForResultCode(result));
	    }
#endif
	    goto abnormalReturn;
	}
	if (catchTop == initCatchTop) {
#ifdef TCL_COMPILE_DEBUG
	    if (traceInstructions) {
		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
			StringForResultCode(result));
	    }
#endif
	    goto abnormalReturn;

	 * "exception". It was found either by checkForCatch just above or by
	 * an instruction during break, continue, or error processing. Jump to
	 * its catchOffset after unwinding the operand stack to the depth it
	 * had when starting to execute the range's catch command.
	 */

    processCatch:
	while (CURR_DEPTH > *catchTop) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %d, catchTop=%d, "
		    "unwound to %ld, new pc %u\n",
		    rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
		    (long) *catchTop, (unsigned) rangePtr->catchOffset);
	}
#endif
	pc = (codePtr->codeStart + rangePtr->catchOffset);
	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */

	/*
	 * end of infinite loop dispatching on instructions.

	CLANG_ASSERT(bcFramePtr);
    }

    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
    if (--codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }
    TclStackFree(interp, TD);	/* free my stack */

    return result;
}

#undef codePtr
#undef iPtr
#undef bcFramePtr
#undef initCatchTop
#undef initTosPtr
#undef auxObjList
#undef catchTop
#undef TCONST

/*
 *----------------------------------------------------------------------
 *
 * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
 *

	 * Use objStrings as a list object.
	 */

	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
	    goto end;
	}
	attributeStringsAllocated = (const char **)
		TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
	for (index = 0; index < numObjStrings; index++) {
	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
	    attributeStringsAllocated[index] = TclGetString(objPtr);
	}
	attributeStringsAllocated[index] = NULL;
	attributeStrings = attributeStringsAllocated;
    }

  end:
    if (attributeStringsAllocated != NULL) {
	/*
	 * Free up the array we allocated.
	 */

	TclStackFree(interp, (void *) attributeStringsAllocated);

	/*
	 * We don't need this object that was passed to us any more.
	 */

	if (objStrings != NULL) {
	    Tcl_DecrRefCount(objStrings);

	 * platform.
	 */

	Tcl_ListObjLength(interp, typePtr, &length);
	if (length <= 0) {
	    goto skipTypes;
	}
	globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    int len;

    if (globTypes != NULL) {
	if (globTypes->macType != NULL) {
	    Tcl_DecrRefCount(globTypes->macType);
	}
	if (globTypes->macCreator != NULL) {
	    Tcl_DecrRefCount(globTypes->macCreator);
	}
	TclStackFree(interp, globTypes);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * Create the string argument array "argv". Make sure argv is large enough
     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
     */

    argc = objc - skip;
    argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));

    /*
     * Copy the string conversions of each (post option) object into the
     * argument vector.
     */

    for (i = 0; i < argc; i++) {
	argv[i] = TclGetString(objv[i + skip]);
    }
    argv[argc] = NULL;
    chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
	    ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));

    /*
     * Free the argv array.
     */

    TclStackFree(interp, (void *) argv);

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

    if (background) {
	/*

		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp, (unsigned)len);

		len = Tcl_ConvertCountedElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }

	    AFTER_FIRST_WORD;

	    /*

	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,(unsigned) len);

		len = Tcl_ConvertCountedElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }
	}

	AFTER_FIRST_WORD;

#}
#declare 1 {
#    int TclAccessDeleteProc(TclAccessProc_ *proc)
#}
#declare 2 {
#    int TclAccessInsertProc(TclAccessProc_ *proc)
#}
declare 3 {
    void TclAllocateFreeObjects(void)
}

# Replaced by TclpChdir in 8.1:
#  declare 4 {
#      int TclChdir(Tcl_Interp *interp, char *dirName)
#  }
declare 5 {
    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
	    Tcl_Channel errorChan)

}
declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
}

declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}

declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)
}
declare 218 {
    void TclPopStackFrame(Tcl_Interp *interp)
}

/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 by Miguel Sofer. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * This is a convenience macro used to initialize a thread local storage ptr.
 */

#define TCL_TSD_INIT(keyPtr) \
  (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))

/*
 *----------------------------------------------------------------
 * Data structures related to bytecode compilation and execution. These are
 * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c.
 *----------------------------------------------------------------
 */

/*
 * Forward declaration to prevent errors when the forward references to
 * Tcl_Parse and CompileEnv are encountered in the procedure type CompileProc
 * declared below.
 */

struct CompileEnv;

 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, ClientData clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;
    struct ExecStack *nextPtr;
    Tcl_Obj **markerPtr;
    Tcl_Obj **endPtr;
    Tcl_Obj **tosPtr;
    Tcl_Obj *stackWords[1];
} ExecStack;

/*
 * The data structure defining the execution environment for ByteCode's.
 * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
 * stack that holds command operands and results. The stack grows towards
 * increasing addresses. The member stackPtr points to the stackItems of the
 * currently active execution stack.
 */

				 * holds the nesting numLevels at yield. */
    int nargs;                  /* Number of args required for resuming this
				 * coroutine; -2 means "0 or 1" (default), -1
				 * means "any" */
} CoroutineData;

typedef struct ExecEnv {
    ExecStack *execStackPtr;	/* Points to the first item in the evaluation
				 * stack on the heap. */
    Tcl_Obj *constants[2];	/* Pointers to constant "0" and "1" objs. */
    struct Tcl_Interp *interp;
    struct NRE_callback *callbackPtr;
				/* Top callback in NRE's stack. */
    struct CoroutineData *corPtr;
    int rewind;
} ExecEnv;

 * Values for the selection mode, i.e the package require preferences.
 */

enum PkgPreferOptions {
    PKG_PREFER_LATEST, PKG_PREFER_STABLE
};

/*
 *----------------------------------------------------------------
 * This structure shadows the first few fields of the memory cache for the
 * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
 * definition there.
 * Some macros require knowledge of some fields in the struct in order to
 * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
 * to the relevant fields is kept in the objCache field in struct Interp.
 *----------------------------------------------------------------
 */

typedef struct AllocCache {
    struct Cache *nextPtr;	/* Linked list of cache entries. */
    Tcl_ThreadId owner;		/* Which thread's cache is this? */
    Tcl_Obj *firstObjPtr;	/* List of free objects for thread. */
    int numObjects;		/* Number of objects for thread. */
} AllocCache;

/*
 *----------------------------------------------------------------
 * This structure defines an interpreter, which is a collection of commands
 * plus other state information related to interpreting commands, such as
 * variable storage. Primary responsibility for this data structure is in
 * tclBasic.c, but almost every Tcl source file uses something in here.
 *----------------------------------------------------------------

     * Note that these are the same for all interps in the same thread. They
     * just have to be initialised for the thread's master interp, slaves
     * inherit the value.
     *
     * They are used by the macros defined below.
     */

    AllocCache *allocCache;
    void *pendingObjDataPtr;	/* Pointer to the Cache and PendingObjData
				 * structs for this interp's thread; see
				 * tclObj.c and tclThreadAlloc.c */
    int *asyncReadyPtr;		/* Pointer to the asyncReady indicator for
				 * this interp's thread; see tclAsync.c */
    /*
     * The pointer to the object system root ekeko. c.f. TIP #257.

 * The macro below is used to modify a "char" value (e.g. by casting it to an
 * unsigned character) so that it can be used safely with macros such as
 * isspace.
 */

#define UCHAR(c) ((unsigned char) (c))

/*
 * This macro is used to properly align the memory allocated by Tcl, giving
 * the same alignment as the native malloc.
 */

#if defined(__APPLE__)
#define TCL_ALLOCALIGN	16
#else
#define TCL_ALLOCALIGN	(2*sizeof(void *))
#endif

/*
 * This macro is used to determine the offset needed to safely allocate any
 * data structure in memory. Given a starting offset or size, it "rounds up"
 * or "aligns" the offset to the next 8-byte boundary so that any data
 * structure can be placed at the resulting offset without fear of an
 * alignment error.
 *

MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);
MODULE_SCOPE void	TclFinalizeIOSubsystem(void);
MODULE_SCOPE void	TclFinalizeFilesystem(void);
MODULE_SCOPE void	TclResetFilesystem(void);
MODULE_SCOPE void	TclFinalizeLoad(void);
MODULE_SCOPE void	TclFinalizeLock(void);
MODULE_SCOPE void	TclFinalizeMemorySubsystem(void);
MODULE_SCOPE void	TclFinalizeNotifier(void);
MODULE_SCOPE void	TclFinalizeObjects(void);
MODULE_SCOPE void	TclFinalizePreserve(void);
MODULE_SCOPE void	TclFinalizeSynchronization(void);
MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
MODULE_SCOPE void	TclFinalizeThreadData(void);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
MODULE_SCOPE double	TclFloor(const mp_int *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,

			    mp_int *bignumValue);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,

    tclObjsFreed++
#else
#  define TclIncrObjsAllocated()
#  define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */

#  define TclAllocObjStorage(objPtr)		\
	TclAllocObjStorageEx(NULL, (objPtr))

#  define TclFreeObjStorage(objPtr)		\
	TclFreeObjStorageEx(NULL, (objPtr))

#ifndef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes    = tclEmptyStringRep; \

	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

#if defined(PURIFY)

/*
 * The PURIFY mode is like the regular mode, but instead of doing block
 * Tcl_Obj allocation and keeping a freed list for efficiency, it always
 * allocates and frees a single Tcl_Obj so that tools like Purify can better
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree((char *) (objPtr))

#undef USE_THREAD_ALLOC
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
 * per-thread caches.
 */

MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclpFreeAllocCache(void *);

/*
 * These macros need to be kept in sync with the code of TclThreadAllocObj()
 * and TclThreadFreeObj().
 *
 * Note that the optimiser should resolve the case (interp==NULL) at compile
 * time.
 */

#  define ALLOC_NOBJHIGH 1200

#  define TclAllocObjStorageEx(interp, objPtr)				\
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			(cachePtr->numObjects == 0))) {			\
	    (objPtr) = TclThreadAllocObj();				\
	} else {							\
	    (objPtr) = cachePtr->firstObjPtr;				\
	    cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \
	    --cachePtr->numObjects;					\
	}								\
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr)				\
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			(cachePtr->numObjects >= ALLOC_NOBJHIGH))) {	\
	    TclThreadFreeObj(objPtr);					\
	} else {							\
	    (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \
	    cachePtr->firstObjPtr = objPtr;				\
	    ++cachePtr->numObjects;					\
	}								\
    } while (0)

#else /* not PURIFY or USE_THREAD_ALLOC */

#ifdef TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex	tclObjMutex;
#endif

#  define TclAllocObjStorageEx(interp, objPtr) \
    do {								\
	Tcl_MutexLock(&tclObjMutex);					\
	if (tclFreeObjList == NULL) {					\
	    TclAllocateFreeObjects();					\
	}								\
	(objPtr) = tclFreeObjList;					\
	tclFreeObjList = (Tcl_Obj *)					\
		tclFreeObjList->internalRep.otherValuePtr;		\
	Tcl_MutexUnlock(&tclObjMutex);					\
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr) \
    do {							       \
	Tcl_MutexLock(&tclObjMutex);				       \
	(objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \
	tclFreeObjList = (objPtr);				       \
	Tcl_MutexUnlock(&tclObjMutex);				       \
    } while (0)
#endif

#else /* TCL_MEM_DEBUG */
MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
			    int line);

# define TclDbNewObj(objPtr, file, line) \
    do { \
	TclIncrObjsAllocated();						\

# define TclDecrRefCount(objPtr) \
    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)

# define TclNewListObjDirect(objc, objv) \
    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)

#undef USE_THREAD_ALLOC
#endif /* TCL_MEM_DEBUG */






























































































/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". This code works even if the
 * byte array contains NULLs as long as the length is correct. Because "len"
 * is referenced multiple times, it should be as simple an expression as

 * Adapted with permission from
 * http://www.pixelbeat.org/programming/gcc/static_assert.html
 */

#define TCL_CT_ASSERT(e) \
    {enum { ct_assert_value = 1/(!!(e)) };}

/*
 *----------------------------------------------------------------
 * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
 * Only checked at compile time.
 *
 * ONLY USE FOR CONSTANT nBytes.
 *
 * DO NOT LET THEM CROSS THREAD BOUNDARIES
 *----------------------------------------------------------------
 */

#define TclSmallAlloc(nbytes, memPtr) \
    TclSmallAllocEx(NULL, (nbytes), (memPtr))

#define TclSmallFree(memPtr) \
    TclSmallFreeEx(NULL, (memPtr))

#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), (objPtr));			\
	memPtr = (ClientData) (objPtr);					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(objPtr);						\
	memPtr = (ClientData) objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *objPtr = (Tcl_Obj *) memPtr;				\
	objPtr->bytes = NULL;						\
	objPtr->typePtr = NULL;						\
	objPtr->refCount = 1;						\
	TclDecrRefCount(objPtr);					\
    } while (0)
#endif   /* TCL_MEM_DEBUG */

/*
 * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
 */

#if defined(PURIFY) && defined(__clang__)
#if __has_feature(attribute_analyzer_noreturn) && \
	!defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
#endif
#if !defined(CLANG_ASSERT)
#include <assert.h>
#define CLANG_ASSERT(x) assert(x)
#endif
#elif !defined(CLANG_ASSERT)
#define CLANG_ASSERT(x)
#endif /* PURIFY && __clang__ */

/*
 *----------------------------------------------------------------
 * Parameters, structs and macros for the non-recursive engine (NRE)
 *----------------------------------------------------------------
 */

    if (((Interp *)interp)->deferredCallbacks) {			\
	TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \
	((Interp *)interp)->deferredCallbacks = NULL;			\
    }

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  ckfree((char *) (ptr))
#endif

#if NRE_ENABLE_ASSERTS

/*
 * Exported function declarations:
 */

/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* 3 */
EXTERN void		TclAllocateFreeObjects(void);
/* Slot 4 is reserved */
/* 5 */
EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
/* 6 */
EXTERN void		TclCleanupCommand(Command *cmdPtr);
/* 7 */

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

typedef struct TclIntStubs {
    int magic;
    const struct TclIntStubHooks *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
    int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */

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

/*
 * Inline function declarations:
 */

/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
#define TclAllocateFreeObjects \
	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
/* Slot 4 is reserved */
#define TclCleanupChildren \
	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
#define TclCleanupCommand \
	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#define TclCopyAndCollapse \
	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */

/* Slot 211 is reserved */
#define TclpFindExecutable \
	(tclIntStubsPtr->tclpFindExecutable) /* 212 */
#define TclGetObjNameOfExecutable \
	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
#define TclSetObjNameOfExecutable \
	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
#define TclStackAlloc \
	(tclIntStubsPtr->tclStackAlloc) /* 215 */
#define TclStackFree \
	(tclIntStubsPtr->tclStackFree) /* 216 */
#define TclPushStackFrame \
	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
#define TclPopStackFrame \
	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
/* Slot 219 is reserved */
/* Slot 220 is reserved */
/* Slot 221 is reserved */