Tcl Source Code

What is mig-alloc-reform?
  1. A massive simplification of the memory management in Tcl core.
     a. removal of the Tcl stack, each BC allocates its own stacklet
     b. TclStackAlloc is gone, replaced with ckalloc; goodbye to sometimes
        hard sync problems
     c. removal of the allocCache slot in struct Interp
     d. retirement of the (unused) Tcl allocator USE_TCLALLOC; replacement
        with a single-thread special case of zippy
     e. unify all allocator options in a single file tclAlloc.c
     d. exploit fast TSD via __thread where available (autoconferry still
        missing, enable by hand with -DHAVE_FAST_TSD)
     f. small improvements in zippy's memory usage: 
         . try to split blocks in the shared cache before allocating new
           ones from the system 
         . use the same bucket for Tcl_Objs and smallest allocs

  2. New allocator options
     a. purify build (but stop using them, see below). This is suitable to
        use with a preloaded malloc replacement
     b. (~NEW) native build: call to sys malloc, but maintain zippy's
        Tcl_Obj caches (per thread, if threads enabled). Can be switched to
        run as a purify build via an env var at startup. This is suitable to
        use with a preloaded malloc replacement. The threaded variant is new. 
     c. zippy build
     d. (NEW) multi build: this is a build that can function as any of the
        other three. Per default it runs as zippy, but can be switched to
        native or purify via an env var at startup. May or may not be used
        for deployment, but it will definitely be very useful for
        development: no need to recompile in order to valgrind, just set an
        env var!
     
 How do you use it? Options are:
   1. Don't pay any attention to it, build as always. You will get the same
      allocator as before
   2. Select the build you want with compiler flags
        -DTCL_ALLOCATOR=(aNATIVE|aPURIFY|aZIPPY|aMULTI)
   3. Select behaviour at startup: native can be switched to purify, multi
      can be switched to any of the others. Define the env var
      TCL_ALLOCATOR when starting up and you're good to go


** PERFORMANCE NOTES **
   * do enable HAVE_FAST_TSD on threaded build where available! Without
     that it is probably slower than before. Note that __thread is not
     available on macosx, but the "slow" version should be quite fast there
     (or so they say)
   * not measured, but: purify, native and zippy builds should be just as
     fast as before. The obj-alloc macros have been removed while
     developing. It is not certain that they provide a speedup, this will
     be measured and acted accordingly 
   * multi build should be a only a tad slower, may even be suitable as
     default build on all platforms 
   * zippy stats not enabled by default, -DZIPPY_STATS switches them on

** TO DO LIST **
   * DEFINITELY
     - test like crazy
     - timings: versus older version (in unthreaded, fast-tsd and slow-tsd
       builds). Determine if the obj-alloc macros should be reenabled
     - autoconferry to auto-detect HAVE_FAST_TSD
     - autoconferry to choose allocator flags? Keep USE_THREAD_ALLOC and
       USE_TCLALLOC for back compat with external build scripts only (and
       set them too!), but set also the new variants  
          TCL_ALLOCATOR=(aNATIVE|aPURIFY|aZIPPY|aMULTI)
     - Makefile.in and autoconferry changes in windows, mac
     - choose allocators from the command line instead of env vars?
     - verify interaction with memdebug (should be 'none', but ...)

   * MAYBE
     - build zippy as malloc-replacement, compile always aNATIVE and
       preload alternatives

/*
 * tclAlloc.c --
 *
 *      This is the generic part of the Tcl allocator. It handles the


 *      freeObjLists and defines which main allocator will be used.
 *

 * Copyright (c) 2013 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.
 */

#include "tclInt.h"
#include "tclAlloc.h"

/*


 * Parameters for the per-thread Tcl_Obj cache:
 *   - if >NOBJHIGH free objects, move some to the shared cache
 *   - if no objects are available, create NOBJALLOC of them
 */

#define NOBJHIGH	1200
#define NOBJALLOC	((NOBJHIGH*2)/3)



/*

 * The Tcl_Obj per-thread cache.
 */


typedef struct Cache {
    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
    int numObjects;		/* Number of objects for thread */
    void *allocCachePtr;
} Cache;





static Cache sharedCache;
#define sharedPtr (&sharedCache)








#if defined(TCL_THREADS)
static Tcl_Mutex *objLockPtr;

static Cache *	GetCache(void);
static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);















#if defined(HAVE_FAST_TSD)
static __thread Cache *tcachePtr;

# define GETCACHE(cachePtr)			\

    do {					\
	if (!tcachePtr) {			\
	    tcachePtr = GetCache();		\
	}					\
	(cachePtr) = tcachePtr;			\
    } while (0)



#else /* THREADS, not HAVE_FAST_TSD */
# define GETCACHE(cachePtr)			\
    do {					\
	(cachePtr) = TclpGetAllocCache();	\
	if ((cachePtr) == NULL) {		\
	    (cachePtr) = GetCache();		\
	}					\
    } while (0)
#endif /* FAST TSD */

#else /* NOT THREADS */
#define GETCACHE(cachePtr)			\
    (cachePtr) = (&sharedCache)
#endif /* THREADS */






/*
 *----------------------------------------------------------------------
 *
 * GetCache ---
 *
 *	Gets per-thread memory cache, allocating it if necessary.
 *
 * Results:
 *	Pointer to cache.


 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */



#if defined(TCL_THREADS)
static Cache *
GetCache(void)
{
    Cache *cachePtr;

    /*



     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {


	cachePtr = calloc(1, sizeof(Cache));

	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}


	cachePtr->allocCachePtr= NULL;
	TclpSetAllocCache(cachePtr);

    }
    return cachePtr;
}
#endif

/*



 * TclSetSharedAllocCache, TclSetAllocCache, TclGetAllocCache
 *
 * These are utility functions for the loadable allocator.
 */



void
TclSetSharedAllocCache(
    void *allocCachePtr)
{

    sharedPtr->allocCachePtr = allocCachePtr;
}


void

TclSetAllocCache(
    void *allocCachePtr)
{
    Cache *cachePtr;


    GETCACHE(cachePtr);
    cachePtr->allocCachePtr = allocCachePtr;
}






void *
TclGetAllocCache(void)
{
    Cache *cachePtr;


    GETCACHE(cachePtr);
    return cachePtr->allocCachePtr;
}

  
/*
 *-------------------------------------------------------------------------
 *
 * TclInitAlloc --
 *
 *	Initialize the memory system.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Initialize the mutex used to serialize obj allocations.
 *      Call the allocator-specific initialization.
 *
 *-------------------------------------------------------------------------
 */

void
TclInitAlloc(void)
{
    /*
     * Set the params for the correct allocator
     */

#if defined(TCL_THREADS)
    Tcl_Mutex *initLockPtr;

    TCL_THREADED = 1;
    initLockPtr = Tcl_GetAllocMutex();
    Tcl_MutexLock(initLockPtr);
    objLockPtr = TclpNewAllocMutex();
    TclXpInitAlloc();
    Tcl_MutexUnlock(initLockPtr);
#else
    TCL_THREADED = 0;
    TclXpInitAlloc();
#endif /* THREADS */

#ifdef PURIFY
    TCL_PURIFY = 1;
#else
    TCL_PURIFY   = (getenv("TCL_PURIFY") != NULL);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAlloc --
 *



 *	This procedure is used to destroy all private resources used in this
 *	file.


 *
 * Results:
 *	None.
 *
 * Side effects:
 *      Call the allocator-specific finalization.


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

void
TclFinalizeAlloc(void)
{


#if defined(TCL_THREADS)






    TclpFreeAllocMutex(objLockPtr);



    objLockPtr = NULL;



    TclpFreeAllocCache(NULL);




#endif




    TclXpFinalizeAlloc();
}

/*
 *----------------------------------------------------------------------
 *
 * TclFreeAllocCache --
 *

 *	Flush and delete a cache, removing from list of caches.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if defined(TCL_THREADS)
void
TclFreeAllocCache(

    void *arg)
{



    Cache *cachePtr = arg;
    

    /*


     * Flush objs.
     */

    if (cachePtr->numObjects > 0) {
	Tcl_MutexLock(objLockPtr);
	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
	Tcl_MutexUnlock(objLockPtr);
    }


    /*

     * Flush the external allocator cache
     */



    TclXpFreeAllocCache(cachePtr->allocCachePtr);

}
#endif




/*
 *----------------------------------------------------------------------
 *
 * TclSmallAlloc --


 *




 *	Allocate a Tcl_Obj sized block from the per-thread cache.
 *
 * Results:
 *	Pointer to uninitialized memory.
 *
 * Side effects:
 *	May move blocks from shared cached or allocate new blocks if
 *	list is empty.
 *
 *----------------------------------------------------------------------
 */




void *
TclSmallAlloc(void)
{
    register Cache *cachePtr;
    register Tcl_Obj *objPtr;
    int numMove;
    Tcl_Obj *newObjsPtr;
   
    GETCACHE(cachePtr);

    /*


     * Pop the first object.
     */

    if(cachePtr->firstObjPtr) {
	haveObj:
	objPtr = cachePtr->firstObjPtr;
	cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;



	cachePtr->numObjects--;
	return objPtr;
    }




    /*

     * Do it AFTER looking at the queue, so that it doesn't slow down
     * non-purify small allocs.
     */
    
    if (TCL_PURIFY) {

	Tcl_Obj *objPtr = (Tcl_Obj *) TclpAlloc(sizeof(Tcl_Obj));

	if (objPtr == NULL) {
	    Tcl_Panic("alloc: could not allocate a new object");
	}
	return objPtr;
    }
    
    /*
     * Get this thread's obj list structure and move or allocate new objs if
     * necessary.
     */

#if defined(TCL_THREADS)
    Tcl_MutexLock(objLockPtr);
    numMove = sharedPtr->numObjects;
    if (numMove > 0) {
	if (numMove > NOBJALLOC) {
	    numMove = NOBJALLOC;
	}
	MoveObjs(sharedPtr, cachePtr, numMove);
    }
    Tcl_MutexUnlock(objLockPtr);
    if (cachePtr->firstObjPtr) {

	goto haveObj;
    }


#endif	
    cachePtr->numObjects = numMove = NOBJALLOC;
    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
    if (newObjsPtr == NULL) {
	Tcl_Panic("alloc: could not allocate %d new objects", numMove);
    }




    while (--numMove >= 0) {
	objPtr = &newObjsPtr[numMove];
	objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
	cachePtr->firstObjPtr = objPtr;
    }



    goto haveObj;
}




/*
 *----------------------------------------------------------------------
 *
 * TclSmallFree --
 *


 *	Return a free Tcl_Obj-sized block to the per-thread cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May move free blocks to shared list upon hitting high water mark.
 *
 *----------------------------------------------------------------------
 */

void
TclSmallFree(
    void *ptr)
{
    Cache *cachePtr;



    Tcl_Obj *objPtr = ptr;
    




    if (TCL_PURIFY) {
	TclpFree((char *) ptr);
	return;
    }


    

    GETCACHE(cachePtr);





    /*


     * Get this thread's list and push on the free Tcl_Obj.
     */

    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = objPtr;
    cachePtr->numObjects++;


#if defined(TCL_THREADS)
    /*
     * If the number of free objects has exceeded the high water mark, move
     * some blocks to the shared list.
     */

    if (cachePtr->numObjects > NOBJHIGH) {
	Tcl_MutexLock(objLockPtr);
	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
	Tcl_MutexUnlock(objLockPtr);


    }

#endif
}

/*
 *----------------------------------------------------------------------
 *
 * MoveObjs --
 *
 *	Move Tcl_Obj's between caches.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */








#if defined(TCL_THREADS)



static void


MoveObjs(






    Cache *fromPtr,







    Cache *toPtr,




    int numMove)






{



    register Tcl_Obj *objPtr = fromPtr->firstObjPtr;


    Tcl_Obj *fromFirstObjPtr = objPtr;






























    toPtr->numObjects += numMove;

    fromPtr->numObjects -= numMove;













    /*


     * Find the last object to be moved; set the next one (the first one not











     * to be moved) as the first object in the 'from' cache.




     */










































    while (--numMove) {



	objPtr = objPtr->internalRep.otherValuePtr;
    }
    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;

    /*


     * Move all objects as a block - they are already linked to each other, we




     * just have to update the first and last.




















     */









    objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;

    toPtr->firstObjPtr = fromFirstObjPtr;




}
















#endif












































































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

/*
 * tclAlloc.h --
 *
 *      This defines the interface for pluggable memory allocators for Tcl.
 *
 * Copyright (c) 2013 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 _TCLALLOC
#define _TCLALLOC

/*
 * These functions must be exported by the allocator. 
 */
 
char * TclpAlloc(unsigned int reqSize);
char * TclpRealloc(char *ptr, unsigned int reqSize);
void   TclpFree(char *ptr);
void * TclSmallAlloc(void);
void   TclSmallFree(void *ptr);

void   TclInitAlloc(void);
void   TclFinalizeAlloc(void);
void   TclFreeAllocCache(void *ptr);

/*
 * The allocator should allow for "purify mode" by checking the environment
 * variable TCL_PURIFY at initialization. If it is set to any value, it should
 * just shunt to plain malloc. This is used for debugging; the value can be
 * treated as a constant, it does not change in a running process.
 */

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

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

#define ALIGN(x)    (((x) + ALLOCALIGN - 1) & ~(ALLOCALIGN - 1))

#endif

/*
 * tclAllocNative.c --
 *
 *      This is the basic native allocator for Tcl, using zippy's per-thread
 *      free obj lists.
 *
 * Copyright (c) 2013 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.
 */

#define OBJQ_ONLY 1
#include "tclAllocZippy.c"

char *
TclpAlloc(
    unsigned int reqSize)
{
    return malloc(reqSize);
}

char *
TclpRealloc(  
    char *ptr,
    unsigned int reqSize)
{
    return realloc(ptr, reqSize);
}

void
TclpFree(
    char *ptr)
{
    free(ptr);
}

/*
 * tclAllocPurify.c --
 *
 *      This is the native allocator for Tcl, suitable for preloading anything else.
 *
 * Copyright (c) 2013 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.
 */

/* This is needed just for sizeof(Tcl_Obj) and malloc*/

#include "tclInt.h"

char *
TclpAlloc(
    unsigned int reqSize)
{
    return malloc(reqSize);
}

char *
TclpRealloc(  
    char *ptr,
    unsigned int reqSize)
{
    return realloc(ptr, reqSize);
}

void
TclpFree(
    char *ptr)
{
    free(ptr);
}

void *
TclSmallAlloc(void)
{
    return malloc(sizeof(Tcl_Obj));
}

void
TclSmallFree(
    void *ptr)
{
    free(ptr);
}

void
TclInitAlloc(void)
{
}

void
TclFinalizeAlloc(void)
{
}

void
TclFreeAllocCache(
    void *ptr)
{
}

/*
 * tclAllocZippy.c --
 *
 *	This is a very fast storage allocator for used with threads (designed
 *	avoid lock contention). The basic strategy is to allocate memory in
 *	fixed size blocks from block caches.
 *
 * The Initial Developer of the Original Code is America Online, Inc.
 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#define NATIVE_T (defined(OBJQ_ONLY) && defined(TCL_THREADS))
#define NATIVE_U (defined(OBJQ_ONLY) && !defined(TCL_THREADS))
#define NATIVE (NATIVE_T || NATIVE_U)
#define ZIPPY_T  (!defined(OBJQ_ONLY) && defined(TCL_THREADS))
#define ZIPPY_U  (!defined(OBJQ_ONLY) && !defined(TCL_THREADS))
#define ZIPPY (ZIPPY_T || ZIPPY_U)

/*
 * The following define the number of Tcl_Obj's to allocate/move at a time and
 * the high water mark to prune a per-thread cache. On a 32 bit system,
 * sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
 */

#define NOBJHIGH	1200
#define NOBJALLOC	((2*NOBJHIGH)/3)

#if ZIPPY 
/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK
#ifdef  NDEBUG
#define RCHECK		0
#else
#define RCHECK		1
#endif
#endif

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

#define ALIGN(x)    (((x) + TCL_ALLOCALIGN - 1) & ~(TCL_ALLOCALIGN - 1))


/*
 * The following union stores accounting information for each block including
 * two small magic numbers and a bucket number when in use or a next pointer
 * when free. The original requested size (not including the Block overhead)
 * is also maintained.
 */

typedef union Block {
    struct {
	union {
	    union Block *next;		/* Next in free list. */
	    struct {
		unsigned char magic1;	/* First magic number. */
		unsigned char bucket;	/* Bucket block allocated from. */
		unsigned char unused;	/* Padding. */
		unsigned char magic2;	/* Second magic number. */
	    } s;
	} u;
	size_t reqSize;			/* Requested allocation size. */
    } b;
    unsigned char padding[TCL_ALLOCALIGN];
} Block;
#define nextBlock	b.u.next
#define sourceBucket	b.u.s.bucket
#define magicNum1	b.u.s.magic1
#define magicNum2	b.u.s.magic2
#define MAGIC		0xEF
#define blockReqSize	b.reqSize

/*
 * The following defines the minimum and and maximum block sizes and the number
 * of buckets in the bucket cache.
 */

#define MINALLOC	((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
#define NBUCKETS	(11 - (MINALLOC >> 5))
#define MAXALLOC	(MINALLOC << (NBUCKETS - 1))

/*
 * The following structure defines a bucket of blocks with various accounting
 * and statistics information.
 */

typedef struct Bucket {
    Block *firstPtr;		/* First block available */
    long numFree;		/* Number of blocks available */

    /* All fields below for accounting only */
#if ZIPPY
    long numRemoves;		/* Number of removes from bucket */
    long numInserts;		/* Number of inserts into bucket */
    long numWaits;		/* Number of waits to acquire a lock */
    long numLocks;		/* Number of locks acquired */
    long totalAssigned;		/* Total space assigned to bucket */
#endif
} Bucket;

#endif /* ZIPPY */

/*
 * The following structure defines a cache of buckets and objs, of which there
 * will be (at most) one per thread. Any changes need to be reflected in the
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().
 */

typedef struct Cache {
    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
    int numObjects;		/* Number of objects for thread */
#if ZIPPY
    struct Cache *nextPtr;	/* Linked list of cache entries */
    int totalAssigned;		/* Total space assigned to thread */
    Bucket buckets[NBUCKETS];	/* The buckets for this thread */
    Tcl_ThreadId owner;		/* Which thread's cache is this? */
#endif
} Cache;

#if ZIPPY
/*
 * The following array specifies various per-bucket limits and locks. The
 * values are statically initialized to avoid calculating them repeatedly.
 */

static struct {
    size_t blockSize;		/* Bucket blocksize. */
    int maxBlocks;		/* Max blocks before move to share. */
#if ZIPPY_T
    int numMove;		/* Num blocks to move to share. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
#endif
} bucketInfo[NBUCKETS];

#endif /* ZIPPY */

/*
 * Static functions defined in this file.
 */

#if ZIPPY

#if ZIPPY_T
static Cache *	GetCache(void);
static void	LockBucket(Cache *cachePtr, int bucket);
static void	UnlockBucket(Cache *cachePtr, int bucket);
static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
static int	GetBlocks(Cache *cachePtr, int bucket);
#else /* ZIPPY_U */
#define GetBlocks(cachePtr, bucket) 0
#endif /* ZIPPY_U */

static void     InitBuckets(void);
static Block *	Ptr2Block(char *ptr);
static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
#endif /* ZIPPY */

#ifdef TCL_THREADS
static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
#endif

/*
 * Local variables defined in this file and initialized at startup.
 */

static Cache sharedCache;
static Cache *sharedPtr = &sharedCache;

#ifdef TCL_THREADS

static Tcl_Mutex *objLockPtr;

#if ZIPPY_T
static Tcl_Mutex *listLockPtr;
static Cache *firstCachePtr = &sharedCache;
#endif

#if defined(HAVE_FAST_TSD)
static __thread Cache *tcachePtr;

# define GETCACHE(cachePtr)			\
    do {					\
	if (!tcachePtr) {			\
	    tcachePtr = GetCache();		\
	}					\
	(cachePtr) = tcachePtr;			\
    } while (0)
#else /* FAST_TSD */
# define GETCACHE(cachePtr)			\
    do {					\
	(cachePtr) = TclpGetAllocCache();	\
	if ((cachePtr) == NULL) {		\
	    (cachePtr) = GetCache();		\
	}					\
    } while (0)
#endif /* FAST_TSD */

#else /* TCL_THREADS */

#define GETCACHE(cachePtr)			\
    (cachePtr) = sharedPtr
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetCache ---
 *
 *	Gets per-thread memory cache, allocating it if necessary.
 *
 * Results:
 *	Pointer to cache.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY
static void
InitBuckets(void)
{
    int i;
    
    for (i = 0; i < NBUCKETS; ++i) {
	bucketInfo[i].blockSize = MINALLOC << i;
	bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
#if ZIPPY_T
	bucketInfo[i].numMove = i < NBUCKETS - 1 ?
	    1 << (NBUCKETS - 2 - i) : 1;
	bucketInfo[i].lockPtr = TclpNewAllocMutex();
#endif
    }
}
#endif

#ifdef TCL_THREADS
static Cache *
GetCache(void)
{
    Cache *cachePtr;
    
    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = calloc(1, sizeof(Cache));
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
#if ZIPPY_T
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
	Tcl_MutexUnlock(listLockPtr);
	cachePtr->owner = Tcl_GetCurrentThread();
#endif
	TclpSetAllocCache(cachePtr); 
    }
    return cachePtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclFreeAllocCache --
 *
 *	Flush and delete a cache, removing from list of caches.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
#ifdef TCL_THREADS
void
TclFreeAllocCache(
    void *arg)
{
    Cache *cachePtr = arg;
#if ZIPPY_T
    Cache **nextPtrPtr;
    register unsigned int bucket;

    /*
     * Flush blocks.
     */

    for (bucket = 0; bucket < NBUCKETS; ++bucket) {
	if (cachePtr->buckets[bucket].numFree > 0) {
	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
	}
    }

    /*
     * Remove from pool list.
     */

    Tcl_MutexLock(listLockPtr);
    nextPtrPtr = &firstCachePtr;
    while (*nextPtrPtr != cachePtr) {
	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
    }
    *nextPtrPtr = cachePtr->nextPtr;
    cachePtr->nextPtr = NULL;
    Tcl_MutexUnlock(listLockPtr);
#endif
    
    /*
     * Flush objs.
     */

    if (cachePtr->numObjects > 0) {
	Tcl_MutexLock(objLockPtr);
	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
	Tcl_MutexUnlock(objLockPtr);
    }

    free(cachePtr);
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpAlloc --
 *
 *	Allocate memory.
 *
 * Results:
 *	Pointer to memory just beyond Block pointer.
 *
 * Side effects:
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */
#if ZIPPY

char *
TclpAlloc(
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    register int bucket;
    size_t size;
    
#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);

    /*
     * Increment the requested size to include room for the Block structure.
     * Call malloc() directly if the required amount is greater than the
     * largest block, otherwise pop the smallest block large enough,
     * allocating more blocks if necessary.
     */

    blockPtr = NULL;
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = malloc(size);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;
	}
	if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
	    blockPtr = cachePtr->buckets[bucket].firstPtr;
	    cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
#if ZIPPY_T
	    cachePtr->buckets[bucket].numFree--;
	    cachePtr->buckets[bucket].numRemoves++;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
#endif
	}
    }
    if (blockPtr == NULL) {
	return NULL;
    }
    return Block2Ptr(blockPtr, bucket, reqSize);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Return blocks to the thread block cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May move blocks to shared cache.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    char *ptr)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;

    if (ptr == NULL) {
	return;
    }

    GETCACHE(cachePtr);

    /*
     * Get the block back from the user pointer and call system free directly
     * for large blocks. Otherwise, push the block back on the bucket and move
     * blocks to the shared cache if there are now too many free.
     */

    blockPtr = Ptr2Block(ptr);
    bucket = blockPtr->sourceBucket;
    if (bucket == NBUCKETS) {
	cachePtr->totalAssigned -= blockPtr->blockReqSize;
	free(blockPtr);
	return;
    }

    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
    cachePtr->buckets[bucket].firstPtr = blockPtr;
    cachePtr->buckets[bucket].numFree++;
    cachePtr->buckets[bucket].numInserts++;

#if ZIPPY_T
    if (cachePtr != sharedPtr &&
	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpRealloc --
 *
 *	Re-allocate memory to a larger or smaller size.
 *
 * Results:
 *	Pointer to memory just beyond Block pointer.
 *
 * Side effects:
 *	Previous memory, if any, may be freed.
 *
 *----------------------------------------------------------------------
 */

char *
TclpRealloc(
    char *ptr,
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    void *newPtr;
    size_t size, min;
    int bucket;

    if (ptr == NULL) {
	return TclpAlloc(reqSize);
    }

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    GETCACHE(cachePtr);

    /*
     * If the block is not a system block and fits in place, simply return the
     * existing pointer. Otherwise, if the block is a system block and the new
     * size would also require a system block, call realloc() directly.
     */

    blockPtr = Ptr2Block(ptr);
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
#endif
    bucket = blockPtr->sourceBucket;
    if (bucket != NBUCKETS) {
	if (bucket > 0) {
	    min = bucketInfo[bucket-1].blockSize;
	} else {
	    min = 0;
	}
	if (size > min && size <= bucketInfo[bucket].blockSize) {
	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
	    return Block2Ptr(blockPtr, bucket, reqSize);
	}
    } else if (size > MAXALLOC) {
	cachePtr->totalAssigned -= blockPtr->blockReqSize;
	cachePtr->totalAssigned += reqSize;
	blockPtr = realloc(blockPtr, size);
	if (blockPtr == NULL) {
	    return NULL;
	}
	return Block2Ptr(blockPtr, NBUCKETS, reqSize);
    }

    /*
     * Finally, perform an expensive malloc/copy/free.
     */

    newPtr = TclpAlloc(reqSize);
    if (newPtr != NULL) {
	if (reqSize > blockPtr->blockReqSize) {
	    reqSize = blockPtr->blockReqSize;
	}
	memcpy(newPtr, ptr, reqSize);
	TclpFree(ptr);
    }
    return newPtr;
}
#endif /* OBJQ_ONLY */

/*
 *----------------------------------------------------------------------
 *
 * TclSmallAlloc --
 *
 *	Allocate a Tcl_Obj from the per-thread cache.
 *
 * Results:
 *	Pointer to uninitialized Tcl_Obj.
 *
 * Side effects:
 *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
 *	list is empty.
 *
 * Note:
 *	If this code is updated, the changes need to be reflected in the macro
 *	TclAllocObjStorageEx() defined in tclInt.h
 *
 *----------------------------------------------------------------------
 */

void *
TclSmallAlloc(void)
{
    register Cache *cachePtr;
    register Tcl_Obj *objPtr;
    register int numMove;


    GETCACHE(cachePtr);

    /*
     * Get this thread's obj list structure and move or allocate new objs if
     * necessary.
     */

#if ZIPPY_T
    if (cachePtr->numObjects == 0) {
	Tcl_MutexLock(objLockPtr);
	numMove = sharedPtr->numObjects;
	if (numMove > 0) {
	    if (numMove > NOBJALLOC) {
		numMove = NOBJALLOC;
	    }
	    MoveObjs(sharedPtr, cachePtr, numMove);
	}
	Tcl_MutexUnlock(objLockPtr);
    }
#endif

    if (cachePtr->numObjects == 0) {
	Tcl_Obj *newObjsPtr;
	
	cachePtr->numObjects = numMove = NOBJALLOC;
	newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
	if (newObjsPtr == NULL) {
	    Tcl_Panic("alloc: could not allocate %d new objects", numMove);
	}
	while (--numMove >= 0) {
	    objPtr = &newObjsPtr[numMove];
	    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
	    cachePtr->firstObjPtr = objPtr;
	}
    }

    /*
     * Pop the first object.
     */

    objPtr = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
    cachePtr->numObjects--;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSmallFree --
 *
 *	Return a free Tcl_Obj to the per-thread cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May move free Tcl_Obj's to shared list upon hitting high water mark.
 *
 * Note:
 *	If this code is updated, the changes need to be reflected in the macro
 *	TclAllocObjStorageEx() defined in tclInt.h
 *
 *----------------------------------------------------------------------
 */

void
TclSmallFree(
    void *ptr)
{
    Cache *cachePtr;
    Tcl_Obj *objPtr = ptr;
    
    GETCACHE(cachePtr);

    /*
     * Get this thread's list and push on the free Tcl_Obj.
     */

    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = objPtr;
    cachePtr->numObjects++;

    /*
     * If the number of free objects has exceeded the high water mark, move
     * some blocks to the shared list.
     */
#if ZIPPY_T
    if (cachePtr->numObjects > NOBJHIGH) {
	Tcl_MutexLock(objLockPtr);
	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
	Tcl_MutexUnlock(objLockPtr);
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMemoryInfo --
 *
 *	Return a list-of-lists of memory stats.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	List appended to given dstring.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY_T
void
Tcl_GetMemoryInfo(
    Tcl_DString *dsPtr)
{
    Cache *cachePtr;
    char buf[200];
    unsigned int n;

    Tcl_MutexLock(listLockPtr);
    cachePtr = firstCachePtr;
    while (cachePtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
		    (unsigned long) bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	Tcl_DStringEndSublist(dsPtr);
	cachePtr = cachePtr->nextPtr;
    }
    Tcl_MutexUnlock(listLockPtr);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * MoveObjs --
 *
 *	Move Tcl_Obj's between caches.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_THREADS

static void
MoveObjs(
    Cache *fromPtr,
    Cache *toPtr,
    int numMove)
{
    register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
    Tcl_Obj *fromFirstObjPtr = objPtr;

    toPtr->numObjects += numMove;
    fromPtr->numObjects -= numMove;

    /*
     * Find the last object to be moved; set the next one (the first one not
     * to be moved) as the first object in the 'from' cache.
     */

    while (--numMove) {
	objPtr = objPtr->internalRep.otherValuePtr;
    }
    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;

    /*
     * Move all objects as a block - they are already linked to each other, we
     * just have to update the first and last.
     */

    objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
    toPtr->firstObjPtr = fromFirstObjPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Block2Ptr, Ptr2Block --
 *
 *	Convert between internal blocks and user pointers.
 *
 * Results:
 *	User pointer or internal block.
 *
 * Side effects:
 *	Invalid blocks will abort the server.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY

static char *
Block2Ptr(
    Block *blockPtr,
    int bucket,
    unsigned int reqSize)
{
    register void *ptr;

    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
    blockPtr->sourceBucket = bucket;
    blockPtr->blockReqSize = reqSize;
    ptr = ((void *) (blockPtr + 1));
#if RCHECK
    ((unsigned char *)(ptr))[reqSize] = MAGIC;
#endif
    return (char *) ptr;
}

static Block *
Ptr2Block(
    char *ptr)
{
    register Block *blockPtr;

    blockPtr = (((Block *) ptr) - 1);
    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
	Tcl_Panic("alloc: invalid block: %p: %x %x",
		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
    }
#if RCHECK
    if (((unsigned char *) ptr)[blockPtr->blockReqSize] != MAGIC) {
	Tcl_Panic("alloc: invalid block: %p: %x %x %x",
		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
		((unsigned char *) ptr)[blockPtr->blockReqSize]);
    }
#endif
    return blockPtr;
}
#endif /* ZIPPY */

/*
 *----------------------------------------------------------------------
 *
 * LockBucket, UnlockBucket --
 *
 *	Set/unset the lock to access a bucket in the shared cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Lock activity and contention are monitored globally and on a per-cache
 *	basis.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY_T

static void
LockBucket(
    Cache *cachePtr,
    int bucket)
{
    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
    cachePtr->buckets[bucket].numLocks++;
    sharedPtr->buckets[bucket].numLocks++;
}

static void
UnlockBucket(
    Cache *cachePtr,
    int bucket)
{
    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
}
#endif /* ZIPPY_T */

/*
 *----------------------------------------------------------------------
 *
 * PutBlocks --
 *
 *	Return unused blocks to the shared cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY_T

static void
PutBlocks(
    Cache *cachePtr,
    int bucket,
    int numMove)
{
    register Block *lastPtr, *firstPtr;
    register int n = numMove;

    /*
     * Before acquiring the lock, walk the block list to find the last block
     * to be moved.
     */

    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
    while (--n > 0) {
	lastPtr = lastPtr->nextBlock;
    }
    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
    cachePtr->buckets[bucket].numFree -= numMove;

    /*
     * Aquire the lock and place the list of blocks at the front of the shared
     * cache bucket.
     */

    LockBucket(cachePtr, bucket);
    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
    sharedPtr->buckets[bucket].firstPtr = firstPtr;
    sharedPtr->buckets[bucket].numFree += numMove;
    UnlockBucket(cachePtr, bucket);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetBlocks --
 *
 *	Get more blocks for a bucket.
 *
 * Results:
 *	1 if blocks where allocated, 0 otherwise.
 *
 * Side effects:
 *	Cache may be filled with available blocks.
 *
 *----------------------------------------------------------------------
 */

#if ZIPPY_T
static int
GetBlocks(
    Cache *cachePtr,
    int bucket)
{
    register Block *blockPtr;
    register int n;

    /*
     * First, atttempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */

    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].numFree > 0) {
	LockBucket(cachePtr, bucket);
	if (sharedPtr->buckets[bucket].numFree > 0) {

	    /*
	     * Either move the entire list or walk the list to find the last
	     * block to move.
	     */

	    n = bucketInfo[bucket].numMove;
	    if (n >= sharedPtr->buckets[bucket].numFree) {
		cachePtr->buckets[bucket].firstPtr =
			sharedPtr->buckets[bucket].firstPtr;
		cachePtr->buckets[bucket].numFree =
			sharedPtr->buckets[bucket].numFree;
		sharedPtr->buckets[bucket].firstPtr = NULL;
		sharedPtr->buckets[bucket].numFree = 0;
	    } else {
		blockPtr = sharedPtr->buckets[bucket].firstPtr;
		cachePtr->buckets[bucket].firstPtr = blockPtr;
		sharedPtr->buckets[bucket].numFree -= n;
		cachePtr->buckets[bucket].numFree = n;
		while (--n > 0) {
		    blockPtr = blockPtr->nextBlock;
		}
		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
		blockPtr->nextBlock = NULL;
	    }
	}
	UnlockBucket(cachePtr, bucket);
    }
    
    if (cachePtr->buckets[bucket].numFree == 0) {
	register size_t size;

	/*
	 * If no blocks could be moved from shared, first look for a larger
	 * block in this cache to split up.
	 */

	blockPtr = NULL;
	n = NBUCKETS;
	size = 0; /* lint */
	while (--n > bucket) {
	    if (cachePtr->buckets[n].numFree > 0) {
		size = bucketInfo[n].blockSize;
		blockPtr = cachePtr->buckets[n].firstPtr;
		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
		cachePtr->buckets[n].numFree--;
		break;
	    }
	}

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = malloc(size);
	    if (blockPtr == NULL) {
		Tcl_Panic("FOO\n");
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.
	 */

	n = size / bucketInfo[bucket].blockSize;
	cachePtr->buckets[bucket].numFree = n;
	cachePtr->buckets[bucket].firstPtr = blockPtr;
	while (--n > 0) {
	    blockPtr->nextBlock = (Block *)
		((char *) blockPtr + bucketInfo[bucket].blockSize);
	    blockPtr = blockPtr->nextBlock;
	}
	blockPtr->nextBlock = NULL;
    }
    return 1;
}
#endif /* ZIPPY_T */

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAlloc --
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclInitAlloc(void)
{
#ifdef TCL_THREADS
#if ZIPPY_T 
    listLockPtr = TclpNewAllocMutex();
    InitBuckets();
#endif
    objLockPtr = TclpNewAllocMutex();
#endif

#if ZIPPY_U
    InitBuckets();
#endif
}

void
TclFinalizeAlloc(void)
{
#ifdef TCL_THREADS
#if ZIPPY_T
    unsigned int i;

    for (i = 0; i < NBUCKETS; ++i) {
	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
	bucketInfo[i].lockPtr = NULL;
    }

    TclpFreeAllocMutex(listLockPtr);
    listLockPtr = NULL;
#endif
    
    TclpFreeAllocMutex(objLockPtr);
    objLockPtr = NULL;

    TclpFreeAllocCache(NULL);
#endif
}

/*
 * 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) */
{


    AssemblyEnv* assemEnvPtr = ckalloc(sizeof(AssemblyEnv));
				/* Assembler environment under construction */
    Tcl_Parse* parsePtr = ckalloc(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 */
{





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

    }

    /*
     * Dispose what's left.
     */

    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
    ckfree(assemEnvPtr->parsePtr);
    ckfree(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.
     */







    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
     * pre-existing command by the same name). If a command has a Tcl_CmdProc

    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 = ckalloc((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);

    ckfree((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 = ckalloc((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);
    }
    ckfree(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 = ckalloc((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]);
	}
	ckfree(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]);
    }
    ckfree(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 = ckalloc(sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = ckalloc(sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = ckalloc(minObjs * sizeof(Tcl_Obj *));

    int *expandStack = ckalloc(minObjs * sizeof(int));
    int *linesStack = ckalloc(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);
    }
    ckfree(linesStack);
    ckfree(expandStack);
    ckfree(stackObjArray);
    ckfree(eeFramePtr);
    ckfree(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 = ckalloc(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 = ckalloc(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);
	    }
	    ckfree(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;
	ckfree(eoFramePtr);
    }
    TclDecrRefCount(listPtr);

    return result;
}

/*

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

    Tcl_MutexUnlock(ckallocMutexPtr);
#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;
    }

    TclCkSmallAlloc(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)");
	}
	TclSmallFree(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)));
    }
    TclSmallFree(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);
	TclSmallFree(iterPtr);
	return result;
    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFree(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);
    }
    TclSmallFree(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)");
	    TclSmallFree(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 = ckalloc(
	    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->aCopyList[i]) {
	    TclDecrRefCount(statePtr->aCopyList[i]);
	}
    }
    if (statePtr->resultList != NULL) {
	TclDecrRefCount(statePtr->resultList);
    }
    ckfree(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FormatObjCmd --
 *

	break;

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

	CmdFrame *fPtr = ckalloc(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));
	ckfree(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) {
		ckfree(sortInfo.indexv);
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",

		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv =
			ckalloc(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) {
		ckfree(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) {
	ckfree(sortInfo.indexv);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *

	    sortInfo.indexv = NULL;
	    break;
	case 1:
	    sortInfo.indexv = &sortInfo.singleIndex;
	    break;
	default:
	    sortInfo.indexv =
		    ckalloc(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]
                 * FIXME: TclStackAlloc is now retired, we could shrink it.
		 */

		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 = ckalloc(length * sizeof(SortElement));

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

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

  done1:
    ckfree(elementArray);

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

	mapWithDict = 1;

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

	mapElemv = ckalloc(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 = ckalloc(mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = ckalloc(mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = ckalloc(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) {
	    ckfree(u2lc);
	}
	ckfree(mapLens);
	ckfree(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) {
	ckfree(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 = ckalloc(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)));
    }
    ckfree(ctxPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ThrowObjCmd --

	return TCL_ERROR;
    }

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

    TclCkSmallAlloc(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 = ckalloc(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);
	ckfree(keyTokenPtrs);
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    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));
    }
    ckfree(keyTokenPtrs);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

int
TclCompileDictAppendCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */

    bodyIndex = i-1;

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

    numLists = (numWords - 2)/2;
    varcList = ckalloc(numLists * sizeof(int));
    memset(varcList, 0, numLists * sizeof(int));
    varvList = (const char ***) ckalloc(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]);
	}
    }
    ckfree((void *)varvList);
    ckfree(varcList);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DupForeachInfo --

	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = ckalloc(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]);
    }
    ckfree(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 = ckalloc(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 = ckalloc(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) {
	ckfree(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 = ckalloc(/*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]);
    }
    ckfree(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 = ckalloc(sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = ckalloc(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;
		}
	    }
	}
    }
    ckfree(fixupTargetArray);
    ckfree(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 = ckalloc(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.
     */

    ckfree(finalFixups);
    envPtr->currStackDepth = savedStackDepth + 1;
}

/*
 *----------------------------------------------------------------------
 *
 * DupJumptableInfo, FreeJumptableInfo --

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

    numHandlers = numWords >> 2;
    numWords -= numHandlers * 4;
    if (numHandlers > 0) {
	handlerTokens = ckalloc(sizeof(Tcl_Token*)*numHandlers);
	matchClauses = ckalloc(sizeof(Tcl_Obj *) * numHandlers);
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = ckalloc(sizeof(int) * numHandlers);
	resultVarIndices = ckalloc(sizeof(int) * numHandlers);
	optionVarIndices = ckalloc(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]);
	    }
	}
	ckfree(optionVarIndices);
	ckfree(resultVarIndices);
	ckfree(matchCodes);
	ckfree(matchClauses);
	ckfree(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 = ckalloc(sizeof(int)*numHandlers);
    forwardsToFix = ckalloc(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]);
    }
    ckfree(forwardsToFix);
    ckfree(addrsToFix);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

static int
IssueTryFinallyInstructions(
    Tcl_Interp *interp,

     */

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

	addrsToFix = ckalloc(sizeof(int)*numHandlers);
	forwardsToFix = ckalloc(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]);
	}
	ckfree(forwardsToFix);
	ckfree(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 = ckalloc(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 = ckalloc(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) {
	ckfree(elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}


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

	    case SCRIPT: {
		Tcl_Parse *nestedPtr =
			ckalloc(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;
		    }
		}
		ckfree(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 = ckalloc(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);
    ckfree(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 = ckalloc(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);
    ckfree(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 = ckalloc(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);
    ckfree(envPtr);
    byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
    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 = ckalloc(sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = ckalloc(sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = ckalloc(sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = ckalloc(sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = ckalloc(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;
		ckfree(freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		ckfree(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;
		ckfree(freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		ckfree(freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		ckfree(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 = ckalloc(2 * (objc-2) * sizeof(Tcl_Obj *));
	OpNode *nodes = ckalloc(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);

	ckfree(nodes);
	ckfree(litObjv);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *

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

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	Tcl_Obj *const *litObjv = objv + 1;
	OpNode *nodes = ckalloc((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);

	ckfree(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 = ckalloc(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);
		}
	    }
	}

	ckfree(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 = ckalloc(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;
    ckfree(parsePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --

	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	return TCL_ERROR;
    }
    searchPtr = ckalloc(sizeof(Tcl_DictSearch));
    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
	    &done) != TCL_OK) {
	ckfree(searchPtr);
	return TCL_ERROR;
    }
    if (done) {
	ckfree(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);
    ckfree(searchPtr);
    return TCL_ERROR;
}

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

     */

  done:
    TclDecrRefCount(keyVarObj);
    TclDecrRefCount(valueVarObj);
    TclDecrRefCount(scriptObj);
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DictMapNRCmd --

	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	return TCL_ERROR;
    }
    storagePtr = ckalloc(sizeof(DictMapStorage));
    if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
	    &valueObj, &done) != TCL_OK) {
	ckfree(storagePtr);
	return TCL_ERROR;
    }
    if (done) {
	/*
	 * Note that this exit leaves an empty value in the result (due to
	 * command calling conventions) but that is OK since an empty value is
	 * an empty dictionary.
	 */

	ckfree(storagePtr);
	return TCL_OK;
    }
    TclNewObj(storagePtr->accumulatorObj);
    TclListObjGetElements(NULL, objv[1], &varc, &varv);
    storagePtr->keyVarObj = varv[0];
    storagePtr->valueVarObj = varv[1];
    storagePtr->scriptObj = objv[3];

  error:
    TclDecrRefCount(storagePtr->keyVarObj);
    TclDecrRefCount(storagePtr->valueVarObj);
    TclDecrRefCount(storagePtr->scriptObj);
    TclDecrRefCount(storagePtr->accumulatorObj);
    Tcl_DictObjDone(&storagePtr->search);
    ckfree(storagePtr);
    return TCL_ERROR;
}

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

  done:
    TclDecrRefCount(storagePtr->keyVarObj);
    TclDecrRefCount(storagePtr->valueVarObj);
    TclDecrRefCount(storagePtr->scriptObj);
    TclDecrRefCount(storagePtr->accumulatorObj);
    Tcl_DictObjDone(&storagePtr->search);
    ckfree(storagePtr);
    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.
	     */

	    TclInitAlloc();		/* Process wide allocator init */
	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */



#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

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

    /*
     * Free synchronization objects. There really should only be one thread
     * alive at this moment.
     */

    TclFinalizeSynchronization();









    /*
     * 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
     * they were loaded in (i.e. last to be loaded is the first to be

    TclResetFilesystem();

    /*
     * At this point, there should no longer be any ckalloc'ed memory.
     */

    TclFinalizeMemorySubsystem();

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

    TclFinalizeAlloc();



  alreadyFinalized:
    TclFinalizeLock();
}

/*
 *----------------------------------------------------------------------

 * 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 */
				/* -----------------------------------------*/
    Tcl_Obj **tosPtr;
    const unsigned char *pc;	/* These fields are used on return TO this */
    unsigned long catchDepth;	        /* this level: they record the state when a */
    int cleanup;		/* new codePtr was received for NR */
    Tcl_Obj *auxObjList;	/* execution. */
    int checkInterp;
    unsigned int capacity;
    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() \
    do {								\
	TD->tosPtr = tosPtr;						\
	TD->pc = pc;							\
	TD->cleanup = cleanup;						\
	TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
    } while (0)

#define TEBC_DATA_DIG() \
    do {					\
	pc = TD->pc;				\
	cleanup = TD->cleanup;			\
	tosPtr = TD->tosPtr;			\
    } while (0)

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

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















/*
 * 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 checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);

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 void		IllegalExprOperandType(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj *opndPtr);
static void		InitByteCodeExecution(Tcl_Interp *interp);

static void		ReleaseDictIterator(Tcl_Obj *objPtr);



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




    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;







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


















void
TclDeleteExecEnv(
    ExecEnv *eePtr)		/* Execution environment to free. */
{


	cachedInExit = TclInExit();

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










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

TclFinalizeExecution(void)
{
    Tcl_MutexLock(&execMutex);
    execInitialized = 0;
    Tcl_MutexUnlock(&execMutex);
    TclFinalizeAuxDataTypeTable();
}


























































































































































































































































































































































/*
 *--------------------------------------------------------------
 *
 * Tcl_ExprObj --
 *
 *	Evaluate an expression in a Tcl_Obj.

	    if (!hePtr) {
		return codePtr;
	    }

	    eclPtr = Tcl_GetHashValue(hePtr);
	    redo = 0;
	    ctxCopyPtr = ckalloc(sizeof(CmdFrame));
	    *ctxCopyPtr = *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 != ctxCopyPtr->line[word]))
			|| ((eclPtr->type == TCL_LOCATION_BC)
			    && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
	    }

	    ckfree(ctxCopyPtr);
	    if (!redo) {
		return codePtr;
	    }
	}
    }

  recompileObj:

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

/*
 * The execution uses a unified stack: first a TEBCdata, immediately
 * above it 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.
 */

// FIXME! The "+1" should not be necessary, temporary until we fix BC issues

#define capacity2size(cap)						\
    (offsetof(TEBCdata, stack) + sizeof(void *)*(cap + codePtr->maxExceptDepth + 1))

int
TclNRExecuteByteCode(
    Tcl_Interp *interp,		/* Token for command interpreter. */
    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
{
    Interp *iPtr = (Interp *) interp;
    TEBCdata *TD;




    
    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 = ckalloc(capacity2size(codePtr->maxStackDepth));

    TD->codePtr     = codePtr;
    TD->tosPtr = initTosPtr;
    TD->pc          = codePtr->codeStart;
    TD->catchDepth  = -1;
    TD->cleanup     = 0;
    TD->auxObjList  = NULL;
    TD->checkInterp = 0;
    TD->capacity = codePtr->maxStackDepth;

    /*
     * 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 catchDepth	(TD->catchDepth)
#define codePtr		(TD->codePtr)
#define checkInterp	(TD->checkInterp)
                        /* Indicates when a check of interp readyness
			 * is necessary. Set by checkInterp = 1 */

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

	checkInterp = 1;
	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) {

	if (TclAsyncReady(iPtr)) {
	    result = Tcl_AsyncInvoke(interp, result);
	    if (result == TCL_ERROR) {
		checkInterp = 1;
		goto gotError;
	    }
	}

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

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

    /*
     * These two instructions account for 26% of all instructions (according
     * to measurements on tclbench by Ben Vitale
     * [http://www.cs.toronto.edu/syslab/pubs/tcl2005-vitale-zaleski.pdf]
     * Resolving them before the switch reduces the cost of branch

	TclNewObj(objPtr);
	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
	PUSH_TAUX_OBJ(objPtr);
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	unsigned int reqWords;

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


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

	reqWords =
	    /* how many were needed originally */
	    codePtr->maxStackDepth


	    /* plus how many we already consumed in previous expansions */
	    + (CURR_DEPTH - TclGetInt4AtPtr(pc+1))
	    /* plus how many are needed for this expansion */
	    + objc - 1;




	(void) POP_OBJECT();
	if (reqWords > TD->capacity) {
	    ptrdiff_t depth;
	    unsigned int size = capacity2size(reqWords);


	    depth = tosPtr - initTosPtr;
	    TD = ckrealloc(TD, size);
	    TD->capacity = reqWords;
	    tosPtr = initTosPtr + depth;
	}

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

	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);

	checkInterp = 1;
	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);
	}



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

#if TCL_SUPPORT_84_BYTECODE
    case INST_CALL_BUILTIN_FUNC1:

	if (iPtr->flags & INTERP_DEBUG_FRAME) {
	    TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc,
		    codePtr, bcFramePtr, pc - codePtr->codeStart);
	}
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = opnd;
	iPtr->ensembleRewrite.numInsertedObjs = 1;

	pc += 6;
	TEBC_YIELD();

	TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
	TclSkipTailcall(interp);
	return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
	
    /*
     * -----------------------------------------------------------------
     *	   Start of INST_LOAD instructions.
     *
     * WARNING: more 'goto' here than your doctor recommended! The different
     * instructions set the value of some variables and then jump to some
     * common execution code.

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


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

	checkInterp = 1;
	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:

	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);

	checkInterp = 1;
	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 {

	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);

	    checkInterp = 1;
	    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)) {

	    TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
		    TCL_TRACE_READS, 0, opnd);

	    checkInterp = 1;
	    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))) {

		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
			TCL_TRACE_READS, 0, opnd);

		checkInterp = 1;
	    }
	    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))) {

		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
			TCL_TRACE_READS, 0, -1);

		checkInterp = 1;
	    }
	    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:

	if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
		opnd) != TCL_OK && flags) {
	    goto errorInUnset;
	}
	checkInterp = 1;
	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:

	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;
	}
	checkInterp = 1;
	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:

	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
		&& (flags & TCL_LEAVE_ERR_MSG)) {
	    goto errorInUnset;
	}
	checkInterp = 1;
	NEXT_INST_V(2, cleanup, 0);

    errorInUnset:
	checkInterp = 1;
	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 {

	    TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);

	    checkInterp = 1;
	}
	NEXT_INST_F(5, 0, 0);
    }

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

	part1Ptr = OBJ_AT_TOS;
	TRACE(("\"%.30s\" => ", O2S(part1Ptr)));
	varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
		/*createPart1*/0, /*createPart2*/0, &arrayPtr);
    doArrayExists:
	if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
		&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {

	    result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
		    NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
		    TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);

	    if (result == TCL_ERROR) {
		TRACE_APPEND(("ERROR: %.30s\n",
			O2S(Tcl_GetObjResult(interp))));
		goto gotError;
	    }
	}
	if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {

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

	    IllegalExprOperandType(interp, pc, valuePtr);

	    checkInterp = 1;	    
	    goto gotError;
	}

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

	    IllegalExprOperandType(interp, pc, value2Ptr);

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

	    IllegalExprOperandType(interp, pc, valuePtr);

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

	    IllegalExprOperandType(interp, pc, value2Ptr);

	    checkInterp = 1;
	    goto gotError;
	}

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

		}

	    case INST_RSHIFT:
		if (l2 < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#if 0

		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    checkInterp = 1;
#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_SetObjResult(interp, Tcl_NewStringObj(
			    "negative shift argument", -1));
#if 0

		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
			    "domain error: argument not in valid range",
			    NULL);
		    checkInterp = 1;
#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_SetObjResult(interp, Tcl_NewStringObj(
			    "integer value too large to represent", -1));
#if 0

		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
			    "integer value too large to represent", NULL);

		    checkInterp = 1;
#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")));

	    IllegalExprOperandType(interp, pc, valuePtr);

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

	    IllegalExprOperandType(interp, pc, value2Ptr);

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

	    IllegalExprOperandType(interp, pc, valuePtr);

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

	    IllegalExprOperandType(interp, pc, valuePtr);

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

	    IllegalExprOperandType(interp, pc, valuePtr);

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

		IllegalExprOperandType(interp, pc, valuePtr);

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

		IllegalExprOperandType(interp, pc, valuePtr);

		checkInterp = 1;
	    } else {
		/*
		 * Numeric conversion of NaN -> error.
		 */

		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
			O2S(objResultPtr)));

		TclExprFloatError(interp, *((const double *) ptr1));

		checkInterp = 1;
	    }
	    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:
	/*

	Tcl_ResetResult(interp);

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

    case INST_CONTINUE:
	/*

	Tcl_ResetResult(interp);

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

    {
	ForeachInfo *infoPtr;

			    if (value2Ptr != NULL) {
				TclDecrRefCount(value2Ptr);
			    }
			    varPtr->value.objPtr = valuePtr;
			    Tcl_IncrRefCount(valuePtr);
			}
		    } else {

			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){

			    checkInterp = 1;
			    TRACE_WITH_OBJ((
				    "%u => ERROR init. index temp %d: ",
				    opnd,varIndex), Tcl_GetObjResult(interp));
			    TclDecrRefCount(listPtr);
			    goto gotError;
			}
			checkInterp = 1;
		    }
		    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.
	 */

	catchStack[++catchDepth] = INT2PTR(CURR_DEPTH);
	TRACE(("%u => catchDepth=%d, stackTop=%d\n",
		TclGetUInt4AtPtr(pc+1), (int) (catchDepth),
		(int) CURR_DEPTH));
	NEXT_INST_F(5, 0, 0);

    case INST_END_CATCH:
	catchDepth--;

	Tcl_ResetResult(interp);

	checkInterp = 1;
	result = TCL_OK;
	TRACE(("=> catchDepth=%d\n", (int) (catchDepth)));
	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:

	objResultPtr = Tcl_GetReturnOptions(interp, result);

	checkInterp = 1;
	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) {

		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_V(5, opnd+1, 1);
	    }
	    if (objResultPtr) {
		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_V(5, opnd+1, 1);
	    }

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "key \"%s\" not known in dictionary",
		    TclGetString(OBJ_AT_TOS)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		    TclGetString(OBJ_AT_TOS), NULL);
	    checkInterp = 1;
	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
	} else {
	    if (*pc == INST_DICT_EXISTS) {
	    dictNotExists:
		objResultPtr = TCONST(0);
		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
		NEXT_INST_V(5, opnd+1, 1);

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

	    dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);

	    checkInterp = 1;
	}
	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);

	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);

	    checkInterp = 1;
	    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 {

	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);

	    checkInterp = 1;
	}
	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);

	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);

	    checkInterp = 1;
	    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 {

	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
		    TCL_LEAVE_ERR_MSG, opnd);

	    checkInterp = 1;
	    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;
	    }

	    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) {
		checkInterp = 1;
		goto gotError;
	    }
	    checkInterp = 1;
	}
	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 {

	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);

	    checkInterp = 1;
	}
	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 {

		valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
			duiPtr->varIndices[i]);

		checkInterp = 1;
	    }
	    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 {

	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);

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

	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
	if (varPtr == NULL) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    TclDecrRefCount(keysPtr);
	    goto gotError;
	}

	result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
		objc, objv, keysPtr);

	TclDecrRefCount(keysPtr);
	if (result != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(1, 2, 0);

	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}

	result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
		objc, objv, keysPtr);

	if (result != TCL_OK) {
	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
	    goto gotError;
	}
	TRACE_APPEND(("OK\n"));
	NEXT_INST_F(5, 2, 0);
    }

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

    divideByZero:

	Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);

	checkInterp = 1;	
	goto gotError;

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

    exponOfZero:


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

	checkInterp = 1;

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

	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? length : 0, pcBeg, tosPtr);

	    checkInterp = 1;
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

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

	while (auxObjList) {
	    if ((catchDepth >=0) && (PTR2INT(catchStack[catchDepth]) >

		        PTR2INT(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 (catchDepth == -1) {
#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 > PTR2INT(catchStack[catchDepth])) {
	    valuePtr = POP_OBJECT();
	    TclDecrRefCount(valuePtr);
	}
#ifdef TCL_COMPILE_DEBUG
	if (traceInstructions) {
	    fprintf(stdout, "  ... found catch at %d, catchDepth=%d, "
		    "unwound to %ld, new pc %u\n",
		    rangePtr->codeOffset, (int) catchDepth,
		    PTR2INT(catchStack[catchDepth]), (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);
    }
    ckfree(TD);	/* free my stack */

    return result;

    /*
     * INST_START_CMD failure case removed where it doesn't bother that much
     *
     * Remark that if the interpreter is marked for deletion its

	    goto instEvalStk;
	}
}

#undef codePtr
#undef iPtr
#undef bcFramePtr

#undef initTosPtr
#undef auxObjList
#undef catchDepth
#undef TCONST

/*
 *----------------------------------------------------------------------
 *
 * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
 *

	 * Use objStrings as a list object.
	 */

	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
	    goto end;
	}
	attributeStringsAllocated = (const char **)
		ckalloc((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;
    } else if (objStrings != NULL) {

    /*
     * Free up the array we allocated and drop our reference to any list of
     * attribute names issued by the filesystem.
     */

  end:
    if (attributeStringsAllocated != NULL) {
	ckfree((void *) attributeStringsAllocated);
    }
    if (objStrings != NULL) {
	Tcl_DecrRefCount(objStrings);
    }
    return result;
}


	 * platform.
	 */

	Tcl_ListObjLength(interp, typePtr, &length);
	if (length <= 0) {
	    goto skipTypes;
	}
	globTypes = ckalloc(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);
	}
	ckfree(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 = ckalloc((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.
     */

    ckfree((void *) argv);

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

    if (background) {
	/*