development branch for allocator changes

40 files changed, 1519 insertions, 2662 deletions

diff --git a/README.mig-alloc-reform b/README.mig-alloc-reform
new file mode 100644
index 0000000..139af2e
--- /dev/null
+++ b/README.mig-alloc-reform
@@ -0,0 +1,65 @@
+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 improvement in zippy's memory usage: try to split blocks in
+        the shared cache before allocating new ones from the system
+
+  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 **
+   * 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 
+
+
+** 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
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 6fff92b..782a12b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -1,253 +1,428 @@
 /*
  * tclAlloc.c --
  *
- *	This is a very fast storage allocator. It allocates blocks of a small
- *	number of different sizes, and keeps free lists of each size. Blocks
- *	that don't exactly fit are passed up to the next larger size. Blocks
- *	over a certain size are directly allocated from the system.
+ *      This is a very flexible storage allocator for Tcl, for use with or
+ *      without threads. Depending on the compile flags, it builds as:
  *
- * Copyright (c) 1983 Regents of the University of California.
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ *      (1) Build flags: TCL_ALLOC_NATIVE
+ *          NATIVE: use the native malloc and a per-thread Tcl_Obj pool, with 
+ *          inter-thread recycling of objects. The per-thread pool can be
+ *          disabled at startup with an env var, thus providing the PURIFY
+ *          behaviour that is useful for valgrind and similar tools. Note that
+ *          the PURIFY costs are negligible when disabled, but when enabled
+ *          Tcl_Obj allocs will be even slower than in a full PURIFY build
+ *          NOTE: the obj pool shares all code with zippy's smallest allocs!
+ *                It does look overcomplicated for this particular case, but
+ *                keeping them together allows simpler maintenance and avoids
+ *                the need for separate debugging
+ *          TODO: in this case build ZIPPY as a preloadable malloc-replacement           
  *
- * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
+ *      (2) Build flags: TCL_ALLOC_ZIPPY
+ *          ZIPPY: use the ex-tclThreadAlloc, essentially aolserver's
+ *          fast threaded allocator. Mods with respect to the original:
+ *            - change in the block sizes, so that the smallest alloc is
+ *              Tcl_Obj-sized
+ *            - share the Tcl_Obj pool with the smallest allocs pool for
+ *              improved cache usage
+ *            - split blocks in the shared pool before mallocing again for
+ *              improved cache usage
+ *            - ?change in the number of blocks to move to/from the shared
+ *              cache: it used to be a fixed number, it is now computed
+ *              to leave a fixed number in the thread's pool. This improves
+ *              sharing behaviour when one thread uses a lot of memory once
+ *              and rarely again (eg, at startup), at the cost of slowing
+ *              slightly threads that allocate/free large numbers of blocks
+ *              repeatedly
+ *            - stats and Tcl_GetMemoryInfo disabled per default, enable with
+ *              -DZIPPY_STATS
+ *            - adapt for unthreaded usage as replacement of the ex tclAlloc
+ *            - -DHAVE_FAST_TSD: use fast TSD via __thread where available
+ *            - (TODO!) build zippy as a pre-loadable library to use with a
+ *              native build as a malloc replacement. Difficulties are:
+ *                  (a) make that portable (easy enough on modern elf/unix, to
+ *                      be researched on win and mac)
+ *                  (b) coordinate the Tcl_Obj pool and the smallest allocs,
+ *                      as they are now addressed from different files. This
+ *                      might require a special Tcl build with no
+ *                      TclSmallAlloc, and a separate preloadable for use with
+ *                      native builds? Or else separate them again, but that's
+ *                      not really good I think.
+ *
+ *               NOTES:
+ *                  . this would be the best option, instead of MULTI. It
+ *                    could be built in two versions (perf, debug/stats)
+ *                  . would a preloaded zippy be slower than builtin?
+ *                    Possibly, due to extra indirection.
+ *
+ *      (3) Build flags: TCL_ALLOC_MULTI
+ *          MULTI: all of the above, selectable at startup with an env
+ *          var. This build will be very slightly slower than the specific
+ *          builds above, but is completely portable: it does not depend on
+ *          any help from the loader or such.
+ *
+ * All variants can be built for both threaded and unthreaded Tcl.
+ *
+ * The Initial Developer of the Original Code is America Online, Inc.
+ * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
+ *
+ * Copyright (c) 2008-2011 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.
  */
 
-/*
- * Windows and Unix use an alternative allocator when building with threads
- * that has significantly reduced lock contention.
- */
-
 #include "tclInt.h"
-#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
 
-#if USE_TCLALLOC
+/*
+ * This macro is used to properly align the memory allocated by Tcl, giving
+ * the same alignment as the native malloc.
+ */
 
-#ifdef TCL_DEBUG
-#   define DEBUG
-/* #define MSTATS */
-#   define RCHECK
+#if defined(__APPLE__)
+#define TCL_ALLOCALIGN	16
+#else
+#define TCL_ALLOCALIGN	(2*sizeof(void *))
 #endif
 
+#undef TclpAlloc
+#undef TclpRealloc
+#undef TclpFree
+#undef TclSmallAlloc
+#undef TclSmallFree
+
+#if (TCL_ALLOCATOR == aNATIVE) || (TCL_ALLOCATOR == aPURIFY)
 /*
- * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
- * until Tcl uses config.h properly.
+ * Not much of this file is needed, most things are dealt with in the
+ * macros. Just shunt the allocators for use by the library, the core
+ * never calls this.
+ *
+ * This is all that is needed for a TCL_ALLOC_PURIFY build, a native build
+ * needs the Tcl_Obj pools too.
  */
+   
+char *
+TclpAlloc(
+    unsigned int reqSize)
+{
+    return malloc(reqSize);
+}
 
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
-typedef unsigned long caddr_t;
-#endif
+char *
+TclpRealloc(  
+    char *ptr,
+    unsigned int reqSize)
+{
+    return realloc(ptr, reqSize);
+}
+
+void
+TclpFree(
+    char *ptr)
+{
+    free(ptr);
+}
+
+#endif /* end of common code for PURIFY and NATIVE*/
+
+#if TCL_ALLOCATOR != aPURIFY
+/*
+ * The rest of this file deals with ZIPPY and MULTI builds, as well as the
+ * Tcl_Obj pools for NATIVE
+ */
 
 /*
- * The overhead on a block is at least 8 bytes. When free, this space contains
- * a pointer to the next free block, and the bottom two bits must be zero.
- * When in use, the first byte is set to MAGIC, and the second byte is the
- * size index. The remaining bytes are for alignment. If range checking is
- * enabled then a second word holds the size of the requested block, less 1,
- * rounded up to a multiple of sizeof(RMAGIC). The order of elements is
- * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic
- * can not be a valid ov.next bit pattern.
+ * Note: we rely on the optimizer to remove unneeded code, instead of setting
+ * up a maze of #ifdefs all over the code.
+ * We should insure that debug builds do at least this much optimization, right?
  */
 
-union overhead {
-    union overhead *next;		/* when free */
-    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */
-    struct {
-	unsigned char magic0;		/* magic number */
-	unsigned char index;		/* bucket # */
-	unsigned char unused;		/* unused */
-	unsigned char magic1;		/* other magic number */
-#ifdef RCHECK
-	unsigned short rmagic;		/* range magic number */
-	unsigned long size;		/* actual block size */
-	unsigned short unused2;		/* padding to 8-byte align */
-#endif
-    } ovu;
-#define overMagic0	ovu.magic0
-#define overMagic1	ovu.magic1
-#define bucketIndex	ovu.index
-#define rangeCheckMagic	ovu.rmagic
-#define realBlockSize	ovu.size
-};
-
-
-#define MAGIC		0xef	/* magic # on accounting info */
-#define RMAGIC		0x5555	/* magic # on range info */
-
-#ifdef RCHECK
-#define	RSLOP		sizeof(unsigned short)
+#if TCL_ALLOCATOR == aZIPPY
+#   define allocator aZIPPY
+#   define ALLOCATOR_BASE aZIPPY
+#elif TCL_ALLOCATOR == aNATIVE
+/* Keep the option to switch PURIFY mode on! */
+static int allocator = aNONE;
+#   define ALLOCATOR_BASE aNATIVE
+#   define RCHECK 0
+#   undef ZIPPY_STATS
 #else
-#define	RSLOP		0
+/* MULTI */
+    static int allocator = aNONE;
+#   define ALLOCATOR_BASE aZIPPY
+#endif
+
+#if TCL_ALLOCATOR != aZIPPY
+static void ChooseAllocator();
 #endif
 
-#define OVERHEAD (sizeof(union overhead) + RSLOP)
 
 /*
- * Macro to make it easier to refer to the end-of-block guard magic.
+ * If range checking is enabled, an additional byte will be allocated to store
+ * the magic number at the end of the requested memory.
  */
 
-#define BLOCK_END(overPtr) \
-    (*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize))
+#ifndef RCHECK
+#  ifdef  NDEBUG
+#    define RCHECK		0
+#  else
+#    define RCHECK		1
+#  endif
+#endif
 
 /*
- * nextf[i] is the pointer to the next free block of size 2^(i+3). The
- * smallest allocatable block is MINBLOCK bytes. The overhead information
- * precedes the data area returned to the user.
+ * The following struct 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.
  */
 
-#define MINBLOCK	((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
-#define NBUCKETS	(13 - (MINBLOCK >> 4))
-#define MAXMALLOC	(1<<(NBUCKETS+2))
-static union overhead *nextf[NBUCKETS];
+typedef struct Block {
+    union {
+	struct 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. */
+} Block;
+
+#define ALIGN(x)    (((x) + TCL_ALLOCALIGN - 1) & ~(TCL_ALLOCALIGN - 1))
+#define OFFSET      ALIGN(sizeof(Block))
+
+#define nextBlock	u.next
+#define sourceBucket	u.s.bucket
+#define magicNum1	u.s.magic1
+#define magicNum2	u.s.magic2
+#define MAGIC		0xEF
+#define blockReqSize	reqSize
 
 /*
- * The following structure is used to keep track of all system memory
- * currently owned by Tcl. When finalizing, all this memory will be returned
- * to the system.
+ * The following defines the minimum and maximum block sizes and the number
+ * of buckets in the bucket cache.
+ *                        32b    64b    Apple-32b
+ *     TCL_ALLOCALIGN       8     16       16
+ *     sizeof(Block)        8     16       16
+ *     OFFSET               8     16       16
+ *     sizeof(Tcl_Obj)     24     48       24
+ *     ALLOCBASE           24     48       24
+ *     MINALLOC            24     48       24
+ *     NBUCKETS            11     10       11
+ *     MAXALLOC         24576  24576    24576
+ *     small allocs      1024    512     1024
+ *        at a time
  */
 
-struct block {
-    struct block *nextPtr;	/* Linked list. */
-    struct block *prevPtr;	/* Linked list for big blocks, ensures 8-byte
-				 * alignment for suballocated blocks. */
-};
+#if TCL_ALLOCATOR == aNATIVE
+#define MINALLOC    MAX(OFFSET, sizeof(Tcl_Obj))
+#else
+#define MINALLOC    ALIGN(MAX(OFFSET+8, sizeof(Tcl_Obj)))
+#endif
 
-static struct block *blockList;	/* Tracks the suballocated blocks. */
-static struct block bigBlocks={	/* Big blocks aren't suballocated. */
-    &bigBlocks, &bigBlocks
-};
+#define NBUCKETS    10 /* previously (11 - (MINALLOC >> 5)) */
+#define MAXALLOC    (MINALLOC << (NBUCKETS - 1))
+
+#if TCL_ALLOCATOR == aNATIVE
+#  define NBUCKETS_0 1
+#  define nBuckets   1
+#else
+#  define NBUCKETS_0 NBUCKETS
+#  if TCL_ALLOCATOR == aZIPPY
+#    define nBuckets NBUCKETS
+#  else
+     static int nBuckets = NBUCKETS;
+#  endif
+#endif
 
 /*
- * The allocator is protected by a special mutex that must be explicitly
- * initialized. Futhermore, because Tcl_Alloc may be used before anything else
- * in Tcl, we make this module self-initializing after all with the allocInit
- * variable.
+ * The following structure defines a bucket of blocks, optionally with various
+ * accounting and statistics information.
  */
 
-#ifdef TCL_THREADS
-static Tcl_Mutex *allocMutexPtr;
+typedef struct Bucket {
+    Block *firstPtr;		/* First block available */
+    long numFree;		/* Number of blocks available */
+#ifdef ZIPPY_STATS
+    /* All fields below for accounting only */
+
+    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
-static int allocInit = 0;
-
-#ifdef MSTATS
+} Bucket;
 
 /*
- * numMallocs[i] is the difference between the number of mallocs and frees for
- * a given block size.
+ * The following structure defines a cache of buckets, at most one per
+ * thread. 
  */
 
-static	unsigned int numMallocs[NBUCKETS+1];
+typedef struct Cache {
+#if defined(TCL_THREADS)
+    struct Cache *nextPtr;	/* Linked list of cache entries */
+#ifdef ZIPPY_STATS
+    Tcl_ThreadId owner;		/* Which thread's cache is this? */
 #endif
-
-#if defined(DEBUG) || defined(RCHECK)
-#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)
-#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
-#else
-#define	ASSERT(p)
-#define RANGE_ASSERT(p)
 #endif
+#ifdef ZIPPY_STATS
+    int totalAssigned;		/* Total space assigned to thread */
+#endif
+    Bucket buckets[1];	        /* The buckets for this thread */
+} Cache;
+
 
 /*
- * Prototypes for functions used only in this file.
+ * The following array specifies various per-bucket limits and locks. The
+ * values are statically initialized to avoid calculating them repeatedly.
  */
 
-static void		MoreCore(int bucket);
-
+static struct {
+    size_t blockSize;		/* Bucket blocksize. */
+#if defined(TCL_THREADS)
+    int maxBlocks;		/* Max blocks before move to share. */
+    int numMove;		/* Num blocks to move to share. */
+    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
+#endif
+} bucketInfo[NBUCKETS_0];
+
 /*
- *-------------------------------------------------------------------------
- *
- * TclInitAlloc --
- *
- *	Initialize the memory system.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Initialize the mutex used to serialize allocations.
- *
- *-------------------------------------------------------------------------
+ * Static functions defined in this file.
  */
 
-void
-TclInitAlloc(void)
-{
-    if (!allocInit) {
-	allocInit = 1;
-#ifdef TCL_THREADS
-	allocMutexPtr = Tcl_GetAllocMutex();
+static Cache *	GetCache(void);
+static int	GetBlocks(Cache *cachePtr, int bucket);
+static inline Block *	Ptr2Block(char *ptr);
+static inline char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
+
+#if defined(TCL_THREADS)
+
+static Cache *firstCachePtr = NULL;
+static Cache *sharedPtr = NULL;
+
+static Tcl_Mutex *listLockPtr;
+static Tcl_Mutex *objLockPtr;
+
+static void	LockBucket(Cache *cachePtr, int bucket);
+static void	UnlockBucket(Cache *cachePtr, int bucket);
+static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
+
+#if defined(HAVE_FAST_TSD)
+static __thread Cache *tcachePtr;
+static __thread int allocInitialized = 0;
+
+# define GETCACHE(cachePtr)			\
+    do {					\
+	if (!allocInitialized) {		\
+	    allocInitialized = 1;		\
+	    tcachePtr = GetCache();				\
+	}					\
+	(cachePtr) = tcachePtr;			\
+    } while (0)
+#else
+# define GETCACHE(cachePtr)			\
+    do {					\
+	(cachePtr) = TclpGetAllocCache();	\
+	if ((cachePtr) == NULL) {		\
+	    (cachePtr) = GetCache();		\
+	}					\
+    } while (0)
 #endif
+#else /* NOT THREADS! */
+
+static int allocInitialized = 0;
+
+#define TclpSetAllocCache()
+#define PutBlocks(cachePtr, bucket, numMove) 
+#define firstCachePtr sharedCachePtr
+
+# define GETCACHE(cachePtr)			\
+    do {					\
+	if (!allocInitialized) {		\
+	    allocInitialized = 1;		\
+	    GetCache();				\
+	}					\
+	(cachePtr) = sharedPtr;		\
+    } while (0)
+
+static void *
+TclpGetAllocCache(void)
+{
+    if (!allocInitialized) {
+	allocInitialized = 1;
+	GetCache();
     }
+    return sharedPtr;
 }
+#endif
+
 
 /*
- *-------------------------------------------------------------------------
- *
- * TclFinalizeAllocSubsystem --
+ *----------------------------------------------------------------------
  *
- *	Release all resources being used by this subsystem, including
- *	aggressively freeing all memory allocated by TclpAlloc() that has not
- *	yet been released with TclpFree().
+ * Block2Ptr, Ptr2Block --
  *
- *	After this function is called, all memory allocated with TclpAlloc()
- *	should be considered unusable.
+ *	Convert between internal blocks and user pointers.
  *
  * Results:
- *	None.
+ *	User pointer or internal block.
  *
  * Side effects:
- *	This subsystem is self-initializing, since memory can be allocated
- *	before Tcl is formally initialized. After this call, this subsystem
- *	has been reset to its initial state and is usable again.
+ *	Invalid blocks will abort the server.
  *
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-void
-TclFinalizeAllocSubsystem(void)
+static inline char *
+Block2Ptr(
+    Block *blockPtr,
+    int bucket,
+    unsigned int reqSize)
 {
-    unsigned int i;
-    struct block *blockPtr, *nextPtr;
+    register void *ptr;
+
+    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
+    blockPtr->sourceBucket = bucket;
+    blockPtr->blockReqSize = reqSize;
+    ptr = (void *) (((char *)blockPtr) + OFFSET);
+#if RCHECK
+    ((unsigned char *)(ptr))[reqSize] = MAGIC;
+#endif
+    return (char *) ptr;
+}
 
-    Tcl_MutexLock(allocMutexPtr);
-    for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
-	nextPtr = blockPtr->nextPtr;
-	TclpSysFree(blockPtr);
-    }
-    blockList = NULL;
+static inline Block *
+Ptr2Block(
+    char *ptr)
+{
+    register Block *blockPtr;
 
-    for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) {
-	nextPtr = blockPtr->nextPtr;
-	TclpSysFree(blockPtr);
-	blockPtr = nextPtr;
+    blockPtr = (Block *) (((char *) ptr) - OFFSET);
+    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
+	Tcl_Panic("alloc: invalid block: %p: %x %x",
+		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
     }
-    bigBlocks.nextPtr = &bigBlocks;
-    bigBlocks.prevPtr = &bigBlocks;
-
-    for (i=0 ; i<NBUCKETS ; i++) {
-	nextf[i] = NULL;
-#ifdef MSTATS
-	numMallocs[i] = 0;
-#endif
+#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]);
     }
-#ifdef MSTATS
-    numMallocs[i] = 0;
 #endif
-    Tcl_MutexUnlock(allocMutexPtr);
+    return blockPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpAlloc --
+ * GetCache ---
  *
- *	Allocate more memory.
+ *	Gets per-thread memory cache, allocating it if necessary.
  *
  * Results:
- *	None.
+ *	Pointer to cache.
  *
  * Side effects:
  *	None.
@@ -255,183 +430,237 @@ TclFinalizeAllocSubsystem(void)
  *----------------------------------------------------------------------
  */
 
-char *
-TclpAlloc(
-    unsigned int numBytes)	/* Number of bytes to allocate. */
+static Cache *
+GetCache(void)
 {
-    register union overhead *overPtr;
-    register long bucket;
-    register unsigned amount;
-    struct block *bigBlockPtr = NULL;
-
-    if (!allocInit) {
-	/*
-	 * We have to make the "self initializing" because Tcl_Alloc may be
-	 * used before any other part of Tcl. E.g., see main() for tclsh!
+    Cache *cachePtr;
+    unsigned int i;
+#if TCL_ALLOCATOR == aZIPPY
+#define allocSize (sizeof(Cache) + (NBUCKETS -1)*sizeof(Bucket))
+#elif TCL_ALLOCATOR == aNATIVE
+#define allocSize sizeof(Cache)
+#else
+    unsigned int allocSize;
+#endif
+    
+    /*
+     * Set the params for the correct allocator
+     */
+    
+#if TCL_ALLOCATOR != aZIPPY
+    if (allocator == aNONE) {
+	/* This insures that it is set just once, as any changes after
+	 * initialization guarantee a hard crash
 	 */
+	
+	ChooseAllocator();
+    }
 
-	TclInitAlloc();
+#if TCL_ALLOCATOR == aMULTI
+    if (allocator == aZIPPY) {
+	allocSize = (sizeof(Cache) + (NBUCKETS -1)*sizeof(Bucket));
+	nBuckets = NBUCKETS;
+    } else {
+	allocSize = sizeof(Cache);
+	nBuckets = 1;
     }
-    Tcl_MutexLock(allocMutexPtr);
+#endif
+#endif
 
     /*
-     * First the simple case: we simple allocate big blocks directly.
+     * Check for first-time initialization.
      */
 
-    if (numBytes >= MAXMALLOC - OVERHEAD) {
-	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
-	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
-		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
-	}
-	if (bigBlockPtr == NULL) {
-	    Tcl_MutexUnlock(allocMutexPtr);
-	    return NULL;
-	}
-	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
-	bigBlocks.nextPtr = bigBlockPtr;
-	bigBlockPtr->prevPtr = &bigBlocks;
-	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
-
-	overPtr = (union overhead *) (bigBlockPtr + 1);
-	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
-	overPtr->bucketIndex = 0xff;
-#ifdef MSTATS
-	numMallocs[NBUCKETS]++;
+#if defined(TCL_THREADS)
+    if (listLockPtr == NULL) {
+	Tcl_Mutex *initLockPtr;
+	initLockPtr = Tcl_GetAllocMutex();
+	Tcl_MutexLock(initLockPtr);
+	if (listLockPtr == NULL) {
+	    listLockPtr = TclpNewAllocMutex();
+	    objLockPtr = TclpNewAllocMutex();
 #endif
-
-#ifdef RCHECK
-	/*
-	 * Record allocated size of block and bound space with magic numbers.
-	 */
-
-	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-	overPtr->rangeCheckMagic = RMAGIC;
-	BLOCK_END(overPtr) = RMAGIC;
+	    for (i = 0; i < nBuckets; ++i) {
+		bucketInfo[i].blockSize = MINALLOC << i;
+#if defined(TCL_THREADS)
+		/* TODO: clearer logic? Change move to keep? */
+		bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
+		bucketInfo[i].numMove = i < NBUCKETS - 1 ?
+			1 << (NBUCKETS - 2 - i) : 1;
+		bucketInfo[i].lockPtr = TclpNewAllocMutex();
 #endif
-
-	Tcl_MutexUnlock(allocMutexPtr);
-	return (void *)(overPtr+1);
+	    }
+#if defined(TCL_THREADS)
+	    sharedPtr = calloc(1, allocSize);
+	    firstCachePtr = sharedPtr;
+	}
+	Tcl_MutexUnlock(initLockPtr);
     }
+#endif
 
+    if (allocator == aPURIFY) {
+	bucketInfo[0].maxBlocks = 0;
+    }
+    
     /*
-     * Convert amount of memory requested into closest block size stored in
-     * hash buckets which satisfies request. Account for space used per block
-     * for accounting.
+     * Get this thread's cache, allocating if necessary.
      */
 
-    amount = MINBLOCK;		/* size of first bucket */
-    bucket = MINBLOCK >> 4;
-
-    while (numBytes + OVERHEAD > amount) {
-	amount <<= 1;
-	if (amount == 0) {
-	    Tcl_MutexUnlock(allocMutexPtr);
-	    return NULL;
+    cachePtr = TclpGetAllocCache();
+    if (cachePtr == NULL) {
+	cachePtr = calloc(1, allocSize);
+	if (cachePtr == NULL) {
+	    Tcl_Panic("alloc: could not allocate new cache");
 	}
-	bucket++;
+#if defined(TCL_THREADS)
+	Tcl_MutexLock(listLockPtr);
+	cachePtr->nextPtr = firstCachePtr;
+	firstCachePtr = cachePtr;
+	Tcl_MutexUnlock(listLockPtr);
+#ifdef ZIPPY_STATS
+	cachePtr->owner = Tcl_GetCurrentThread();
+#endif
+	TclpSetAllocCache(cachePtr);
+#endif
     }
-    ASSERT(bucket < NBUCKETS);
+    return cachePtr;
+}
+
+#if defined(TCL_THREADS)
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFreeAllocCache --
+ *
+ *	Flush and delete a cache, removing from list of caches.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFreeAllocCache(
+    void *arg)
+{
+    Cache *cachePtr = arg;
+    Cache **nextPtrPtr;
+    register unsigned int bucket;
 
     /*
-     * If nothing in hash bucket right now, request more memory from the
-     * system.
+     * Flush blocks.
      */
 
-    if ((overPtr = nextf[bucket]) == NULL) {
-	MoreCore(bucket);
-	if ((overPtr = nextf[bucket]) == NULL) {
-	    Tcl_MutexUnlock(allocMutexPtr);
-	    return NULL;
+    for (bucket = 0; bucket < nBuckets; ++bucket) {
+	if (cachePtr->buckets[bucket].numFree > 0) {
+	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
 	}
     }
 
     /*
-     * Remove from linked list
+     * Remove from pool list.
      */
 
-    nextf[bucket] = overPtr->next;
-    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
-    overPtr->bucketIndex = (unsigned char) bucket;
-
-#ifdef MSTATS
-    numMallocs[bucket]++;
-#endif
-
-#ifdef RCHECK
-    /*
-     * Record allocated size of block and bound space with magic numbers.
-     */
-
-    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-    overPtr->rangeCheckMagic = RMAGIC;
-    BLOCK_END(overPtr) = RMAGIC;
-#endif
-
-    Tcl_MutexUnlock(allocMutexPtr);
-    return ((char *)(overPtr + 1));
+    Tcl_MutexLock(listLockPtr);
+    nextPtrPtr = &firstCachePtr;
+    while (*nextPtrPtr != cachePtr) {
+	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
+    }
+    *nextPtrPtr = cachePtr->nextPtr;
+    cachePtr->nextPtr = NULL;
+    Tcl_MutexUnlock(listLockPtr);
+    free(cachePtr);
 }
+#endif
 
+#if TCL_ALLOCATOR != aNATIVE
 /*
  *----------------------------------------------------------------------
  *
- * MoreCore --
- *
- *	Allocate more memory to the indicated bucket.
+ * TclpAlloc --
  *
- *	Assumes Mutex is already held.
+ *	Allocate memory.
  *
  * Results:
- *	None.
+ *	Pointer to memory just beyond Block pointer.
  *
  * Side effects:
- *	Attempts to get more memory from the system.
+ *	May allocate more blocks for a bucket.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-MoreCore(
-    int bucket)			/* What bucket to allocat to. */
+char *
+TclpAlloc(
+    unsigned int reqSize)
 {
-    register union overhead *overPtr;
-    register long size;		/* size of desired block */
-    long amount;		/* amount to allocate */
-    int numBlocks;		/* how many blocks we get */
-    struct block *blockPtr;
-
-    /*
-     * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
-     * VAX, I think) or for a negative arg.
-     */
+    Cache *cachePtr;
+    Block *blockPtr;
+    register int bucket;
+    size_t size;
 
-    size = 1 << (bucket + 3);
-    ASSERT(size > 0);
+    if (allocator < aNONE) {
+	return (void *) malloc(reqSize);
+    }
+    
+    GETCACHE(cachePtr);
 
-    amount = MAXMALLOC;
-    numBlocks = amount / size;
-    ASSERT(numBlocks*size == amount);
+#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;
 
-    blockPtr = (struct block *) TclpSysAlloc((unsigned)
-	    (sizeof(struct block) + amount), 1);
-    /* no more room! */
-    if (blockPtr == NULL) {
-	return;
+	if (((size_t) reqSize) > max - OFFSET - RCHECK) {
+	    /* Requested allocation exceeds memory */
+	    return NULL;
+	}
     }
-    blockPtr->nextPtr = blockList;
-    blockList = blockPtr;
-
-    overPtr = (union overhead *) (blockPtr + 1);
+#endif
 
     /*
-     * Add new memory allocated to that on free list for this hash bucket.
+     * 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.
      */
 
-    nextf[bucket] = overPtr;
-    while (--numBlocks > 0) {
-	overPtr->next = (union overhead *)((caddr_t)overPtr + size);
-	overPtr = (union overhead *)((caddr_t)overPtr + size);
+    blockPtr = NULL;
+    size = reqSize + OFFSET;
+#if RCHECK
+    size++;
+#endif
+    if (size > MAXALLOC) {
+	bucket = nBuckets;
+	blockPtr = malloc(size);
+#ifdef ZIPPY_STATS
+	if (blockPtr != NULL) {
+	    cachePtr->totalAssigned += reqSize;
+	}
+#endif
+    } 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;
+	    cachePtr->buckets[bucket].numFree--;
+#ifdef ZIPPY_STATS
+	    cachePtr->buckets[bucket].numRemoves++;
+	    cachePtr->buckets[bucket].totalAssigned += reqSize;
+#endif
+	}
+    }
+    if (blockPtr == NULL) {
+	return NULL;
     }
-    overPtr->next = NULL;
+    return Block2Ptr(blockPtr, bucket, reqSize);
 }
 
 /*
@@ -439,64 +668,66 @@ MoreCore(
  *
  * TclpFree --
  *
- *	Free memory.
+ *	Return blocks to the thread block cache.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	None.
+ *	May move blocks to shared cache.
  *
  *----------------------------------------------------------------------
  */
 
 void
 TclpFree(
-    char *oldPtr)		/* Pointer to memory to free. */
+    char *ptr)
 {
-    register long size;
-    register union overhead *overPtr;
-    struct block *bigBlockPtr;
+    Cache *cachePtr;
+    Block *blockPtr;
+    int bucket;
 
-    if (oldPtr == NULL) {
-	return;
+    if (allocator < aNONE) {
+	return free((char *) ptr);
     }
 
-    Tcl_MutexLock(allocMutexPtr);
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
+    GETCACHE(cachePtr);
 
-    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
-    ASSERT(overPtr->overMagic1 == MAGIC);
-    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
-	Tcl_MutexUnlock(allocMutexPtr);
+    if (ptr == NULL) {
 	return;
     }
 
-    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
-    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
-    size = overPtr->bucketIndex;
-    if (size == 0xff) {
-#ifdef MSTATS
-	numMallocs[NBUCKETS]--;
-#endif
-
-	bigBlockPtr = (struct block *) overPtr - 1;
-	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
-	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
-	TclpSysFree(bigBlockPtr);
+    /*
+     * 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.
+     */
 
-	Tcl_MutexUnlock(allocMutexPtr);
+    blockPtr = Ptr2Block(ptr);
+    bucket = blockPtr->sourceBucket;
+    if (bucket == nBuckets) {
+#ifdef ZIPPY_STATS
+	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+#endif
+	free(blockPtr);
 	return;
     }
-    ASSERT(size < NBUCKETS);
-    overPtr->next = nextf[size];	/* also clobbers overMagic */
-    nextf[size] = overPtr;
 
-#ifdef MSTATS
-    numMallocs[size]--;
+#ifdef ZIPPY_STATS
+    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+#endif
+    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
+    cachePtr->buckets[bucket].firstPtr = blockPtr;
+    cachePtr->buckets[bucket].numFree++;
+#ifdef ZIPPY_STATS
+    cachePtr->buckets[bucket].numInserts++;
+#endif
+#if defined(TCL_THREADS)
+    if (cachePtr != sharedPtr &&
+	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
+	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
+    }
 #endif
-
-    Tcl_MutexUnlock(allocMutexPtr);
 }
 
 /*
@@ -504,138 +735,308 @@ TclpFree(
  *
  * TclpRealloc --
  *
- *	Reallocate memory.
+ *	Re-allocate memory to a larger or smaller size.
  *
  * Results:
- *	None.
+ *	Pointer to memory just beyond Block pointer.
  *
  * Side effects:
- *	None.
+ *	Previous memory, if any, may be freed.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-TclpRealloc(
-    char *oldPtr,		/* Pointer to alloced block. */
-    unsigned int numBytes)	/* New size of memory. */
+TclpRealloc(  
+    char *ptr,
+    unsigned int reqSize)
 {
-    int i;
-    union overhead *overPtr;
-    struct block *bigBlockPtr;
-    int expensive;
-    unsigned long maxSize;
-
-    if (oldPtr == NULL) {
-	return TclpAlloc(numBytes);
+    Cache *cachePtr;
+    Block *blockPtr;
+    void *newPtr;
+    size_t size, min;
+    int bucket;
+
+    if (allocator < aNONE) {
+	return (void *) realloc((char *) ptr, reqSize);
     }
 
-    Tcl_MutexLock(allocMutexPtr);
-
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
+    GETCACHE(cachePtr);
 
-    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
-    ASSERT(overPtr->overMagic1 == MAGIC);
-    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
-	Tcl_MutexUnlock(allocMutexPtr);
-	return NULL;
+    if (ptr == NULL) {
+	return TclpAlloc(reqSize);
     }
 
-    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
-    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
-    i = overPtr->bucketIndex;
+#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 - OFFSET - RCHECK) {
+	    /* Requested allocation exceeds memory */
+	    return NULL;
+	}
+    }
+#endif
 
     /*
-     * If the block isn't in a bin, just realloc it.
+     * 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.
      */
 
-    if (i == 0xff) {
-	struct block *prevPtr, *nextPtr;
-	bigBlockPtr = (struct block *) overPtr - 1;
-	prevPtr = bigBlockPtr->prevPtr;
-	nextPtr = bigBlockPtr->nextPtr;
-	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
-		sizeof(struct block) + OVERHEAD + numBytes);
-	if (bigBlockPtr == NULL) {
-	    Tcl_MutexUnlock(allocMutexPtr);
+    blockPtr = Ptr2Block(ptr);
+    size = reqSize + OFFSET;
+#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) {
+#ifdef ZIPPY_STATS
+	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
+	    cachePtr->buckets[bucket].totalAssigned += reqSize;
+#endif
+	    return Block2Ptr(blockPtr, bucket, reqSize);
+	}
+    } else if (size > MAXALLOC) {
+#ifdef ZIPPY_STATS
+	cachePtr->totalAssigned -= blockPtr->blockReqSize;
+	cachePtr->totalAssigned += reqSize;
+#endif
+	blockPtr = realloc(blockPtr, size);
+	if (blockPtr == NULL) {
 	    return NULL;
 	}
+	return Block2Ptr(blockPtr, nBuckets, reqSize);
+    }
 
-	if (prevPtr->nextPtr != bigBlockPtr) {
-	    /*
-	     * If the block has moved, splice the new block into the list
-	     * where the old block used to be.
-	     */
+    /*
+     * Finally, perform an expensive malloc/copy/free.
+     */
 
-	    prevPtr->nextPtr = bigBlockPtr;
-	    nextPtr->prevPtr = bigBlockPtr;
+    newPtr = TclpAlloc(reqSize);
+    if (newPtr != NULL) {
+	if (reqSize > blockPtr->blockReqSize) {
+	    reqSize = blockPtr->blockReqSize;
 	}
+	memcpy(newPtr, ptr, reqSize);
+	TclpFree(ptr);
+    }
+    return newPtr;
+}
+#ifdef ZIPPY_STATS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetMemoryInfo --
+ *
+ *	Return a list-of-lists of memory stats.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	List appended to given dstring.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	overPtr = (union overhead *) (bigBlockPtr + 1);
-
-#ifdef MSTATS
-	numMallocs[NBUCKETS]++;
+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 defined(TCL_THREADS)
+	if (cachePtr == sharedPtr) {
+	    Tcl_DStringAppendElement(dsPtr, "shared");
+	} else {
+	    sprintf(buf, "thread%p", cachePtr->owner);
+	    Tcl_DStringAppendElement(dsPtr, buf);
+	}
+#else
+	Tcl_DStringAppendElement(dsPtr, "unthreaded");	    
 #endif
-
-#ifdef RCHECK
-	/*
-	 * Record allocated size of block and update magic number bounds.
-	 */
-
-	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-	BLOCK_END(overPtr) = RMAGIC;
+	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);
+#if defined(TCL_THREADS)
+	cachePtr = cachePtr->nextPtr;
+#else
+	cachePtr = NULL;
 #endif
-
-	Tcl_MutexUnlock(allocMutexPtr);
-	return (char *)(overPtr+1);
     }
-    maxSize = 1 << (i+3);
-    expensive = 0;
-    if (numBytes+OVERHEAD > maxSize) {
-	expensive = 1;
-    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
-	expensive = 1;
+    Tcl_MutexUnlock(listLockPtr);
+}
+#endif /* ZIPPY_STATS */
+#endif /* code above only for NATIVE allocator */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+{
+    Cache *cachePtr;
+    Block *blockPtr;
+    Bucket *bucketPtr;
+
+    GETCACHE(cachePtr);
+    bucketPtr = &cachePtr->buckets[0];
+
+    blockPtr = bucketPtr->firstPtr;
+    if (bucketPtr->numFree || GetBlocks(cachePtr, 0)) {
+        blockPtr = bucketPtr->firstPtr;
+ 	bucketPtr->firstPtr = blockPtr->nextBlock;
+ 	bucketPtr->numFree--;
+#ifdef ZIPPY_STATS
+ 	bucketPtr->numRemoves++;
+ 	bucketPtr->totalAssigned += sizeof(Tcl_Obj);
+#endif
     }
+    return blockPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    if (expensive) {
-	void *newPtr;
+void
+TclSmallFree(
+    void *ptr)
+{
+    Cache *cachePtr;
+    Block *blockPtr = ptr;
+    Bucket *bucketPtr;
 
-	Tcl_MutexUnlock(allocMutexPtr);
+    GETCACHE(cachePtr);
+    bucketPtr = &cachePtr->buckets[0];
 
-	newPtr = TclpAlloc(numBytes);
-	if (newPtr == NULL) {
-	    return NULL;
-	}
-	maxSize -= OVERHEAD;
-	if (maxSize < numBytes) {
-	    numBytes = maxSize;
+#ifdef ZIPPY_STATS
+    bucketPtr->totalAssigned -= sizeof(Tcl_Obj);
+#endif
+    blockPtr->nextBlock = bucketPtr->firstPtr;
+    bucketPtr->firstPtr = blockPtr;
+    bucketPtr->numFree++;
+#ifdef ZIPPY_STATS
+    bucketPtr->numInserts++;
+#endif
+    
+    if (bucketPtr->numFree > bucketInfo[0].maxBlocks) {
+	if (allocator == aPURIFY) {
+	    /* undo */
+	    bucketPtr->numFree = 0;
+	    bucketPtr->firstPtr = NULL;
+	    free((char *) blockPtr);
+	    return;
 	}
-	memcpy(newPtr, oldPtr, (size_t) numBytes);
-	TclpFree(oldPtr);
-	return newPtr;
+#if defined(TCL_THREADS)
+	PutBlocks(cachePtr, 0, bucketInfo[0].numMove);
+#endif
     }
+}
+
+#if defined(TCL_THREADS)
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    /*
-     * Ok, we don't have to copy, it fits as-is
-     */
-
-#ifdef RCHECK
-    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-    BLOCK_END(overPtr) = RMAGIC;
+static void
+LockBucket(
+    Cache *cachePtr,
+    int bucket)
+{
+#if 0
+    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
+	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
+	cachePtr->buckets[bucket].numWaits++;
+	sharedPtr->buckets[bucket].numWaits++;
+    }
+#else
+    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
 #endif
+#ifdef ZIPPY_STATS
+    cachePtr->buckets[bucket].numLocks++;
+    sharedPtr->buckets[bucket].numLocks++;
+#endif
+}
 
-    Tcl_MutexUnlock(allocMutexPtr);
-    return(oldPtr);
+static void
+UnlockBucket(
+    Cache *cachePtr,
+    int bucket)
+{
+    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * mstats --
+ * PutBlocks --
  *
- *	Prints two lines of numbers, one showing the length of the free list
- *	for each size category, the second showing the number of mallocs -
- *	frees for each size category.
+ *	Return unused blocks to the shared cache.
  *
  * Results:
  *	None.
@@ -646,95 +1047,203 @@ TclpRealloc(
  *----------------------------------------------------------------------
  */
 
-#ifdef MSTATS
-void
-mstats(
-    char *s)			/* Where to write info. */
+static void
+PutBlocks(
+    Cache *cachePtr,
+    int bucket,
+    int numMove)
 {
-    register int i, j;
-    register union overhead *overPtr;
-    int totalFree = 0, totalUsed = 0;
+    register Block *lastPtr, *firstPtr;
+    register int n = numMove;
 
-    Tcl_MutexLock(allocMutexPtr);
-
-    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
-    for (i = 0; i < NBUCKETS; i++) {
-	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
-	    fprintf(stderr, " %d", j);
-	}
-	totalFree += j * (1 << (i + 3));
-    }
+    /*
+     * Before acquiring the lock, walk the block list to find the last block
+     * to be moved.
+     */
 
-    fprintf(stderr, "\nused:\t");
-    for (i = 0; i < NBUCKETS; i++) {
-	fprintf(stderr, " %d", numMallocs[i]);
-	totalUsed += numMallocs[i] * (1 << (i + 3));
+    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
+    while (--n > 0) {
+	lastPtr = lastPtr->nextBlock;
     }
+    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
+    cachePtr->buckets[bucket].numFree -= numMove;
 
-    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
-	    totalUsed, totalFree);
-    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
-	    MAXMALLOC, numMallocs[NBUCKETS]);
+    /*
+     * Aquire the lock and place the list of blocks at the front of the shared
+     * cache bucket.
+     */
 
-    Tcl_MutexUnlock(allocMutexPtr);
+    LockBucket(cachePtr, bucket);
+    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
+    sharedPtr->buckets[bucket].firstPtr = firstPtr;
+    sharedPtr->buckets[bucket].numFree += numMove;
+    UnlockBucket(cachePtr, bucket);
 }
 #endif
-
-#else	/* !USE_TCLALLOC */
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpAlloc --
+ * GetBlocks --
  *
- *	Allocate more memory.
+ *	Get more blocks for a bucket.
  *
  * Results:
- *	None.
+ *	1 if blocks where allocated, 0 otherwise.
  *
  * Side effects:
- *	None.
+ *	Cache may be filled with available blocks.
  *
  *----------------------------------------------------------------------
  */
 
-char *
-TclpAlloc(
-    unsigned int numBytes)	/* Number of bytes to allocate. */
+static int
+GetBlocks(
+    Cache *cachePtr,
+    int bucket)
 {
-    return (char *) malloc(numBytes);
+    register Block *blockPtr = NULL;
+    register int n;
+
+    if (allocator == aPURIFY) {
+	if (bucket) {
+	    Tcl_Panic("purify mode asking for blocks?");
+	}
+	cachePtr->buckets[0].firstPtr = (Block *) calloc(1, MINALLOC);
+	cachePtr->buckets[0].numFree = 1;
+	return 1;
+    }
+
+#if defined(TCL_THREADS)
+    /*
+     * 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);
+    }
+#endif
+    
+    if (cachePtr->buckets[bucket].numFree == 0) {
+	register size_t size;
+
+#if TCL_ALLOCATOR != aNATIVE
+	/*
+	 * If no blocks could be moved from shared, first look for a larger
+	 * block in this cache OR the shared cache to split up.
+	 */
+
+	n = nBuckets;
+	size = 0; /* lint */
+	while (--n > bucket) {
+	    size = bucketInfo[n].blockSize;
+	    if (cachePtr->buckets[n].numFree > 0) {
+		blockPtr = cachePtr->buckets[n].firstPtr;
+		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
+		cachePtr->buckets[n].numFree--;
+		break;
+	    } else if (sharedPtr->buckets[n].numFree > 0){
+		LockBucket(cachePtr, n);
+		if (sharedPtr->buckets[n].numFree > 0) {
+		    blockPtr = sharedPtr->buckets[n].firstPtr;
+		    sharedPtr->buckets[n].firstPtr = blockPtr->nextBlock;
+		    sharedPtr->buckets[n].numFree--;
+		    UnlockBucket(cachePtr, n);
+		    break;		
+		}
+		UnlockBucket(cachePtr, n);
+	    }
+	}
+#endif
+
+	/*
+	 * Otherwise, allocate a big new block directly.
+	 */
+
+	if (blockPtr == NULL) {
+	    size = MAXALLOC;
+	    blockPtr = malloc(size);
+	    if (blockPtr == NULL) {
+		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;
 }
 
 /*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  *
- * TclpFree --
+ * TclInitAlloc --
  *
- *	Free memory.
+ *	Initialize the memory system.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	None.
+ *	Initialize the mutex used to serialize allocations.
  *
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  */
 
 void
-TclpFree(
-    char *oldPtr)		/* Pointer to memory to free. */
+TclInitAlloc(void)
 {
-    free(oldPtr);
-    return;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpRealloc --
+ * TclFinalizeAlloc --
  *
- *	Reallocate memory.
+ *	This procedure is used to destroy all private resources used in this
+ *	file.
  *
  * Results:
  *	None.
@@ -745,16 +1254,55 @@ TclpFree(
  *----------------------------------------------------------------------
  */
 
-char *
-TclpRealloc(
-    char *oldPtr,		/* Pointer to alloced block. */
-    unsigned int numBytes)	/* New size of memory. */
+void
+TclFinalizeAlloc(void)
 {
-    return (char *) realloc(oldPtr, numBytes);
+#if defined(TCL_THREADS)
+    unsigned int i;
+
+    for (i = 0; i < nBuckets; ++i) {
+	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
+	bucketInfo[i].lockPtr = NULL;
+    }
+
+    TclpFreeAllocMutex(objLockPtr);
+    objLockPtr = NULL;
+
+    TclpFreeAllocMutex(listLockPtr);
+    listLockPtr = NULL;
+
+    TclpFreeAllocCache(NULL);
+#endif
 }
+
+#if TCL_ALLOCATOR != aZIPPY
+static void
+ChooseAllocator()
+{
+    char *choice = getenv("TCL_ALLOCATOR");
+
+    /*
+     * This is only called with ALLOCATOR_BASE aZIPPY (when compiled with 
+     * aMULTI) or aNATIVE (when compiled with aNATIVE).
+     */
+    
+    allocator = ALLOCATOR_BASE;
+
+    if (choice) {
+	/*
+	 * Only override the base when requesting native or purify
+	 */
+	
+	if (!strcmp(choice, "aNATIVE")) {
+	    allocator = aNATIVE;
+	} else if (!strcmp(choice, "aPURIFY")) {
+	    allocator = aPURIFY;
+	}
+    }
+}
+#endif
 
-#endif /* !USE_TCLALLOC */
-#endif /* !TCL_THREADS */
+#endif /* end of !PURIFY */
 
 /*
  * Local Variables:
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 754941f..2562558 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1095,11 +1095,9 @@ NewAssemblyEnv(
 				 * generation*/
     int flags)			/* Compilation flags (TCL_EVAL_DIRECT) */
 {
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
+    AssemblyEnv* assemEnvPtr = ckalloc(sizeof(AssemblyEnv));
 				/* Assembler environment under construction */
-    Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse* parsePtr = ckalloc(sizeof(Tcl_Parse));
 				/* Parse of one line of assembly code */
 
     assemEnvPtr->envPtr = envPtr;
@@ -1144,11 +1142,6 @@ static void
 FreeAssemblyEnv(
     AssemblyEnv* assemEnvPtr)	/* Environment to free */
 {
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment being used for code
-				 * generation */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
     BasicBlock* thisBB;		/* Pointer to a basic block being deleted */
     BasicBlock* nextBB;		/* Pointer to a deleted basic block's
 				 * successor */
@@ -1191,8 +1184,8 @@ FreeAssemblyEnv(
      * Dispose what's left.
      */
 
-    TclStackFree(interp, assemEnvPtr->parsePtr);
-    TclStackFree(interp, assemEnvPtr);
+    ckfree(assemEnvPtr->parsePtr);
+    ckfree(assemEnvPtr);
 }
 
 /*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5f2b301..5e676ba 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -728,11 +728,6 @@ Tcl_CreateInterp(void)
      * cache was already initialised by the call to alloc the interp struct.
      */
 
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    iPtr->allocCache = TclpGetAllocCache();
-#else
-    iPtr->allocCache = NULL;
-#endif
     iPtr->pendingObjDataPtr = NULL;
     iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
     iPtr->deferredCallbacks = NULL;
@@ -2319,8 +2314,7 @@ TclInvokeStringCommand(
 {
     Command *cmdPtr = clientData;
     int i, result;
-    const char **argv =
-	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
+    const char **argv = ckalloc((unsigned)(objc + 1) * sizeof(char *));
 
     for (i = 0; i < objc; i++) {
 	argv[i] = Tcl_GetString(objv[i]);
@@ -2333,7 +2327,7 @@ TclInvokeStringCommand(
 
     result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv);
 
-    TclStackFree(interp, (void *) argv);
+    ckfree((void *) argv);
     return result;
 }
 
@@ -2368,8 +2362,7 @@ TclInvokeObjectCommand(
     Command *cmdPtr = clientData;
     Tcl_Obj *objPtr;
     int i, length, result;
-    Tcl_Obj **objv =
-	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
+    Tcl_Obj **objv = ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
 
     for (i = 0; i < argc; i++) {
 	length = strlen(argv[i]);
@@ -2405,7 +2398,7 @@ TclInvokeObjectCommand(
 	objPtr = objv[i];
 	Tcl_DecrRefCount(objPtr);
     }
-    TclStackFree(interp, objv);
+    ckfree(objv);
     return result;
 }
 
@@ -4563,7 +4556,7 @@ TEOV_NotFound(
     Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
 	    &handlerObjc, &handlerObjv);
     newObjc = objc + handlerObjc;
-    newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
+    newObjv = ckalloc((int) sizeof(Tcl_Obj *) * newObjc);
 
     /*
      * Copy command prefix from unknown handler and add on the real command's
@@ -4602,7 +4595,7 @@ TEOV_NotFound(
 	for (i = 0; i < handlerObjc; ++i) {
 	    Tcl_DecrRefCount(newObjv[i]);
 	}
-	TclStackFree(interp, newObjv);
+	ckfree(newObjv);
 	return TCL_ERROR;
     }
 
@@ -4640,7 +4633,7 @@ TEOV_NotFoundCallback(
     for (i = 0; i < objc; ++i) {
 	Tcl_DecrRefCount(objv[i]);
     }
-    TclStackFree(interp, objv);
+    ckfree(objv);
 
     return result;
 }
@@ -4937,12 +4930,11 @@ TclEvalEx(
 				 * state has been allocated while evaluating
 				 * the script, so that it can be freed
 				 * properly if an error occurs. */
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
-    CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
-    Tcl_Obj **stackObjArray =
-	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
-    int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
-    int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
+    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
@@ -5338,11 +5330,11 @@ TclEvalEx(
     if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
 	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
     }
-    TclStackFree(interp, linesStack);
-    TclStackFree(interp, expandStack);
-    TclStackFree(interp, stackObjArray);
-    TclStackFree(interp, eeFramePtr);
-    TclStackFree(interp, parsePtr);
+    ckfree(linesStack);
+    ckfree(expandStack);
+    ckfree(stackObjArray);
+    ckfree(eeFramePtr);
+    ckfree(parsePtr);
 
     return code;
 }
@@ -5980,7 +5972,7 @@ TclNREvalObjEx(
 	     * should be pushed, as needed by alias and ensemble redirections.
 	     */
 
-	    eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	    eoFramePtr = ckalloc(sizeof(CmdFrame));
 	    eoFramePtr->nline = 0;
 	    eoFramePtr->line = NULL;
 
@@ -6098,7 +6090,7 @@ TclNREvalObjEx(
 	     */
 
 	    int pc = 0;
-	    CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	    CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame));
 
 	    *ctxPtr = *invoker;
 	    if (invoker->type == TCL_LOCATION_BC) {
@@ -6139,7 +6131,7 @@ TclNREvalObjEx(
 
 		Tcl_DecrRefCount(ctxPtr->data.eval.path);
 	    }
-	    TclStackFree(interp, ctxPtr);
+	    ckfree(ctxPtr);
 	}
 
 	/*
@@ -6218,7 +6210,7 @@ TEOEx_ListCallback(
 
     if (eoFramePtr) {
 	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
-	TclStackFree(interp, eoFramePtr);
+	ckfree(eoFramePtr);
     }
     TclDecrRefCount(listPtr);
 
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 9d63ebf..3b51f68 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -1296,10 +1296,6 @@ TclFinalizeMemorySubsystem(void)
 
     Tcl_MutexUnlock(ckallocMutexPtr);
 #endif
-
-#if USE_TCLALLOC
-    TclFinalizeAllocSubsystem();
-#endif
 }
 
 /*
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 3edfa54..b4afdef 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2348,7 +2348,7 @@ TclNRForObjCmd(
 	return TCL_ERROR;
     }
 
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
+    TclCkSmallAlloc(sizeof(ForIterData), iterPtr);
     iterPtr->cond = objv[2];
     iterPtr->body = objv[4];
     iterPtr->next = objv[3];
@@ -2376,7 +2376,7 @@ ForSetupCallback(
 	if (result == TCL_ERROR) {
 	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
 	}
-	TclSmallFreeEx(interp, iterPtr);
+	TclSmallFree(iterPtr);
 	return result;
     }
     TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
@@ -2414,7 +2414,7 @@ TclNRForIterCallback(
 	Tcl_AppendObjToErrorInfo(interp,
 		Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
     }
-    TclSmallFreeEx(interp, iterPtr);
+    TclSmallFree(iterPtr);
     return result;
 }
 
@@ -2431,11 +2431,11 @@ ForCondCallback(
 
     if (result != TCL_OK) {
 	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
+	TclSmallFree(iterPtr);
 	return result;
     } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
 	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
+	TclSmallFree(iterPtr);
 	return TCL_ERROR;
     }
     Tcl_DecrRefCount(boolObj);
@@ -2452,7 +2452,7 @@ ForCondCallback(
 	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
 		iterPtr->word);
     }
-    TclSmallFreeEx(interp, iterPtr);
+    TclSmallFree(iterPtr);
     return result;
 }
 
@@ -2492,7 +2492,7 @@ ForPostNextCallback(
     if ((result != TCL_BREAK) && (result != TCL_OK)) {
 	if (result == TCL_ERROR) {
 	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-	    TclSmallFreeEx(interp, iterPtr);
+	    TclSmallFree(iterPtr);
 	}
 	return result;
     }
@@ -2560,7 +2560,7 @@ TclNRForeachCmd(
      * allocation for better performance.
      */
 
-    statePtr = TclStackAlloc(interp,
+    statePtr = ckalloc(
 	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
 	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
     memset(statePtr, 0,
@@ -2754,7 +2754,7 @@ ForeachCleanup(
 	    TclDecrRefCount(statePtr->aCopyList[i]);
 	}
     }
-    TclStackFree(interp, statePtr);
+    ckfree(statePtr);
 }
 
 /*
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b38ec9f..cd4a72b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1313,7 +1313,7 @@ TclInfoFrame(
 	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
 	 */
 
-	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	CmdFrame *fPtr = ckalloc(sizeof(CmdFrame));
 
 	*fPtr = *framePtr;
 
@@ -1347,7 +1347,7 @@ TclInfoFrame(
 
 	ADD_PAIR("cmd",
 		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
-	TclStackFree(interp, fPtr);
+	ckfree(fPtr);
 	break;
     }
 
@@ -3016,7 +3016,7 @@ Tcl_LsearchObjCmd(
 	    int j;
 
 	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
+		ckfree(sortInfo.indexv);
 	    }
 	    if (i > objc-4) {
 		if (startPtr != NULL) {
@@ -3051,7 +3051,7 @@ Tcl_LsearchObjCmd(
 		break;
 	    default:
 		sortInfo.indexv =
-			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+			ckalloc(sizeof(int) * sortInfo.indexc);
 	    }
 
 	    /*
@@ -3158,7 +3158,7 @@ Tcl_LsearchObjCmd(
 
 	if (offset > listc-1) {
 	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
+		ckfree(sortInfo.indexv);
 	    }
 	    if (allMatches || inlineReturn) {
 		Tcl_ResetResult(interp);
@@ -3483,7 +3483,7 @@ Tcl_LsearchObjCmd(
 
   done:
     if (sortInfo.indexc > 1) {
-	TclStackFree(interp, sortInfo.indexv);
+	ckfree(sortInfo.indexv);
     }
     return result;
 }
@@ -3770,7 +3770,7 @@ Tcl_LsortObjCmd(
             break;
         default:
             sortInfo.indexv =
-		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+		    ckalloc(sizeof(int) * sortInfo.indexc);
             allocatedIndexVector = 1;	/* Cannot use indexc field, as it
                                          * might be decreased by 1 later. */
         }
@@ -3865,6 +3865,7 @@ Tcl_LsortObjCmd(
 		/*
 		 * 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++) {
@@ -3902,7 +3903,7 @@ Tcl_LsortObjCmd(
      * begins sorting it into the sublists as it appears.
      */
 
-    elementArray = TclStackAlloc(interp, length * sizeof(SortElement));
+    elementArray = ckalloc(length * sizeof(SortElement));
 
     for (i=0; i < length; i++){
 	idx = groupSize * i + groupOffset;
@@ -4026,7 +4027,7 @@ Tcl_LsortObjCmd(
     }
 
   done1:
-    TclStackFree(interp, elementArray);
+    ckfree(elementArray);
 
   done:
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
@@ -4036,7 +4037,7 @@ Tcl_LsortObjCmd(
     }
   done2:
     if (allocatedIndexVector) {
-	TclStackFree(interp, sortInfo.indexv);
+	ckfree(sortInfo.indexv);
     }
     return sortInfo.resultCode;
 }
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 05f2e5d..d85cd83 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1835,7 +1835,7 @@ StringMapCmd(
 	 * adapt this code...
 	 */
 
-	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
+	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) {
@@ -1944,10 +1944,10 @@ StringMapCmd(
 	 * case.
 	 */
 
-	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
-	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
+	mapStrings = ckalloc(mapElemc*2*sizeof(Tcl_UniChar *));
+	mapLens = ckalloc(mapElemc * 2 * sizeof(int));
 	if (nocase) {
-	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
+	    u2lc = ckalloc(mapElemc * sizeof(Tcl_UniChar));
 	}
 	for (index = 0; index < mapElemc; index++) {
 	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
@@ -1997,10 +1997,10 @@ StringMapCmd(
 	    }
 	}
 	if (nocase) {
-	    TclStackFree(interp, u2lc);
+	    ckfree(u2lc);
 	}
-	TclStackFree(interp, mapLens);
-	TclStackFree(interp, mapStrings);
+	ckfree(mapLens);
+	ckfree(mapStrings);
     }
     if (p != ustring1) {
 	/*
@@ -2012,7 +2012,7 @@ StringMapCmd(
     Tcl_SetObjResult(interp, resultPtr);
   done:
     if (mapWithDict) {
-	TclStackFree(interp, mapElemv);
+	ckfree(mapElemv);
     }
     if (copySource) {
 	Tcl_DecrRefCount(sourceObj);
@@ -3849,7 +3849,7 @@ TclNRSwitchObjCmd(
      */
 
   matchFound:
-    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+    ctxPtr = ckalloc(sizeof(CmdFrame));
     *ctxPtr = *iPtr->cmdFramePtr;
 
     if (splitObjs) {
@@ -3966,7 +3966,7 @@ SwitchPostProc(
 		(overflow ? limit : patternLength), pattern,
 		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
     }
-    TclStackFree(interp, ctxPtr);
+    ckfree(ctxPtr);
     return result;
 }
 
@@ -4729,7 +4729,7 @@ TclNRWhileObjCmd(
      * We reuse [for]'s callback, passing a NULL for the 'next' script.
      */
 
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
+    TclCkSmallAlloc(sizeof(ForIterData), iterPtr);
     iterPtr->cond = objv[1];
     iterPtr->body = objv[2];
     iterPtr->next = NULL;
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 083f530..2fda2b9 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1021,8 +1021,7 @@ TclCompileDictUpdateCmd(
 
     duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
     duiPtr->length = numVars;
-    keyTokenPtrs = TclStackAlloc(interp,
-	    sizeof(Tcl_Token *) * numVars);
+    keyTokenPtrs = ckalloc(sizeof(Tcl_Token *) * numVars);
     tokenPtr = TokenAfter(dictVarTokenPtr);
 
     for (i=0 ; i<numVars ; i++) {
@@ -1060,7 +1059,7 @@ TclCompileDictUpdateCmd(
     if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
     failedUpdateInfoAssembly:
 	ckfree(duiPtr);
-	TclStackFree(interp, keyTokenPtrs);
+	ckfree(keyTokenPtrs);
 	return TCL_ERROR;
     }
     bodyTokenPtr = tokenPtr;
@@ -1124,7 +1123,7 @@ TclCompileDictUpdateCmd(
 	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
 		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
-    TclStackFree(interp, keyTokenPtrs);
+    ckfree(keyTokenPtrs);
     return TCL_OK;
 }
 
@@ -1637,10 +1636,9 @@ TclCompileForeachCmd(
      */
 
     numLists = (numWords - 2)/2;
-    varcList = TclStackAlloc(interp, numLists * sizeof(int));
+    varcList = ckalloc(numLists * sizeof(int));
     memset(varcList, 0, numLists * sizeof(int));
-    varvList = (const char ***) TclStackAlloc(interp,
-	    numLists * sizeof(const char **));
+    varvList = (const char ***) ckalloc(numLists * sizeof(const char **));
     memset((char*) varvList, 0, numLists * sizeof(const char **));
 
     /*
@@ -1867,8 +1865,8 @@ TclCompileForeachCmd(
 	    ckfree(varvList[loopIndex]);
 	}
     }
-    TclStackFree(interp, (void *)varvList);
-    TclStackFree(interp, varcList);
+    ckfree((void *)varvList);
+    ckfree(varcList);
     return code;
 }
 
@@ -3516,7 +3514,7 @@ TclCompileReturnCmd(
      * Allocate some working space.
      */
 
-    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
+    objv = ckalloc(numOptionWords * sizeof(Tcl_Obj *));
 
     /*
      * Scan through the return options. If any are unknown at compile time,
@@ -3540,7 +3538,7 @@ TclCompileReturnCmd(
     while (--objc >= 0) {
 	TclDecrRefCount(objv[objc]);
     }
-    TclStackFree(interp, objv);
+    ckfree(objv);
     if (TCL_ERROR == status) {
 	/*
 	 * Something was bogus in the return options. Clear the error message,
@@ -4028,7 +4026,7 @@ PushVarName(
 		 * assemble the corresponding token.
 		 */
 
-		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
+		elemTokenPtr = ckalloc(sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -4081,7 +4079,7 @@ PushVarName(
 		 * token.
 		 */
 
-		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
+		elemTokenPtr = ckalloc(n * sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -4169,7 +4167,7 @@ PushVarName(
 	varTokenPtr[removedParen].size++;
     }
     if (allocedTokens) {
-	TclStackFree(interp, elemTokenPtr);
+	ckfree(elemTokenPtr);
     }
     *localIndexPtr = localIndex;
     *simpleVarNamePtr = simpleVarName;
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index d956819..ff494f2 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -595,7 +595,7 @@ TclCompileSubstCmd(
 	return TCL_ERROR;
     }
 
-    objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));
+    objv = ckalloc(/*numArgs*/ numOpts * sizeof(Tcl_Obj *));
 
     for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
 	objv[objc] = Tcl_NewObj();
@@ -628,7 +628,7 @@ TclCompileSubstCmd(
     while (--objc >= 0) {
 	TclDecrRefCount(objv[objc]);
     }
-    TclStackFree(interp, objv);
+    ckfree(objv);
     if (/*toSubst == NULL*/ code != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -1320,8 +1320,8 @@ IssueSwitchChainedTests(
 
     contFixIndex = -1;
     contFixCount = 0;
-    fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
-    fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens);
+    fixupArray = ckalloc(sizeof(JumpFixup) * numBodyTokens);
+    fixupTargetArray = ckalloc(sizeof(int) * numBodyTokens);
     memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
     fixupCount = 0;
     foundDefault = 0;
@@ -1520,8 +1520,8 @@ IssueSwitchChainedTests(
 	    }
 	}
     }
-    TclStackFree(interp, fixupTargetArray);
-    TclStackFree(interp, fixupArray);
+    ckfree(fixupTargetArray);
+    ckfree(fixupArray);
 
     envPtr->currStackDepth = savedStackDepth + 1;
 }
@@ -1582,7 +1582,7 @@ IssueSwitchJumpTable(
     jtPtr = ckalloc(sizeof(JumptableInfo));
     Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
     infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
-    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
+    finalFixups = ckalloc(sizeof(int) * (numBodyTokens/2));
     foundDefault = 0;
     mustGenerate = 1;
 
@@ -1720,7 +1720,7 @@ IssueSwitchJumpTable(
      * Clean up all our temporary space and return.
      */
 
-    TclStackFree(interp, finalFixups);
+    ckfree(finalFixups);
 }
 
 /*
@@ -1975,12 +1975,12 @@ TclCompileTryCmd(
     numHandlers = numWords >> 2;
     numWords -= numHandlers * 4;
     if (numHandlers > 0) {
-	handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
-	matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
+	handlerTokens = ckalloc(sizeof(Tcl_Token*)*numHandlers);
+	matchClauses = ckalloc(sizeof(Tcl_Obj *) * numHandlers);
 	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
-	matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
-	resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
-	optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
+	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;
@@ -2139,11 +2139,11 @@ TclCompileTryCmd(
 		TclDecrRefCount(matchClauses[i]);
 	    }
 	}
-	TclStackFree(interp, optionVarIndices);
-	TclStackFree(interp, resultVarIndices);
-	TclStackFree(interp, matchCodes);
-	TclStackFree(interp, matchClauses);
-	TclStackFree(interp, handlerTokens);
+	ckfree(optionVarIndices);
+	ckfree(resultVarIndices);
+	ckfree(matchCodes);
+	ckfree(matchClauses);
+	ckfree(handlerTokens);
     }
     return result;
 }
@@ -2219,8 +2219,8 @@ IssueTryInstructions(
      * Slight overallocation, but reduces size of this function.
      */
 
-    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+    addrsToFix = ckalloc(sizeof(int)*numHandlers);
+    forwardsToFix = ckalloc(sizeof(int)*numHandlers);
 
     for (i=0 ; i<numHandlers ; i++) {
 	sprintf(buf, "%d", matchCodes[i]);
@@ -2307,8 +2307,8 @@ IssueTryInstructions(
     for (i=0 ; i<numHandlers ; i++) {
 	FIXJUMP(addrsToFix[i]);
     }
-    TclStackFree(interp, forwardsToFix);
-    TclStackFree(interp, addrsToFix);
+    ckfree(forwardsToFix);
+    ckfree(addrsToFix);
     return TCL_OK;
 }
 
@@ -2370,8 +2370,8 @@ IssueTryFinallyInstructions(
 	 * Slight overallocation, but reduces size of this function.
 	 */
 
-	addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-	forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
+	addrsToFix = ckalloc(sizeof(int)*numHandlers);
+	forwardsToFix = ckalloc(sizeof(int)*numHandlers);
 
 	for (i=0 ; i<numHandlers ; i++) {
 	    sprintf(buf, "%d", matchCodes[i]);
@@ -2503,8 +2503,8 @@ IssueTryFinallyInstructions(
 	for (i=0 ; i<numHandlers-1 ; i++) {
 	    FIXJUMP(addrsToFix[i]);
 	}
-	TclStackFree(interp, forwardsToFix);
-	TclStackFree(interp, addrsToFix);
+	ckfree(forwardsToFix);
+	ckfree(addrsToFix);
     }
 
     /*
@@ -2900,7 +2900,7 @@ PushVarName(
 		 * assemble the corresponding token.
 		 */
 
-		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
+		elemTokenPtr = ckalloc(sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -2953,7 +2953,7 @@ PushVarName(
 		 * token.
 		 */
 
-		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
+		elemTokenPtr = ckalloc(n * sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -3041,7 +3041,7 @@ PushVarName(
 	varTokenPtr[removedParen].size++;
     }
     if (allocedTokens) {
-	TclStackFree(interp, elemTokenPtr);
+	ckfree(elemTokenPtr);
     }
     *localIndexPtr = localIndex;
     *simpleVarNamePtr = simpleVarName;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index a07d6df..396448b 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -920,7 +920,7 @@ ParseExpr(
 
 	    case SCRIPT: {
 		Tcl_Parse *nestedPtr =
-			TclStackAlloc(interp, sizeof(Tcl_Parse));
+			ckalloc(sizeof(Tcl_Parse));
 
 		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
 		tokenPtr->type = TCL_TOKEN_COMMAND;
@@ -955,7 +955,7 @@ ParseExpr(
 			break;
 		    }
 		}
-		TclStackFree(interp, nestedPtr);
+		ckfree(nestedPtr);
 		end = start;
 		start = tokenPtr->start;
 		scanned = end - start;
@@ -1821,7 +1821,7 @@ Tcl_ParseExpr(
     OpNode *opTree = NULL;	/* Will point to the tree of operators. */
     Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals. */
     Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names. */
-    Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *exprParsePtr = ckalloc(sizeof(Tcl_Parse));
 				/* Holds the Tcl_Tokens of substitutions. */
 
     if (numBytes < 0) {
@@ -1843,7 +1843,7 @@ Tcl_ParseExpr(
     }
 
     Tcl_FreeParse(exprParsePtr);
-    TclStackFree(interp, exprParsePtr);
+    ckfree(exprParsePtr);
     ckfree(opTree);
     return code;
 }
@@ -2072,7 +2072,7 @@ TclCompileExpr(
     OpNode *opTree = NULL;	/* Will point to the tree of operators */
     Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
     Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse));
 				/* Holds the Tcl_Tokens of substitutions */
 
     int code = ParseExpr(interp, script, numBytes, &opTree, litList,
@@ -2100,7 +2100,7 @@ TclCompileExpr(
     }
 
     Tcl_FreeParse(parsePtr);
-    TclStackFree(interp, parsePtr);
+    ckfree(parsePtr);
     Tcl_DecrRefCount(funcList);
     Tcl_DecrRefCount(litList);
     ckfree(opTree);
@@ -2143,7 +2143,7 @@ ExecConstantExprTree(
      * bytecode, so there's no need to tend to TIP 280 issues.
      */
 
-    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
+    envPtr = ckalloc(sizeof(CompileEnv));
     TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
     CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
 	    0 /* optimize */);
@@ -2151,7 +2151,7 @@ ExecConstantExprTree(
     Tcl_IncrRefCount(byteCodeObj);
     TclInitByteCodeObj(byteCodeObj, envPtr);
     TclFreeCompileEnv(envPtr);
-    TclStackFree(interp, envPtr);
+    ckfree(envPtr);
     byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
     TclNRExecuteByteCode(interp, byteCodePtr);
     code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
@@ -2208,10 +2208,10 @@ CompileExprTree(
 
 	    switch (nodePtr->lexeme) {
 	    case QUESTION:
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump = ckalloc(sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump = ckalloc(sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
 		jumpPtr->depth = envPtr->currStackDepth;
@@ -2219,13 +2219,13 @@ CompileExprTree(
 		break;
 	    case AND:
 	    case OR:
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump = ckalloc(sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump = ckalloc(sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
+		newJump = ckalloc(sizeof(JumpList));
 		newJump->next = jumpPtr;
 		jumpPtr = newJump;
 		jumpPtr->depth = envPtr->currStackDepth;
@@ -2331,10 +2331,10 @@ CompileExprTree(
 		envPtr->currStackDepth = jumpPtr->depth + 1;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
+		ckfree(freePtr);
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
+		ckfree(freePtr);
 		break;
 	    case AND:
 	    case OR:
@@ -2358,13 +2358,13 @@ CompileExprTree(
 		envPtr->currStackDepth = jumpPtr->depth + 1;
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
+		ckfree(freePtr);
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
+		ckfree(freePtr);
 		freePtr = jumpPtr;
 		jumpPtr = jumpPtr->next;
-		TclStackFree(interp, freePtr);
+		ckfree(freePtr);
 		break;
 	    default:
 		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
@@ -2541,9 +2541,8 @@ TclSortingOpCmd(
 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
     } else {
 	TclOpCmdClientData *occdPtr = clientData;
-	Tcl_Obj **litObjv = TclStackAlloc(interp,
-		2 * (objc-2) * sizeof(Tcl_Obj *));
-	OpNode *nodes = TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
+	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;
@@ -2583,8 +2582,8 @@ TclSortingOpCmd(
 
 	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
 
-	TclStackFree(interp, nodes);
-	TclStackFree(interp, litObjv);
+	ckfree(nodes);
+	ckfree(litObjv);
     }
     return code;
 }
@@ -2670,7 +2669,7 @@ TclVariadicOpCmd(
 	return code;
     } else {
 	Tcl_Obj *const *litObjv = objv + 1;
-	OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
+	OpNode *nodes = ckalloc((objc-1) * sizeof(OpNode));
 	int i, lastOp = OT_LITERAL;
 
 	nodes[0].lexeme = START;
@@ -2703,7 +2702,7 @@ TclVariadicOpCmd(
 
 	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
 
-	TclStackFree(interp, nodes);
+	ckfree(nodes);
 	return code;
     }
 }
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index aed9e3b..4d6bf33 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1202,7 +1202,7 @@ TclInitCompileEnv(
 	 * ...) which may make change the type as well.
 	 */
 
-	CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame));
 	int pc = 0;
 
 	*ctxPtr = *invoker;
@@ -1255,7 +1255,7 @@ TclInitCompileEnv(
 	    }
 	}
 
-	TclStackFree(interp, ctxPtr);
+	ckfree(ctxPtr);
     }
 
     envPtr->extCmdMapPtr->start = envPtr->line;
@@ -1461,7 +1461,7 @@ TclCompileScript(
     /* TIP #280 */
     ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
     int *wlines, wlineat, cmdLine, *clNext;
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse));
 
     Tcl_DStringInit(&ds);
 
@@ -1877,7 +1877,7 @@ TclCompileScript(
     }
 
     envPtr->numSrcBytes = p - script;
-    TclStackFree(interp, parsePtr);
+    ckfree(parsePtr);
     Tcl_DStringFree(&ds);
 }
 
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 3da91a3..4ed3fe6 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -2425,14 +2425,14 @@ DictForNRCmd(
 		TCL_STATIC);
 	return TCL_ERROR;
     }
-    searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
+    searchPtr = ckalloc(sizeof(Tcl_DictSearch));
     if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
 	    &done) != TCL_OK) {
-	TclStackFree(interp, searchPtr);
+	ckfree(searchPtr);
 	return TCL_ERROR;
     }
     if (done) {
-	TclStackFree(interp, searchPtr);
+	ckfree(searchPtr);
 	return TCL_OK;
     }
     TclListObjGetElements(NULL, objv[1], &varc, &varv);
@@ -2488,7 +2488,7 @@ DictForNRCmd(
     TclDecrRefCount(valueVarObj);
     TclDecrRefCount(scriptObj);
     Tcl_DictObjDone(searchPtr);
-    TclStackFree(interp, searchPtr);
+    ckfree(searchPtr);
     return TCL_ERROR;
 }
 
@@ -2574,7 +2574,7 @@ DictForLoopCallback(
     TclDecrRefCount(valueVarObj);
     TclDecrRefCount(scriptObj);
     Tcl_DictObjDone(searchPtr);
-    TclStackFree(interp, searchPtr);
+    ckfree(searchPtr);
     return result;
 }
 
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 78bd7b8..49e8137 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1032,9 +1032,7 @@ TclInitSubsystems(void)
 
 	    TclInitThreadStorage();     /* Creates master hash table for
 					 * thread local storage */
-#if USE_TCLALLOC
 	    TclInitAlloc();		/* Process wide mutex init */
-#endif
 #ifdef TCL_MEM_DEBUG
 	    TclInitDbCkalloc();		/* Process wide mutex init */
 #endif
@@ -1211,9 +1209,7 @@ Tcl_Finalize(void)
      * Close down the thread-specific object allocator.
      */
 
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    TclFinalizeThreadAlloc();
-#endif
+    TclFinalizeAlloc();
 
     /*
      * We defer unloading of packages until very late to avoid memory access
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 26d3e04..b340144 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -171,19 +171,21 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
 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 */
-    ptrdiff_t *catchTop;	/* this level: they record the state when a */
+    int catchDepth;	        /* this level: they record the state when a */
     int cleanup;		/* new codePtr was received for NR */
     Tcl_Obj *auxObjList;	/* execution. */
     int checkInterp;
     CmdFrame cmdFrame;
+    unsigned int capacity;
     void * stack[1];            /* Start of the actual combined catch and obj
 				 * stacks; the struct will be expanded as
 				 * necessary */
 } TEBCdata;
 
 #define TEBC_YIELD()					\
-    esPtr->tosPtr = tosPtr;				\
+    TD->tosPtr = tosPtr;				\
     TD->pc = pc;					\
     TD->cleanup = cleanup;				\
     TclNRAddCallback(interp, TEBCresume, TD,	\
@@ -192,7 +194,7 @@ typedef struct TEBCdata {
 #define TEBC_DATA_DIG()				\
     pc = TD->pc;				\
     cleanup = TD->cleanup;			\
-    tosPtr = esPtr->tosPtr
+    tosPtr = TD->tosPtr
     
 
 #define PUSH_TAUX_OBJ(objPtr) \
@@ -296,20 +298,6 @@ VarHashCreateVar(
     } while (0)
 
 /*
- * Macros used to cache often-referenced Tcl evaluation stack information
- * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
- * pair must surround any call inside TclNRExecuteByteCode (and a few other
- * procedures that use this scheme) that could result in a recursive call
- * to TclNRExecuteByteCode.
- */
-
-#define CACHE_STACK_INFO() \
-    checkInterp = 1
-
-#define DECACHE_STACK_INFO() \
-    esPtr->tosPtr = tosPtr
-
-/*
  * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
  * increments the object's ref count since it makes the stack have another
  * reference pointing to the object. However, POP_OBJECT does not decrement
@@ -683,7 +671,6 @@ static void		ValidatePcAndStackTop(ByteCode *codePtr,
 			    int stackLowerBound, int checkStack);
 #endif /* TCL_COMPILE_DEBUG */
 static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void		DeleteExecStack(ExecStack *esPtr);
 static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr);
 MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
@@ -699,16 +686,10 @@ static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
 static const char *	GetSrcInfoForPc(const unsigned char *pc,
 			    ByteCode *codePtr, int *lengthPtr,
 			    const unsigned char **pcBeg);
-static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
-			    int move);
 static void		IllegalExprOperandType(Tcl_Interp *interp,
 			    const unsigned char *pc, Tcl_Obj *opndPtr);
 static void		InitByteCodeExecution(Tcl_Interp *interp);
-static inline int	OFFSET(void *ptr);
 static void		ReleaseDictIterator(Tcl_Obj *objPtr);
-/* Useful elsewhere, make available in tclInt.h or stubs? */
-static Tcl_Obj **	StackAllocWords(Tcl_Interp *interp, int numWords);
-static Tcl_Obj **	StackReallocWords(Tcl_Interp *interp, int numWords);
 static Tcl_NRPostProc	CopyCallback;
 static Tcl_NRPostProc	ExprObjCallback;
 
@@ -845,10 +826,7 @@ TclCreateExecEnv(
 				 * [sizeof(Tcl_Obj*)] */
 {
     ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
-    ExecStack *esPtr = ckalloc(sizeof(ExecStack)
-	    + (size_t) (size-1) * sizeof(Tcl_Obj *));
 
-    eePtr->execStackPtr = esPtr;
     TclNewBooleanObj(eePtr->constants[0], 0);
     Tcl_IncrRefCount(eePtr->constants[0]);
     TclNewBooleanObj(eePtr->constants[1], 1);
@@ -858,12 +836,6 @@ TclCreateExecEnv(
     eePtr->corPtr = NULL;
     eePtr->rewind = 0;
 
-    esPtr->prevPtr = NULL;
-    esPtr->nextPtr = NULL;
-    esPtr->markerPtr = NULL;
-    esPtr->endPtr = &esPtr->stackWords[size-1];
-    esPtr->tosPtr = &esPtr->stackWords[-1];
-
     Tcl_MutexLock(&execMutex);
     if (!execInitialized) {
 	TclInitAuxDataTypeTable();
@@ -892,42 +864,14 @@ TclCreateExecEnv(
  *----------------------------------------------------------------------
  */
 
-static void
-DeleteExecStack(
-    ExecStack *esPtr)
-{
-    if (esPtr->markerPtr) {
-	Tcl_Panic("freeing an execStack which is still in use");
-    }
-
-    if (esPtr->prevPtr) {
-	esPtr->prevPtr->nextPtr = esPtr->nextPtr;
-    }
-    if (esPtr->nextPtr) {
-	esPtr->nextPtr->prevPtr = esPtr->prevPtr;
-    }
-    ckfree(esPtr);
-}
-
 void
 TclDeleteExecEnv(
     ExecEnv *eePtr)		/* Execution environment to free. */
 {
-    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
-
     /*
      * Delete all stacks in this exec env.
      */
 
-    while (esPtr->nextPtr) {
-	esPtr = esPtr->nextPtr;
-    }
-    while (esPtr) {
-	tmpPtr = esPtr;
-	esPtr = tmpPtr->prevPtr;
-	DeleteExecStack(tmpPtr);
-    }
-
     TclDecrRefCount(eePtr->constants[0]);
     TclDecrRefCount(eePtr->constants[1]);
     if (eePtr->callbackPtr) {
@@ -967,339 +911,6 @@ TclFinalizeExecution(void)
 }
 
 /*
- * Auxiliary code to insure that GrowEvaluationStack always returns correctly
- * aligned memory.
- *
- * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
- * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
- * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
- */
-
-#define WALLOCALIGN \
-    (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
-
-/*
- * OFFSET computes how many words have to be skipped until the next aligned
- * word. Note that we are only interested in the low order bits of ptr, so
- * that any possible information loss in PTR2INT is of no consequence.
- */
-
-static inline int
-OFFSET(
-    void *ptr)
-{
-    int mask = TCL_ALLOCALIGN-1;
-    int base = PTR2INT(ptr) & mask;
-    return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
-}
-
-/*
- * Given a marker, compute where the following aligned memory starts.
- */
-
-#define MEMSTART(markerPtr) \
-    ((markerPtr) + OFFSET(markerPtr))
-
-/*
- *----------------------------------------------------------------------
- *
- * GrowEvaluationStack --
- *
- *	This procedure grows a Tcl evaluation stack stored in an ExecEnv,
- *	copying over the words since the last mark if so requested. A mark is
- *	set at the beginning of the new area when no copying is requested.
- *
- * Results:
- *	Returns a pointer to the first usable word in the (possibly) grown
- *	stack.
- *
- * Side effects:
- *	The size of the evaluation stack may be grown, a marker is set
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj **
-GrowEvaluationStack(
-    ExecEnv *eePtr,		/* Points to the ExecEnv with an evaluation
-				 * stack to enlarge. */
-    int growth,			/* How much larger than the current used
-				 * size. */
-    int move)			/* 1 if move words since last marker. */
-{
-    ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
-    int newBytes, newElems, currElems;
-    int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
-    Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
-    int moveWords = 0;
-
-    if (move) {
-	if (!markerPtr) {
-	    Tcl_Panic("STACK: Reallocating with no previous alloc");
-	}
-	if (needed <= 0) {
-	    return MEMSTART(markerPtr);
-	}
-    } else {
-	Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
-	int offset = OFFSET(tmpMarkerPtr);
-
-	if (needed + offset < 0) {
-	    /*
-	     * Put a marker pointing to the previous marker in this stack, and
-	     * store it in esPtr as the current marker. Return a pointer to
-	     * the start of aligned memory.
-	     */
-
-	    esPtr->markerPtr = tmpMarkerPtr;
-	    memStart = tmpMarkerPtr + offset;
-	    esPtr->tosPtr = memStart - 1;
-	    *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
-	    return memStart;
-	}
-    }
-
-    /*
-     * Reset move to hold the number of words to be moved to new stack (if
-     * any) and growth to hold the complete stack requirements: add one for
-     * the marker, (WALLOCALIGN-1) for the maximal possible offset.
-     */
-
-    if (move) {
-	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
-    }
-    needed = growth + moveWords + WALLOCALIGN;
-
-    /*
-     * Check if there is enough room in the next stack (if there is one, it
-     * should be both empty and the last one!)
-     */
-
-    if (esPtr->nextPtr) {
-	oldPtr = esPtr;
-	esPtr = oldPtr->nextPtr;
-	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
-	if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
-	    Tcl_Panic("STACK: Stack after current is in use");
-	}
-	if (esPtr->nextPtr) {
-	    Tcl_Panic("STACK: Stack after current is not last");
-	}
-	if (needed <= currElems) {
-	    goto newStackReady;
-	}
-	DeleteExecStack(esPtr);
-	esPtr = oldPtr;
-    } else {
-	currElems = esPtr->endPtr - &esPtr->stackWords[-1];
-    }
-
-    /*
-     * We need to allocate a new stack! It needs to store 'growth' words,
-     * including the elements to be copied over and the new marker.
-     */
-
-    newElems = 2*currElems;
-    while (needed > newElems) {
-	newElems *= 2;
-    }
-    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
-
-    oldPtr = esPtr;
-    esPtr = ckalloc(newBytes);
-
-    oldPtr->nextPtr = esPtr;
-    esPtr->prevPtr = oldPtr;
-    esPtr->nextPtr = NULL;
-    esPtr->endPtr = &esPtr->stackWords[newElems-1];
-
-  newStackReady:
-    eePtr->execStackPtr = esPtr;
-
-    /*
-     * Store a NULL marker at the beginning of the stack, to indicate that
-     * this is the first marker in this stack and that rewinding to here
-     * should actually be a return to the previous stack.
-     */
-
-    esPtr->stackWords[0] = NULL;
-    esPtr->markerPtr = &esPtr->stackWords[0];
-    memStart = MEMSTART(esPtr->markerPtr);
-    esPtr->tosPtr = memStart - 1;
-
-    if (move) {
-	memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
-	esPtr->tosPtr += moveWords;
-	oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
-	oldPtr->tosPtr = markerPtr-1;
-    }
-
-    /*
-     * Free the old stack if it is now unused.
-     */
-
-    if (!oldPtr->markerPtr) {
-	DeleteExecStack(oldPtr);
-    }
-
-    return memStart;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclStackAlloc, TclStackRealloc, TclStackFree --
- *
- *	Allocate memory from the execution stack; it has to be returned later
- *	with a call to TclStackFree.
- *
- * Results:
- *	A pointer to the first byte allocated, or panics if the allocation did
- *	not succeed.
- *
- * Side effects:
- *	The execution stack may be grown.
- *
- *--------------------------------------------------------------
- */
-
-static Tcl_Obj **
-StackAllocWords(
-    Tcl_Interp *interp,
-    int numWords)
-{
-    /*
-     * Note that GrowEvaluationStack sets a marker in the stack. This marker
-     * is read when rewinding, e.g., by TclStackFree.
-     */
-
-    Interp *iPtr = (Interp *) interp;
-    ExecEnv *eePtr = iPtr->execEnvPtr;
-    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
-
-    eePtr->execStackPtr->tosPtr += numWords;
-    return resPtr;
-}
-
-static Tcl_Obj **
-StackReallocWords(
-    Tcl_Interp *interp,
-    int numWords)
-{
-    Interp *iPtr = (Interp *) interp;
-    ExecEnv *eePtr = iPtr->execEnvPtr;
-    Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
-
-    eePtr->execStackPtr->tosPtr += numWords;
-    return resPtr;
-}
-
-void
-TclStackFree(
-    Tcl_Interp *interp,
-    void *freePtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    ExecEnv *eePtr;
-    ExecStack *esPtr;
-    Tcl_Obj **markerPtr, *marker;
-
-    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	Tcl_Free((char *) freePtr);
-	return;
-    }
-
-    /*
-     * Rewind the stack to the previous marker position. The current marker,
-     * as set in the last call to GrowEvaluationStack, contains a pointer to
-     * the previous marker.
-     */
-
-    eePtr = iPtr->execEnvPtr;
-    esPtr = eePtr->execStackPtr;
-    markerPtr = esPtr->markerPtr;
-    marker = *markerPtr;
-
-    if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
-	Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
-		freePtr, MEMSTART(markerPtr));
-    }
-
-    esPtr->tosPtr = markerPtr - 1;
-    esPtr->markerPtr = (Tcl_Obj **) marker;
-    if (marker) {
-	return;
-    }
-
-    /*
-     * Return to previous active stack. Note that repeated expansions or
-     * reallocs could have generated several unused intervening stacks: free
-     * them too.
-     */
-
-    while (esPtr->nextPtr) {
-	esPtr = esPtr->nextPtr;
-    }
-    esPtr->tosPtr = &esPtr->stackWords[-1];
-    while (esPtr->prevPtr) {
-	ExecStack *tmpPtr = esPtr->prevPtr;
-	if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
-	    DeleteExecStack(tmpPtr);
-	} else {
-	    break;
-	}
-    }
-    if (esPtr->prevPtr) {
-	eePtr->execStackPtr = esPtr->prevPtr;
-    } else {
-	eePtr->execStackPtr = esPtr;
-    }	
-}
-
-void *
-TclStackAlloc(
-    Tcl_Interp *interp,
-    int numBytes)
-{
-    Interp *iPtr = (Interp *) interp;
-    int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
-
-    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	return (void *) Tcl_Alloc(numBytes);
-    }
-
-    return (void *) StackAllocWords(interp, numWords);
-}
-
-void *
-TclStackRealloc(
-    Tcl_Interp *interp,
-    void *ptr,
-    int numBytes)
-{
-    Interp *iPtr = (Interp *) interp;
-    ExecEnv *eePtr;
-    ExecStack *esPtr;
-    Tcl_Obj **markerPtr;
-    int numWords;
-
-    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	return (void *) Tcl_Realloc((char *) ptr, numBytes);
-    }
-
-    eePtr = iPtr->execEnvPtr;
-    esPtr = eePtr->execStackPtr;
-    markerPtr = esPtr->markerPtr;
-
-    if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
-	Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
-    }
-
-    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
-    return (void *) StackReallocWords(interp, numWords);
-}
-
-/*
  *--------------------------------------------------------------
  *
  * Tcl_ExprObj --
@@ -1697,7 +1308,7 @@ TclCompileObj(
 		int redo = 0;
 
 		if (invoker) {
-		    CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
+		    CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame));
 		    *ctxPtr = *invoker;
 
 		    if (invoker->type == TCL_LOCATION_BC) {
@@ -1736,7 +1347,7 @@ TclCompileObj(
 				    && (ctxPtr->type == TCL_LOCATION_SOURCE));
 		    }
 
-		    TclStackFree(interp, ctxPtr);
+		    ckfree(ctxPtr);
 		}
 
 		if (redo) {
@@ -1921,9 +1532,8 @@ TclIncrObj(
  *----------------------------------------------------------------------
  */
 #define	bcFramePtr	(&TD->cmdFrame)
-#define	initCatchTop	((ptrdiff_t *) (&TD->stack[-1]))
-#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
-#define esPtr           (iPtr->execEnvPtr->execStackPtr)
+#define	catchStack	(TD->stack)
+#define	initTosPtr	((Tcl_Obj **) &TD->stack[codePtr->maxExceptDepth - 1])
 
 int
 TclNRExecuteByteCode(
@@ -1932,10 +1542,8 @@ TclNRExecuteByteCode(
 {
     Interp *iPtr = (Interp *) interp;
     TEBCdata *TD;
-    int size = sizeof(TEBCdata) -1 + 
-	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
-	         *(sizeof(void *));
-    int numWords = (size + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *);
+    unsigned int size = sizeof(TEBCdata) + sizeof(void *) *
+	  (codePtr->maxStackDepth + codePtr->maxExceptDepth - 1);       
     
     if (iPtr->execEnvPtr->rewind) {
 	return TCL_ERROR;
@@ -1955,15 +1563,16 @@ TclNRExecuteByteCode(
      * execution stack is large enough to execute this ByteCode.
      */
 
-    TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
-    esPtr->tosPtr = initTosPtr;
+    TD = ckalloc(size);
+    TD->tosPtr = initTosPtr;
     
     TD->codePtr     = codePtr;
     TD->pc          = codePtr->codeStart;
-    TD->catchTop    = initCatchTop;
+    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
@@ -2048,11 +1657,11 @@ TEBCresume(
 
     TEBCdata *TD = data[0];
 #define auxObjList	(TD->auxObjList)
-#define catchTop	(TD->catchTop)
+#define catchDepth	(TD->catchDepth)
 #define codePtr         (TD->codePtr)
 #define checkInterp	(TD->checkInterp)
                         /* Indicates when a check of interp readyness
-			 * is necessary. Set by CACHE_STACK_INFO() */
+			 * is necessary. Set by checkInterp = 1 */
 
     /*
      * Globals: variables that store state, must remain valid at all times.
@@ -2113,7 +1722,7 @@ TEBCresume(
 	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
 	}
 
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	if (result == TCL_OK) {
 #ifndef TCL_COMPILE_DEBUG
 	    if (*pc == INST_POP) {
@@ -2253,29 +1862,28 @@ TEBCresume(
      */
 
     if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
-	DECACHE_STACK_INFO();
 	if (TclAsyncReady(iPtr)) {
 	    result = Tcl_AsyncInvoke(interp, result);
 	    if (result == TCL_ERROR) {
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 		goto gotError;
 	    }
 	}
 
 	if (TclCanceled(iPtr)) {
 	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 		goto gotError;
 	    }
 	}
 
 	if (TclLimitReady(iPtr->limit)) {
 	    if (Tcl_LimitCheck(interp) == TCL_ERROR) {
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 		goto gotError;
 	    }
 	}
-	CACHE_STACK_INFO();
+	checkInterp = 1;
     }
 
     TCL_DTRACE_INST_NEXT();
@@ -2643,7 +2251,7 @@ TEBCresume(
 
     case INST_EXPAND_STKTOP: {
 	int i;
-	ptrdiff_t moved;
+	unsigned int reqWords;
 
 	/*
 	 * Make sure that the element at stackTop is a list; if not, just
@@ -2657,7 +2265,6 @@ TEBCresume(
 		    Tcl_GetObjResult(interp));
 	    goto gotError;
 	}
-	(void) POP_OBJECT();
 
 	/*
 	 * Make sure there is enough room in the stack to expand this list
@@ -2666,24 +2273,26 @@ TEBCresume(
 	 * stack depth, as seen by the compiler.
 	 */
 
-	length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
-	DECACHE_STACK_INFO();
-	moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
-		- (Tcl_Obj **) TD;
-	if (moved) {
-	    /*
-	     * Change the global data to point to the new stack: move the
-	     * TEBCdataPtr TD, recompute the position of every other
-	     * stack-allocated parameter, update the stack pointers.
-	     */
-
-	    esPtr = iPtr->execEnvPtr->execStackPtr;
-	    TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+	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;
 
-	    catchTop += moved;
-	    tosPtr += moved;
+	(void) POP_OBJECT();
+	if (reqWords > TD->capacity) {
+	    ptrdiff_t depth;
+	    unsigned int size = sizeof(TEBCdata) + sizeof(void *) *
+		+ (reqWords + codePtr->maxExceptDepth - 1);
+	    
+	    depth = tosPtr - initTosPtr;
+	    TD = ckrealloc(TD, size);
+	    tosPtr = initTosPtr + depth;
+	    TD->capacity = reqWords;
 	}
-
+	
 	/*
 	 * Expand the list at stacktop onto the stack; free the list. Knowing
 	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
@@ -2702,9 +2311,8 @@ TEBCresume(
 
 	bcFramePtr->data.tebc.pc = (char *) pc;
 	iPtr->cmdFramePtr = bcFramePtr;
-	DECACHE_STACK_INFO();
 	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	cleanup = 1;
 	pc++;
 	TEBC_YIELD();
@@ -2790,8 +2398,6 @@ TEBCresume(
 		    codePtr, bcFramePtr, pc - codePtr->codeStart);
 	}
 
-	DECACHE_STACK_INFO();
-
 	pc += pcAdjustment;
 	TEBC_YIELD();
 	return TclNREvalObjv(interp, objc, objv,
@@ -3016,10 +2622,9 @@ TEBCresume(
 	 * TclPtrGetVar to process fully.
 	 */
 
-	DECACHE_STACK_INFO();
 	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
 		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	if (!objResultPtr) {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    goto gotError;
@@ -3263,10 +2868,9 @@ TEBCresume(
 	part1Ptr = part2Ptr = NULL;
 
     doCallPtrSetVar:
-	DECACHE_STACK_INFO();
 	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
 		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	if (!objResultPtr) {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	    goto gotError;
@@ -3527,10 +3131,9 @@ TEBCresume(
 	    }
 	    Tcl_DecrRefCount(incrPtr);
 	} else {
-	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
 		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
 		TRACE_APPEND(("ERROR: %.30s\n",
@@ -3562,10 +3165,9 @@ TEBCresume(
 	}
 	TRACE(("%u => ", opnd));
 	if (ReadTraced(varPtr)) {
-	    DECACHE_STACK_INFO();
 	    TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
 		    TCL_TRACE_READS, 0, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    if (TclIsVarUndefined(varPtr)) {
 		TclCleanupVar(varPtr, NULL);
 		varPtr = NULL;
@@ -3598,10 +3200,9 @@ TEBCresume(
 		0, 1, arrayPtr, opnd);
 	if (varPtr) {
 	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
-		DECACHE_STACK_INFO();
 		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
 			TCL_TRACE_READS, 0, opnd);
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 	    }
 	    if (TclIsVarUndefined(varPtr)) {
 		TclCleanupVar(varPtr, arrayPtr);
@@ -3631,10 +3232,9 @@ TEBCresume(
 		/*createPart1*/0, /*createPart2*/1, &arrayPtr);
 	if (varPtr) {
 	    if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
-		DECACHE_STACK_INFO();
 		TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
 			TCL_TRACE_READS, 0, -1);
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 	    }
 	    if (TclIsVarUndefined(varPtr)) {
 		TclCleanupVar(varPtr, arrayPtr);
@@ -3678,12 +3278,11 @@ TEBCresume(
 	}
 
     slowUnsetScalar:
-	DECACHE_STACK_INFO();
 	if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
 		opnd) != TCL_OK && flags) {
 	    goto errorInUnset;
 	}
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	NEXT_INST_F(6, 0, 0);
 
     case INST_UNSET_ARRAY:
@@ -3720,7 +3319,6 @@ TEBCresume(
 	    }
 	}
     slowUnsetArray:
-	DECACHE_STACK_INFO();
 	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
 		0, 0, arrayPtr, opnd);
 	if (!varPtr) {
@@ -3731,7 +3329,7 @@ TEBCresume(
 		flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
 	    goto errorInUnset;
 	}
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	NEXT_INST_F(6, 1, 0);
 
     case INST_UNSET_ARRAY_STK:
@@ -3751,16 +3349,15 @@ TEBCresume(
 	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
 
     doUnsetStk:
-	DECACHE_STACK_INFO();
 	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
 		&& (flags & TCL_LEAVE_ERR_MSG)) {
 	    goto errorInUnset;
 	}
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	NEXT_INST_V(2, cleanup, 0);
 
     errorInUnset:
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
 	goto gotError;
 
@@ -3781,9 +3378,8 @@ TEBCresume(
 	    }
 	    varPtr->value.objPtr = NULL;
 	} else {
-	    DECACHE_STACK_INFO();
 	    TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	NEXT_INST_F(5, 0, 0);
     }
@@ -4024,18 +3620,16 @@ TEBCresume(
 	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();	    
+	    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")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, value2Ptr);
-	    CACHE_STACK_INFO();	    
+	    checkInterp = 1;	    
 	    goto gotError;
 	}
 
@@ -4812,9 +4406,8 @@ TEBCresume(
 	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
 		    O2S(value2Ptr), (valuePtr->typePtr?
 		    valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 
@@ -4823,9 +4416,8 @@ TEBCresume(
 	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
 		    O2S(value2Ptr), (value2Ptr->typePtr?
 		    value2Ptr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, value2Ptr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 
@@ -4883,11 +4475,10 @@ TEBCresume(
 		    Tcl_SetResult(interp, "negative shift argument",
 			    TCL_STATIC);
 #if 0
-		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 			    "domain error: argument not in valid range",
 			    NULL);
-		    CACHE_STACK_INFO();
+		    checkInterp = 1;
 #endif
 		    goto gotError;
 		} else if (l1 == 0) {
@@ -4931,11 +4522,10 @@ TEBCresume(
 		    Tcl_SetResult(interp, "negative shift argument",
 			    TCL_STATIC);
 #if 0
-		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 			    "domain error: argument not in valid range",
 			    NULL);
-		    CACHE_STACK_INFO();
+		    checkInterp = 1;
 #endif
 		    goto gotError;
 		} else if (l1 == 0) {
@@ -4955,10 +4545,9 @@ TEBCresume(
 			    "integer value too large to represent",
 			    TCL_STATIC);
 #if 0
-		    DECACHE_STACK_INFO();
 		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
 			    "integer value too large to represent", NULL);
-		    CACHE_STACK_INFO();
+		    checkInterp = 1;
 #endif
 		    goto gotError;
 		} else {
@@ -5041,9 +4630,8 @@ TEBCresume(
 	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
 		    O2S(value2Ptr), O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 
@@ -5062,9 +4650,8 @@ TEBCresume(
 	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
 		    O2S(value2Ptr), O2S(valuePtr),
 		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, value2Ptr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 
@@ -5211,9 +4798,8 @@ TEBCresume(
 	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 	/* TODO: Consider peephole opt. */
@@ -5231,9 +4817,8 @@ TEBCresume(
 
 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 	if (type1 == TCL_NUMBER_LONG) {
@@ -5258,9 +4843,8 @@ TEBCresume(
 		|| IsErroringNaNType(type1)) {
 	    TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
 		    (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
-	    DECACHE_STACK_INFO();
 	    IllegalExprOperandType(interp, pc, valuePtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    goto gotError;
 	}
 	switch (type1) {
@@ -5304,9 +4888,8 @@ TEBCresume(
 
 		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
-		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 		goto gotError;
 	    }
 
@@ -5322,9 +4905,8 @@ TEBCresume(
 
 		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
 			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
-		DECACHE_STACK_INFO();
 		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 	    } else {
 		/*
 		 * Numeric conversion of NaN -> error.
@@ -5332,9 +4914,8 @@ TEBCresume(
 
 		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
 			O2S(objResultPtr)));
-		DECACHE_STACK_INFO();
 		TclExprFloatError(interp, *((const double *) ptr1));
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 	    }
 	    goto gotError;
 	}
@@ -5379,9 +4960,8 @@ TEBCresume(
 
     case INST_BREAK:
 	/*
-	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	*/
 	result = TCL_BREAK;
 	cleanup = 0;
@@ -5389,9 +4969,8 @@ TEBCresume(
 
     case INST_CONTINUE:
 	/*
-	DECACHE_STACK_INFO();
 	Tcl_ResetResult(interp);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	*/
 	result = TCL_CONTINUE;
 	cleanup = 0;
@@ -5524,17 +5103,16 @@ TEBCresume(
 			    Tcl_IncrRefCount(valuePtr);
 			}
 		    } else {
-			DECACHE_STACK_INFO();
 			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
-			    CACHE_STACK_INFO();
+			    checkInterp = 1;
 			    TRACE_WITH_OBJ((
 				    "%u => ERROR init. index temp %d: ",
 				    opnd,varIndex), Tcl_GetObjResult(interp));
 			    TclDecrRefCount(listPtr);
 			    goto gotError;
 			}
-			CACHE_STACK_INFO();
+			checkInterp = 1;
 		    }
 		    valIndex++;
 		}
@@ -5566,19 +5144,18 @@ TEBCresume(
 	 * stack.
 	 */
 
-	*(++catchTop) = CURR_DEPTH;
-	TRACE(("%u => catchTop=%d, stackTop=%d\n",
-		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
+	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:
-	catchTop--;
-	DECACHE_STACK_INFO();
+	catchDepth--;
 	Tcl_ResetResult(interp);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	result = TCL_OK;
-	TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
+	TRACE(("=> catchDepth=%d\n", (int) (catchDepth)));
 	NEXT_INST_F(1, 0, 0);
 
     case INST_PUSH_RESULT:
@@ -5600,9 +5177,8 @@ TEBCresume(
 	NEXT_INST_F(1, 0, 1);
 
     case INST_PUSH_RETURN_OPTIONS:
-	DECACHE_STACK_INFO();
 	objResultPtr = Tcl_GetReturnOptions(interp, result);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
@@ -5654,13 +5230,12 @@ TEBCresume(
 		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 		NEXT_INST_V(5, opnd+1, 1);
 	    }
-	    DECACHE_STACK_INFO();
 	    Tcl_ResetResult(interp);
 	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
 		    "\" not known in dictionary", NULL);
 	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
 		    TclGetString(OBJ_AT_TOS), NULL);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
 	} else {
 	    TRACE_WITH_OBJ((
@@ -5683,9 +5258,8 @@ TEBCresume(
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
-	    DECACHE_STACK_INFO();
 	    dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	if (dictPtr == NULL) {
 	    TclNewObj(dictPtr);
@@ -5757,10 +5331,9 @@ TEBCresume(
 	    objResultPtr = dictPtr;
 	} else {
 	    Tcl_IncrRefCount(dictPtr);
-	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
 		TRACE_APPEND(("ERROR: %.30s\n",
@@ -5787,9 +5360,8 @@ TEBCresume(
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
-	    DECACHE_STACK_INFO();
 	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	if (dictPtr == NULL) {
 	    TclNewObj(dictPtr);
@@ -5893,10 +5465,9 @@ TEBCresume(
 	    objResultPtr = dictPtr;
 	} else {
 	    Tcl_IncrRefCount(dictPtr);
-	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    TclDecrRefCount(dictPtr);
 	    if (objResultPtr == NULL) {
 		TRACE_APPEND(("ERROR: %.30s\n",
@@ -5998,10 +5569,9 @@ TEBCresume(
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
-	    DECACHE_STACK_INFO();
 	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
 		    TCL_LEAVE_ERR_MSG, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    if (dictPtr == NULL) {
 		goto gotError;
 	    }
@@ -6022,7 +5592,6 @@ TEBCresume(
 	    while (TclIsVarLink(varPtr)) {
 		varPtr = varPtr->value.linkPtr;
 	    }
-	    DECACHE_STACK_INFO();
 	    if (valuePtr == NULL) {
 		TclObjUnsetVar2(interp,
 			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
@@ -6030,10 +5599,10 @@ TEBCresume(
 	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 		    valuePtr, TCL_LEAVE_ERR_MSG,
 		    duiPtr->varIndices[i]) == NULL) {
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 		goto gotError;
 	    }
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	NEXT_INST_F(9, 0, 0);
 
@@ -6049,9 +5618,8 @@ TEBCresume(
 	if (TclIsVarDirectReadable(varPtr)) {
 	    dictPtr = varPtr->value.objPtr;
 	} else {
-	    DECACHE_STACK_INFO();
 	    dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	if (dictPtr == NULL) {
 	    NEXT_INST_F(9, 1, 0);
@@ -6077,10 +5645,9 @@ TEBCresume(
 	    if (TclIsVarDirectReadable(var2Ptr)) {
 		valuePtr = var2Ptr->value.objPtr;
 	    } else {
-		DECACHE_STACK_INFO();
 		valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
 			duiPtr->varIndices[i]);
-		CACHE_STACK_INFO();
+		checkInterp = 1;
 	    }
 	    if (valuePtr == NULL) {
 		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
@@ -6096,10 +5663,9 @@ TEBCresume(
 	    TclDecrRefCount(varPtr->value.objPtr);
 	    varPtr->value.objPtr = dictPtr;
 	} else {
-	    DECACHE_STACK_INFO();
 	    objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
 		    dictPtr, TCL_LEAVE_ERR_MSG, opnd);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	    if (objResultPtr == NULL) {
 		if (allocdict) {
 		    TclDecrRefCount(dictPtr);
@@ -6215,10 +5781,9 @@ TEBCresume(
 	 */
 
     divideByZero:
-	DECACHE_STACK_INFO();	
 	Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
 	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
-	CACHE_STACK_INFO();	
+	checkInterp = 1;	
 	goto gotError;
 
 	/*
@@ -6227,12 +5792,11 @@ TEBCresume(
 	 */
 
     exponOfZero:
-	DECACHE_STACK_INFO();	
 	Tcl_SetResult(interp, "exponentiation of zero by negative power",
 		TCL_STATIC);
 	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
 		"exponentiation of zero by negative power", NULL);
-	CACHE_STACK_INFO();
+	checkInterp = 1;
 
 	/*
 	 * Almost all error paths feed through here rather than assigning to
@@ -6258,9 +5822,8 @@ TEBCresume(
 	    const unsigned char *pcBeg;
 
 	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
-	    DECACHE_STACK_INFO();
 	    TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr);
-	    CACHE_STACK_INFO();
+	    checkInterp = 1;
 	}
 	iPtr->flags &= ~ERR_ALREADY_LOGGED;
 
@@ -6270,8 +5833,8 @@ TEBCresume(
 	 */
 
 	while (auxObjList) {
-	    if ((catchTop != initCatchTop) && (*catchTop >
-		    (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1)) {
+	    if ((catchDepth >=0) && (PTR2INT(catchStack[catchDepth]) >
+		        PTR2INT(auxObjList->internalRep.twoPtrValue.ptr1))) {
 		break;
 	    }
 	    POP_TAUX_OBJ();
@@ -6311,7 +5874,7 @@ TEBCresume(
 #endif
 	    goto abnormalReturn;
 	}
-	if (catchTop == initCatchTop) {
+	if (catchDepth == -1) {
 #ifdef TCL_COMPILE_DEBUG
 	    if (traceInstructions) {
 		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
@@ -6346,16 +5909,16 @@ TEBCresume(
 	 */
 
     processCatch:
-	while (CURR_DEPTH > *catchTop) {
+	while (CURR_DEPTH > PTR2INT(catchStack[catchDepth])) {
 	    valuePtr = POP_OBJECT();
 	    TclDecrRefCount(valuePtr);
 	}
 #ifdef TCL_COMPILE_DEBUG
 	if (traceInstructions) {
-	    fprintf(stdout, "  ... found catch at %d, catchTop=%d, "
+	    fprintf(stdout, "  ... found catch at %d, catchDepth=%d, "
 		    "unwound to %ld, new pc %u\n",
-		    rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
-		    (long) *catchTop, (unsigned) rangePtr->catchOffset);
+		    rangePtr->codeOffset, (int) catchDepth,
+		    PTR2INT(catchStack[catchDepth]), (unsigned) rangePtr->catchOffset);
 	}
 #endif
 	pc = (codePtr->codeStart + rangePtr->catchOffset);
@@ -6404,7 +5967,7 @@ TEBCresume(
     if (--codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
-    TclStackFree(interp, TD);	/* free my stack */
+    ckfree(TD);	/* free my stack */
 
     return result;
 }
@@ -6412,10 +5975,9 @@ TEBCresume(
 #undef codePtr
 #undef iPtr
 #undef bcFramePtr
-#undef initCatchTop
 #undef initTosPtr
 #undef auxObjList
-#undef catchTop
+#undef catchDepth
 #undef TCONST
 
 /*
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 6d3c013..52ad278 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -999,7 +999,7 @@ TclFileAttrsCmd(
 	    goto end;
 	}
 	attributeStringsAllocated = (const char **)
-		TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
+		ckalloc((1+numObjStrings) * sizeof(char *));
 	for (index = 0; index < numObjStrings; index++) {
 	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
 	    attributeStringsAllocated[index] = TclGetString(objPtr);
@@ -1110,7 +1110,7 @@ TclFileAttrsCmd(
 	 * Free up the array we allocated.
 	 */
 
-	TclStackFree(interp, (void *) attributeStringsAllocated);
+	ckfree((void *) attributeStringsAllocated);
 
 	/*
 	 * We don't need this object that was passed to us any more.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index d53c271..eff1010 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1422,7 +1422,7 @@ Tcl_GlobObjCmd(
 	if (length <= 0) {
 	    goto skipTypes;
 	}
-	globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
+	globTypes = ckalloc(sizeof(Tcl_GlobTypeData));
 	globTypes->type = 0;
 	globTypes->perm = 0;
 	globTypes->macType = NULL;
@@ -1638,7 +1638,7 @@ Tcl_GlobObjCmd(
 	if (globTypes->macCreator != NULL) {
 	    Tcl_DecrRefCount(globTypes->macCreator);
 	}
-	TclStackFree(interp, globTypes);
+	ckfree(globTypes);
     }
     return result;
 }
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 1f0e4a9..ffa172a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -929,7 +929,7 @@ Tcl_ExecObjCmd(
      */
 
     argc = objc - skip;
-    argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+    argv = ckalloc((unsigned)(argc + 1) * sizeof(char *));
 
     /*
      * Copy the string conversions of each (post option) object into the
@@ -947,7 +947,7 @@ Tcl_ExecObjCmd(
      * Free the argv array.
      */
 
-    TclStackFree(interp, (void *) argv);
+    ckfree((void *) argv);
 
     if (chan == NULL) {
 	return TCL_ERROR;
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index d98842e..f9511af 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -952,12 +952,12 @@ Tcl_WrongNumArgs(
 	    len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
 
 	    if (MAY_QUOTE_WORD && len != elemLen) {
-		char *quotedElementStr = TclStackAlloc(interp, (unsigned)len);
+		char *quotedElementStr = ckalloc((unsigned)len);
 
 		len = Tcl_ConvertCountedElement(elementStr, elemLen,
 			quotedElementStr, flags);
 		Tcl_AppendToObj(objPtr, quotedElementStr, len);
-		TclStackFree(interp, quotedElementStr);
+		ckfree(quotedElementStr);
 	    } else {
 		Tcl_AppendToObj(objPtr, elementStr, elemLen);
 	    }
@@ -1006,12 +1006,12 @@ Tcl_WrongNumArgs(
 	    len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
 
 	    if (MAY_QUOTE_WORD && len != elemLen) {
-		char *quotedElementStr = TclStackAlloc(interp,(unsigned) len);
+		char *quotedElementStr = ckalloc((unsigned) len);
 
 		len = Tcl_ConvertCountedElement(elementStr, elemLen,
 			quotedElementStr, flags);
 		Tcl_AppendToObj(objPtr, quotedElementStr, len);
-		TclStackFree(interp, quotedElementStr);
+		ckfree(quotedElementStr);
 	    } else {
 		Tcl_AppendToObj(objPtr, elementStr, elemLen);
 	    }
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index df60dae..6330836 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -35,9 +35,9 @@ scspec EXTERN
 #declare 2 {
 #    int TclAccessInsertProc(TclAccessProc_ *proc)
 #}
-declare 3 {
-    void TclAllocateFreeObjects(void)
-}
+#declare 3 {
+#    void TclAllocateFreeObjects(void)
+#}
 # Replaced by TclpChdir in 8.1:
 #  declare 4 {
 #      int TclChdir(Tcl_Interp *interp, char *dirName)
@@ -867,12 +867,12 @@ declare 213 {
 declare 214 {
     void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
 }
-declare 215 {
-    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
-}
-declare 216 {
-    void TclStackFree(Tcl_Interp *interp, void *freePtr)
-}
+#declare 215 {
+#    void *TclStackAlloc(Tcl_Interp *interp, unsigned int numBytes)
+#}
+#declare 216 {
+#    void TclStackFree(Tcl_Interp *interp, void *freePtr)
+#}
 declare 217 {
     int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
             Tcl_Namespace *namespacePtr, int isProcCallFrame)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 42e2212..45eaf7e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -10,7 +10,7 @@
  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
- * Copyright (c) 2008 by Miguel Sofer. All rights reserved.
+ * Copyright (c) 2008-2011 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.
@@ -1390,13 +1390,6 @@ MODULE_SCOPE void	TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
   (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
 
 /*
- *----------------------------------------------------------------
- * Data structures related to bytecode compilation and execution. These are
- * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c.
- *----------------------------------------------------------------
- */
-
-/*
  * Forward declaration to prevent errors when the forward references to
  * Tcl_Parse and CompileEnv are encountered in the procedure type CompileProc
  * declared below.
@@ -1438,19 +1431,6 @@ typedef int (CompileHookProc)(Tcl_Interp *interp,
 	struct CompileEnv *compEnvPtr, ClientData clientData);
 
 /*
- * The data structure for a (linked list of) execution stacks.
- */
-
-typedef struct ExecStack {
-    struct ExecStack *prevPtr;
-    struct ExecStack *nextPtr;
-    Tcl_Obj **markerPtr;
-    Tcl_Obj **endPtr;
-    Tcl_Obj **tosPtr;
-    Tcl_Obj *stackWords[1];
-} ExecStack;
-
-/*
  * The data structure defining the execution environment for ByteCode's.
  * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
  * stack that holds command operands and results. The stack grows towards
@@ -1487,8 +1467,6 @@ typedef struct CoroutineData {
 } CoroutineData;
 
 typedef struct ExecEnv {
-    ExecStack *execStackPtr;	/* Points to the first item in the evaluation
-				 * stack on the heap. */
     Tcl_Obj *constants[2];	/* Pointers to constant "0" and "1" objs. */
     struct Tcl_Interp *interp;
     struct NRE_callback *callbackPtr;
@@ -1769,24 +1747,6 @@ enum PkgPreferOptions {
 
 /*
  *----------------------------------------------------------------
- * This structure shadows the first few fields of the memory cache for the
- * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
- * definition there.
- * Some macros require knowledge of some fields in the struct in order to
- * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the objCache field in struct Interp.
- *----------------------------------------------------------------
- */
-
-typedef struct AllocCache {
-    struct Cache *nextPtr;	/* Linked list of cache entries. */
-    Tcl_ThreadId owner;		/* Which thread's cache is this? */
-    Tcl_Obj *firstObjPtr;	/* List of free objects for thread. */
-    int numObjects;		/* Number of objects for thread. */
-} AllocCache;
-
-/*
- *----------------------------------------------------------------
  * This structure defines an interpreter, which is a collection of commands
  * plus other state information related to interpreting commands, such as
  * variable storage. Primary responsibility for this data structure is in
@@ -2118,7 +2078,6 @@ typedef struct Interp {
      * They are used by the macros defined below.
      */
 
-    AllocCache *allocCache;
     void *pendingObjDataPtr;	/* Pointer to the Cache and PendingObjData
 				 * structs for this interp's thread; see
 				 * tclObj.c and tclThreadAlloc.c */
@@ -2351,17 +2310,6 @@ struct LimitHandler {
 #define UCHAR(c) ((unsigned char) (c))
 
 /*
- * This macro is used to properly align the memory allocated by Tcl, giving
- * the same alignment as the native malloc.
- */
-
-#if defined(__APPLE__)
-#define TCL_ALLOCALIGN	16
-#else
-#define TCL_ALLOCALIGN	(2*sizeof(void *))
-#endif
-
-/*
  * This macro is used to determine the offset needed to safely allocate any
  * data structure in memory. Given a starting offset or size, it "rounds up"
  * or "aligns" the offset to the next 8-byte boundary so that any data
@@ -2902,7 +2850,6 @@ MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
 			    ClientData clientData);
 MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
 			    ClientData clientData);
-MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
 MODULE_SCOPE void	TclFinalizeAsync(void);
 MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
 MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
@@ -2919,7 +2866,6 @@ MODULE_SCOPE void	TclFinalizeNotifier(void);
 MODULE_SCOPE void	TclFinalizeObjects(void);
 MODULE_SCOPE void	TclFinalizePreserve(void);
 MODULE_SCOPE void	TclFinalizeSynchronization(void);
-MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
 MODULE_SCOPE void	TclFinalizeThreadData(void);
 MODULE_SCOPE void	TclFinalizeThreadObjects(void);
 MODULE_SCOPE double	TclFloor(const mp_int *a);
@@ -3097,8 +3043,6 @@ MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 			    Tcl_Obj *newValue, Tcl_Encoding encoding);
 MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
-MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
-			    int numBytes);
 MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
 			    const char *pattern, int ptnLen, int flags);
 MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
@@ -3808,10 +3752,10 @@ typedef const char *TclDTraceStr;
 #endif /* TCL_COMPILE_STATS */
 
 #  define TclAllocObjStorage(objPtr)		\
-	TclAllocObjStorageEx(NULL, (objPtr))
+    (objPtr) = TclSmallAlloc()
 
 #  define TclFreeObjStorage(objPtr)		\
-	TclFreeObjStorageEx(NULL, (objPtr))
+    TclSmallFree(objPtr)
 
 #ifndef TCL_MEM_DEBUG
 # define TclNewObj(objPtr) \
@@ -3846,128 +3790,122 @@ typedef const char *TclDTraceStr;
 	} \
     }
 
-#if defined(PURIFY)
+#else /* TCL_MEM_DEBUG */
+MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
+			    int line);
 
-/*
- * The PURIFY mode is like the regular mode, but instead of doing block
- * Tcl_Obj allocation and keeping a freed list for efficiency, it always
- * allocates and frees a single Tcl_Obj so that tools like Purify can better
- * track memory leaks.
- */
+# define TclDbNewObj(objPtr, file, line) \
+    do { \
+	TclIncrObjsAllocated();						\
+	(objPtr) = (Tcl_Obj *)						\
+		Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line));		\
+	TclDbInitNewObj((objPtr), (file), (line));			\
+	TCL_DTRACE_OBJ_CREATE(objPtr);					\
+    } while (0)
 
-#  define TclAllocObjStorageEx(interp, objPtr) \
-	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+# define TclNewObj(objPtr) \
+    TclDbNewObj(objPtr, __FILE__, __LINE__);
 
-#  define TclFreeObjStorageEx(interp, objPtr) \
-	ckfree((char *) (objPtr))
+# define TclDecrRefCount(objPtr) \
+    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
 
-#undef USE_THREAD_ALLOC
-#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+# define TclNewListObjDirect(objc, objv) \
+    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)
+
+#endif /* TCL_MEM_DEBUG */
 
 /*
+ * Macros that drive the allocator behaviour
+ */
+
+#if defined(TCL_THREADS)
+/*
  * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
  * per-thread caches.
  */
-
-MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
-MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
-MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
-MODULE_SCOPE void	TclFreeAllocCache(void *);
+MODULE_SCOPE void	TclpFreeAllocCache(void *);
 MODULE_SCOPE void *	TclpGetAllocCache(void);
 MODULE_SCOPE void	TclpSetAllocCache(void *);
+MODULE_SCOPE void	TclFreeAllocCache(void *);
 MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
-MODULE_SCOPE void	TclpFreeAllocCache(void *);
+MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
+#endif
 
 /*
- * These macros need to be kept in sync with the code of TclThreadAllocObj()
- * and TclThreadFreeObj().
- *
- * Note that the optimiser should resolve the case (interp==NULL) at compile
- * time.
+ * List of valid allocators. Have to respect the following convention:
+ *  - allocators that shunt TclpAlloc to malloc are below aNONE
+ *  - allocators that use zippy are above aNONE
  */
 
-#  define ALLOC_NOBJHIGH 1200
+#define aNATIVE    0
+#define aPURIFY    1
+#define aNONE      2 
+#define aZIPPY     3
+#define aMULTI     4
 
-#  define TclAllocObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects == 0))) {			\
-	    (objPtr) = TclThreadAllocObj();				\
-	} else {							\
-	    (objPtr) = cachePtr->firstObjPtr;				\
-	    cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \
-	    --cachePtr->numObjects;					\
-	}								\
-    } while (0)
-
-#  define TclFreeObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects >= ALLOC_NOBJHIGH))) {	\
-	    TclThreadFreeObj(objPtr);					\
-	} else {							\
-	    (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \
-	    cachePtr->firstObjPtr = objPtr;				\
-	    ++cachePtr->numObjects;					\
-	}								\
-    } while (0)
-
-#else /* not PURIFY or USE_THREAD_ALLOC */
+#if defined(TCL_ALLOCATOR) && ((TCL_ALLOCATOR < 0) || (TCL_ALLOCATOR > aMULTI))
+#undef TCL_ALLOCATOR
+#endif
 
-#ifdef TCL_THREADS
-/* declared in tclObj.c */
-MODULE_SCOPE Tcl_Mutex	tclObjMutex;
+#ifdef PURIFY
+#  undef TCL_ALLOCATOR
+#  define TCL_ALLOCATOR aPURIFY
 #endif
 
-#  define TclAllocObjStorageEx(interp, objPtr) \
-    do {								\
-	Tcl_MutexLock(&tclObjMutex);					\
-	if (tclFreeObjList == NULL) {					\
-	    TclAllocateFreeObjects();					\
-	}								\
-	(objPtr) = tclFreeObjList;					\
-	tclFreeObjList = (Tcl_Obj *)					\
-		tclFreeObjList->internalRep.otherValuePtr;		\
-	Tcl_MutexUnlock(&tclObjMutex);					\
-    } while (0)
+#if !defined(TCL_ALLOCATOR)
+#  if defined(USE_THREAD_ALLOC) || defined(USE_TCLALLOC)
+#    define TCL_ALLOCATOR aZIPPY
+#  else
+#    define TCL_ALLOCATOR aNATIVE
+#  endif
+#endif
 
-#  define TclFreeObjStorageEx(interp, objPtr) \
-    do {							       \
-	Tcl_MutexLock(&tclObjMutex);				       \
-	(objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \
-	tclFreeObjList = (objPtr);				       \
-	Tcl_MutexUnlock(&tclObjMutex);				       \
-    } while (0)
+#if TCL_ALLOCATOR < aNONE /* native or purify */
+#    define TclpAlloc(size) ckalloc(size)
+#    define TclpRealloc(ptr, size) ckrealloc((ptr),(size))
+#    define TclpFree(size) ckfree(size)
+#else
+   MODULE_SCOPE char * TclpAlloc(unsigned int size);
+   MODULE_SCOPE char * TclpRealloc(char * ptr, unsigned int size);
+   MODULE_SCOPE void   TclpFree(char * ptr);
 #endif
 
-#else /* TCL_MEM_DEBUG */
-MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
-			    int line);
+#if TCL_ALLOCATOR == aPURIFY
+#  define TclSmallAlloc() ckalloc(sizeof(Tcl_Obj))
+#  define TclSmallFree(ptr) ckfree(ptr)
+#  define TclInitAlloc()
+#  define TclFinalizeAlloc()
+#else
+   MODULE_SCOPE void * TclSmallAlloc();
+   MODULE_SCOPE void   TclSmallFree(void *ptr);
+   MODULE_SCOPE void   TclInitAlloc(void);
+   MODULE_SCOPE void   TclFinalizeAlloc(void);
+#endif
 
-# define TclDbNewObj(objPtr, file, line) \
-    do { \
-	TclIncrObjsAllocated();						\
-	(objPtr) = (Tcl_Obj *)						\
-		Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line));		\
-	TclDbInitNewObj((objPtr), (file), (line));			\
-	TCL_DTRACE_OBJ_CREATE(objPtr);					\
+#define TclCkSmallAlloc(nbytes, memPtr)					\
+    do {								\
+	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
+	memPtr = TclSmallAlloc();					\
     } while (0)
 
-# define TclNewObj(objPtr) \
-    TclDbNewObj(objPtr, __FILE__, __LINE__);
+/*
+ * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
+ */
 
-# define TclDecrRefCount(objPtr) \
-    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#if (TCL_ALLOCATOR == aPURIFY) && defined(__clang__)
+#if __has_feature(attribute_analyzer_noreturn) && \
+       !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
+void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
+#endif
+#if !defined(CLANG_ASSERT)
+#include <assert.h>
+#define CLANG_ASSERT(x) assert(x)
+#endif
+#elif !defined(CLANG_ASSERT)
+ #define CLANG_ASSERT(x)
+#endif /* PURIFY && __clang__ */
 
-# define TclNewListObjDirect(objc, objv) \
-    TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__)
 
-#undef USE_THREAD_ALLOC
-#endif /* TCL_MEM_DEBUG */
 
 /*
  *----------------------------------------------------------------
@@ -4471,73 +4409,11 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
     {enum { ct_assert_value = 1/(!!(e)) };}
 
 /*
- *----------------------------------------------------------------
- * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
- * Only checked at compile time.
- *
- * ONLY USE FOR CONSTANT nBytes.
- *
- * DO NOT LET THEM CROSS THREAD BOUNDARIES
- *----------------------------------------------------------------
- */
-
-#define TclSmallAlloc(nbytes, memPtr) \
-    TclSmallAllocEx(NULL, (nbytes), (memPtr))
-
-#define TclSmallFree(memPtr) \
-    TclSmallFreeEx(NULL, (memPtr))
-
-#ifndef TCL_MEM_DEBUG
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr;						\
-	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
-	TclIncrObjsAllocated();						\
-	TclAllocObjStorageEx((interp), (objPtr));			\
-	memPtr = (ClientData) (objPtr);					\
-    } while (0)
-
-#define TclSmallFreeEx(interp, memPtr) \
-    do {								\
-	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
-	TclIncrObjsFreed();						\
-    } while (0)
-
-#else    /* TCL_MEM_DEBUG */
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr;						\
-	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
-	TclNewObj(objPtr);						\
-	memPtr = (ClientData) objPtr;					\
-    } while (0)
-
-#define TclSmallFreeEx(interp, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr = (Tcl_Obj *) memPtr;				\
-	objPtr->bytes = NULL;						\
-	objPtr->typePtr = NULL;						\
-	objPtr->refCount = 1;						\
-	TclDecrRefCount(objPtr);					\
-    } while (0)
-#endif   /* TCL_MEM_DEBUG */
-
-/*
  * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
  */
 
-#if defined(PURIFY) && defined(__clang__)
-#if __has_feature(attribute_analyzer_noreturn) && \
-	!defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
-void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
-#endif
-#if !defined(CLANG_ASSERT)
-#include <assert.h>
-#define CLANG_ASSERT(x) assert(x)
-#endif
-#elif !defined(CLANG_ASSERT)
 #define CLANG_ASSERT(x)
-#endif /* PURIFY && __clang__ */
+
 
 /*
  *----------------------------------------------------------------
@@ -4610,8 +4486,8 @@ typedef struct NRE_callback {
 
 #if NRE_USE_SMALL_ALLOC
 #define TCLNR_ALLOC(interp, ptr) \
-    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
-#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
+    TclCkSmallAlloc(sizeof(NRE_callback), (ptr))
+#define TCLNR_FREE(interp, ptr)  TclSmallFree(ptr)
 #else
 #define TCLNR_ALLOC(interp, ptr) \
     (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index b294e4f..0966d32 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -58,8 +58,7 @@
 /* Slot 0 is reserved */
 /* Slot 1 is reserved */
 /* Slot 2 is reserved */
-/* 3 */
-EXTERN void		TclAllocateFreeObjects(void);
+/* Slot 3 is reserved */
 /* Slot 4 is reserved */
 /* 5 */
 EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
@@ -506,10 +505,8 @@ EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
 /* 214 */
 EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
 				Tcl_Encoding encoding);
-/* 215 */
-EXTERN void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
-/* 216 */
-EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
+/* Slot 215 is reserved */
+/* Slot 216 is reserved */
 /* 217 */
 EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
 				Tcl_CallFrame **framePtrPtr,
@@ -609,7 +606,7 @@ typedef struct TclIntStubs {
     void (*reserved0)(void);
     void (*reserved1)(void);
     void (*reserved2)(void);
-    void (*tclAllocateFreeObjects) (void); /* 3 */
+    void (*reserved3)(void);
     void (*reserved4)(void);
     int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
     void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
@@ -821,8 +818,8 @@ typedef struct TclIntStubs {
     void (*tclpFindExecutable) (const char *argv0); /* 212 */
     Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
     void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
-    void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
-    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
+    void (*reserved215)(void);
+    void (*reserved216)(void);
     int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
     void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
     void (*reserved219)(void);
@@ -876,8 +873,7 @@ extern const TclIntStubs *tclIntStubsPtr;
 /* Slot 0 is reserved */
 /* Slot 1 is reserved */
 /* Slot 2 is reserved */
-#define TclAllocateFreeObjects \
-	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
+/* Slot 3 is reserved */
 /* Slot 4 is reserved */
 #define TclCleanupChildren \
 	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
@@ -1216,10 +1212,8 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
 #define TclSetObjNameOfExecutable \
 	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
-#define TclStackAlloc \
-	(tclIntStubsPtr->tclStackAlloc) /* 215 */
-#define TclStackFree \
-	(tclIntStubsPtr->tclStackFree) /* 216 */
+/* Slot 215 is reserved */
+/* Slot 216 is reserved */
 #define TclPushStackFrame \
 	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
 #define TclPopStackFrame \
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 67761ed..46a5f42 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1169,7 +1169,7 @@ Tcl_CreateAlias(
     int i;
     int result;
 
-    objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
+    objv = ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
     for (i = 0; i < argc; i++) {
 	objv[i] = Tcl_NewStringObj(argv[i], -1);
 	Tcl_IncrRefCount(objv[i]);
@@ -1187,7 +1187,7 @@ Tcl_CreateAlias(
     for (i = 0; i < argc; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
-    TclStackFree(slaveInterp, objv);
+    ckfree(objv);
     Tcl_DecrRefCount(targetObjPtr);
     Tcl_DecrRefCount(slaveObjPtr);
 
@@ -1863,7 +1863,7 @@ AliasObjCmd(
     if (cmdc <= ALIAS_CMDV_PREALLOC) {
 	cmdv = cmdArr;
     } else {
-	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
+	cmdv = ckalloc(cmdc * sizeof(Tcl_Obj *));
     }
 
     prefv = &aliasPtr->objPtr;
@@ -1930,7 +1930,7 @@ AliasObjCmd(
 	Tcl_DecrRefCount(cmdv[i]);
     }
     if (cmdv != cmdArr) {
-	TclStackFree(interp, cmdv);
+	ckfree(cmdv);
     }
     return result;
 #undef ALIAS_CMDV_PREALLOC
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index ad233b9..08a9443 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -465,7 +465,7 @@ TclPushStackFrame(
 				 * treated as references to namespace
 				 * variables. */
 {
-    *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame));
+    *framePtrPtr = ckalloc(sizeof(CallFrame));
     return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
 	    isProcCallFrame);
 }
@@ -477,7 +477,7 @@ TclPopStackFrame(
     CallFrame *freePtr = ((Interp *) interp)->framePtr;
 
     Tcl_PopCallFrame(interp);
-    TclStackFree(interp, freePtr);
+    ckfree(freePtr);
 }
 
 /*
@@ -2632,8 +2632,7 @@ TclResetShadowedCmdRefs(
     int found, i;
     int trailFront = -1;
     int trailSize = 5;		/* Formerly NUM_TRAIL_ELEMS. */
-    Namespace **trailPtr = TclStackAlloc(interp,
-	    trailSize * sizeof(Namespace *));
+    Namespace **trailPtr = ckalloc(trailSize * sizeof(Namespace *));
 
     /*
      * Start at the namespace containing the new command, and work up through
@@ -2722,13 +2721,12 @@ TclResetShadowedCmdRefs(
 	if (trailFront == trailSize) {
 	    int newSize = 2 * trailSize;
 
-	    trailPtr = TclStackRealloc(interp, trailPtr,
-		    newSize * sizeof(Namespace *));
+	    trailPtr = ckrealloc(trailPtr, newSize * sizeof(Namespace *));
 	    trailSize = newSize;
 	}
 	trailPtr[trailFront] = nsPtr;
     }
-    TclStackFree(interp, trailPtr);
+    ckfree(trailPtr);
 }
 
 /*
@@ -3970,8 +3968,7 @@ NamespacePathCmd(
 	goto badNamespace;
     }
     if (nsObjc != 0) {
-	namespaceList = TclStackAlloc(interp,
-		sizeof(Tcl_Namespace *) * nsObjc);
+	namespaceList = ckalloc(sizeof(Tcl_Namespace *) * nsObjc);
 
 	for (i=0 ; i<nsObjc ; i++) {
 	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
@@ -3990,7 +3987,7 @@ NamespacePathCmd(
     result = TCL_OK;
   badNamespace:
     if (namespaceList != NULL) {
-	TclStackFree(interp, namespaceList);
+	ckfree(namespaceList);
     }
     return result;
 }
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 1e8d1a3..8814819 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -104,7 +104,7 @@ TclOODeleteContext(
     register Object *oPtr = contextPtr->oPtr;
 
     TclOODeleteChain(contextPtr->callPtr);
-    TclStackFree(oPtr->fPtr->interp, contextPtr);
+    ckfree(contextPtr);
     DelRef(oPtr);
 }
 
@@ -1087,7 +1087,7 @@ TclOOGetCallContext(
     }
 
   returnContext:
-    contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
+    contextPtr = ckalloc(sizeof(CallContext));
     contextPtr->oPtr = oPtr;
     AddRef(oPtr);
     contextPtr->callPtr = callPtr;
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 8d8eb85..cc3a0ad 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -455,7 +455,7 @@ TclOOUnknownDefinition(
 	 * Got one match, and only one match!
 	 */
 
-	Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
+	Tcl_Obj **newObjv = ckalloc(sizeof(Tcl_Obj*)*(objc-1));
 	int result;
 
 	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
@@ -465,7 +465,7 @@ TclOOUnknownDefinition(
 	}
 	result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
 	Tcl_DecrRefCount(newObjv[0]);
-	TclStackFree(interp, newObjv);
+	ckfree(newObjv);
 	return result;
     }
 
@@ -1546,7 +1546,7 @@ TclOODefineMixinObjCmd(
 	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
 	return TCL_ERROR;
     }
-    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
+    mixins = ckalloc(sizeof(Class *) * (objc-1));
 
     for (i=1 ; i<objc ; i++) {
 	Class *clsPtr = GetClassInOuterContext(interp, objv[i],
@@ -1568,11 +1568,11 @@ TclOODefineMixinObjCmd(
 	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
     }
 
-    TclStackFree(interp, mixins);
+    ckfree(mixins);
     return TCL_OK;
 
   freeAndError:
-    TclStackFree(interp, mixins);
+    ckfree(mixins);
     return TCL_ERROR;
 }
 
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 112d663..0996eab 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -686,7 +686,7 @@ InvokeProcedureMethod(
      * Allocate the special frame data.
      */
 
-    fdPtr = TclStackAlloc(interp, sizeof(PMFrameData));
+    fdPtr = ckalloc(sizeof(PMFrameData));
 
     /*
      * Create a call frame for this method.
@@ -695,7 +695,7 @@ InvokeProcedureMethod(
     result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
 	    objc, objv, fdPtr);
     if (result != TCL_OK) {
-	TclStackFree(interp, fdPtr);
+	ckfree(fdPtr);
 	return result;
     }
     pmPtr->refCount++;
@@ -719,11 +719,11 @@ InvokeProcedureMethod(
 	    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
 
 	    Tcl_PopCallFrame(interp);
-	    TclStackFree(interp, fdPtr->framePtr);
+	    ckfree(fdPtr->framePtr);
 	    if (--pmPtr->refCount < 1) {
 		DeleteProcedureMethodRecord(pmPtr);
 	    }
-	    TclStackFree(interp, fdPtr);
+	    ckfree(fdPtr);
 	    return result;
 	}
     }
@@ -774,7 +774,7 @@ FinalizePMCall(
     if (--pmPtr->refCount < 1) {
 	DeleteProcedureMethodRecord(pmPtr);
     }
-    TclStackFree(interp, fdPtr);
+    ckfree(fdPtr);
     return result;
 }
 
@@ -1447,7 +1447,7 @@ FinalizeForwardCall(
 {
     Tcl_Obj **argObjs = data[0];
     
-    TclStackFree(interp, argObjs);
+    ckfree(argObjs);
     return result;
 }
 
@@ -1576,7 +1576,7 @@ InitEnsembleRewrite(
     Tcl_Obj **argObjs;
     unsigned len = rewriteLength + objc - toRewrite;
 
-    argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
+    argObjs = ckalloc(sizeof(Tcl_Obj *) * len);
     memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
     memcpy(argObjs + rewriteLength, objv + toRewrite,
 	    sizeof(Tcl_Obj *) * (objc - toRewrite));
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 3bc6f12..5056c1c 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -27,12 +27,6 @@ static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
 TCL_DECLARE_MUTEX(tableMutex)
 
 /*
- * Head of the list of free Tcl_Obj structs we maintain.
- */
-
-Tcl_Obj *tclFreeObjList = NULL;
-
-/*
  * The object allocator is single threaded. This mutex is referenced by the
  * TclNewObj macro, however, so must be visible.
  */
@@ -475,7 +469,7 @@ TclFinalizeThreadObjects(void)
  * TclFinalizeObjects --
  *
  *	This function is called by Tcl_Finalize to clean up all registered
- *	Tcl_ObjType's and to reset the tclFreeObjList.
+ *	Tcl_ObjType's
  *
  * Results:
  *	None.
@@ -495,15 +489,6 @@ TclFinalizeObjects(void)
 	typeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
-
-    /*
-     * All we do here is reset the head pointer of the linked list of free
-     * Tcl_Obj's to NULL; the memory finalization will take care of releasing
-     * memory for us.
-     */
-    Tcl_MutexLock(&tclObjMutex);
-    tclFreeObjList = NULL;
-    Tcl_MutexUnlock(&tclObjMutex);
 }
 
 /*
@@ -1238,59 +1223,6 @@ Tcl_DbNewObj(
 /*
  *----------------------------------------------------------------------
  *
- * TclAllocateFreeObjects --
- *
- *	Function to allocate a number of free Tcl_Objs. This is done using a
- *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
- *
- *	Assumes mutex is held.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
- *	first of a number of free Tcl_Obj's linked together by their
- *	internalRep.otherValuePtrs.
- *
- *----------------------------------------------------------------------
- */
-
-#define OBJS_TO_ALLOC_EACH_TIME 100
-
-void
-TclAllocateFreeObjects(void)
-{
-    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
-    char *basePtr;
-    register Tcl_Obj *prevPtr, *objPtr;
-    register int i;
-
-    /*
-     * This has been noted by Purify to be a potential leak. The problem is
-     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
-     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
-     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
-     * but leaves it to Tcl's memory subsystem finalization to release it.
-     * Purify apparently can't figure that out, and fires a false alarm.
-     */
-
-    basePtr = ckalloc(bytesToAlloc);
-
-    prevPtr = NULL;
-    objPtr = (Tcl_Obj *) basePtr;
-    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
-	objPtr->internalRep.otherValuePtr = prevPtr;
-	prevPtr = objPtr;
-	objPtr++;
-    }
-    tclFreeObjList = prevPtr;
-}
-#undef OBJS_TO_ALLOC_EACH_TIME
-
-/*
- *----------------------------------------------------------------------
- *
  * TclFreeObj --
  *
  *	This function frees the memory associated with the argument object.
@@ -1404,7 +1336,6 @@ TclFreeObj(
      */
 
     TclInvalidateStringRep(objPtr);
-    objPtr->length = -1;
 
     if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
 	/*
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 9bfe608..afd4c0b 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1129,14 +1129,14 @@ ParseTokens(
 
 	    src++;
 	    numBytes--;
-	    nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
+	    nestedPtr = ckalloc(sizeof(Tcl_Parse));
 	    while (1) {
 		if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
 			nestedPtr) != TCL_OK) {
 		    parsePtr->errorType = nestedPtr->errorType;
 		    parsePtr->term = nestedPtr->term;
 		    parsePtr->incomplete = nestedPtr->incomplete;
-		    TclStackFree(parsePtr->interp, nestedPtr);
+		    ckfree(nestedPtr);
 		    return TCL_ERROR;
 		}
 		src = nestedPtr->commandStart + nestedPtr->commandSize;
@@ -1162,11 +1162,11 @@ ParseTokens(
 		    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
 		    parsePtr->term = tokenPtr->start;
 		    parsePtr->incomplete = 1;
-		    TclStackFree(parsePtr->interp, nestedPtr);
+		    ckfree(nestedPtr);
 		    return TCL_ERROR;
 		}
 	    }
-	    TclStackFree(parsePtr->interp, nestedPtr);
+	    ckfree(nestedPtr);
 	    tokenPtr->type = TCL_TOKEN_COMMAND;
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
@@ -1526,10 +1526,10 @@ Tcl_ParseVar(
 {
     register Tcl_Obj *objPtr;
     int code;
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse));
 
     if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
-	TclStackFree(interp, parsePtr);
+	ckfree(parsePtr);
 	return NULL;
     }
 
@@ -1541,13 +1541,13 @@ Tcl_ParseVar(
 	 * There isn't a variable name after all: the $ is just a $.
 	 */
 
-	TclStackFree(interp, parsePtr);
+	ckfree(parsePtr);
 	return "$";
     }
 
     code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
 	    NULL, 1, NULL, NULL);
-    TclStackFree(interp, parsePtr);
+    ckfree(parsePtr);
     if (code != TCL_OK) {
 	return NULL;
     }
@@ -2008,7 +2008,7 @@ TclSubstParse(
 		Tcl_Token *tokenPtr;
 		const char *lastTerm = parsePtr->term;
 		Tcl_Parse *nestedPtr =
-			TclStackAlloc(interp, sizeof(Tcl_Parse));
+			ckalloc(sizeof(Tcl_Parse));
 
 		while (TCL_OK ==
 			Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
@@ -2026,7 +2026,7 @@ TclSubstParse(
 		    }
 		    lastTerm = nestedPtr->term;
 		}
-		TclStackFree(interp, nestedPtr);
+		ckfree(nestedPtr);
 
 		if (lastTerm == parsePtr->term) {
 		    /*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 6cd5bb2..63dd61d 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -222,7 +222,7 @@ Tcl_ProcObjCmd(
      */
 
     if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	CmdFrame *contextPtr = ckalloc(sizeof(CmdFrame));
 
 	*contextPtr = *iPtr->cmdFramePtr;
 	if (contextPtr->type == TCL_LOCATION_BC) {
@@ -300,7 +300,7 @@ Tcl_ProcObjCmd(
 	    Tcl_DecrRefCount(contextPtr->data.eval.path);
 	    contextPtr->data.eval.path = NULL;
 	}
-	TclStackFree(interp, contextPtr);
+	ckfree(contextPtr);
     }
 
     /*
@@ -1096,8 +1096,7 @@ ProcWrongNumArgs(
      */
 
     numArgs = framePtr->procPtr->numArgs;
-    desiredObjs = TclStackAlloc(interp,
-	    (int) sizeof(Tcl_Obj *) * (numArgs+1));
+    desiredObjs = ckalloc((int) sizeof(Tcl_Obj *) * (numArgs+1));
 
     if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
 	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
@@ -1135,7 +1134,7 @@ ProcWrongNumArgs(
     for (i=0 ; i<=numArgs ; i++) {
 	Tcl_DecrRefCount(desiredObjs[i]);
     }
-    TclStackFree(interp, desiredObjs);
+    ckfree(desiredObjs);
     return TCL_ERROR;
 }
 
@@ -1449,7 +1448,7 @@ InitArgsAndLocals(
      * parameters.
      */
 
-    varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
+    varPtr = ckalloc((int)(localCt * sizeof(Var)));
     framePtr->compiledLocals = varPtr;
     framePtr->numCompiledLocals = localCt;
 
@@ -1740,9 +1739,9 @@ TclNRInterpProcCore(
     if (result != TCL_OK) {
 	freePtr = iPtr->framePtr;
 	Tcl_PopCallFrame(interp);	/* Pop but do not free. */
-	TclStackFree(interp, freePtr->compiledLocals);
+	ckfree(freePtr->compiledLocals);
 					/* Free compiledLocals. */
-	TclStackFree(interp, freePtr);	/* Free CallFrame. */
+	ckfree(freePtr);	/* Free CallFrame. */
 	return TCL_ERROR;
     }
 
@@ -1912,9 +1911,9 @@ InterpProcNR2(
 
     freePtr = iPtr->framePtr;
     Tcl_PopCallFrame(interp);		/* Pop but do not free. */
-    TclStackFree(interp, freePtr->compiledLocals);
+    ckfree(freePtr->compiledLocals);
 					/* Free compiledLocals. */
-    TclStackFree(interp, freePtr);	/* Free CallFrame. */
+    ckfree(freePtr);	/* Free CallFrame. */
 
     return result;
 }
@@ -2516,7 +2515,7 @@ SetLambdaFromAny(
      */
 
     if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	CmdFrame *contextPtr = ckalloc(sizeof(CmdFrame));
 
 	*contextPtr = *iPtr->cmdFramePtr;
 	if (contextPtr->type == TCL_LOCATION_BC) {
@@ -2580,7 +2579,7 @@ SetLambdaFromAny(
 
 	    Tcl_DecrRefCount(contextPtr->data.eval.path);
 	}
-	TclStackFree(interp, contextPtr);
+	ckfree(contextPtr);
     }
 
     /*
@@ -2717,7 +2716,7 @@ TclNRApplyObjCmd(
 	return TCL_ERROR;
     }
 
-    extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
+    extraPtr = ckalloc(sizeof(ApplyExtraData));
     memset(&extraPtr->cmd, 0, sizeof(Command));
     procPtr->cmdPtr = &extraPtr->cmd;
     extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
@@ -2768,7 +2767,7 @@ ApplyNR2(
 	((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
     }
 
-    TclStackFree(interp, extraPtr);
+    ckfree(extraPtr);
     return result;
 }
 
diff --git a/generic/tclScan.c b/generic/tclScan.c
index c862be4..45f970d 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -259,7 +259,7 @@ ValidateFormat(
     char *end;
     Tcl_UniChar ch;
     int objIndex, xpgSize, nspace = numVars;
-    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
+    int *nassign = ckalloc(nspace * sizeof(int));
     char buf[TCL_UTF_MAX+1];
 
     /*
@@ -465,8 +465,7 @@ ValidateFormat(
 		} else {
 		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
 		}
-		nassign = TclStackRealloc(interp, nassign,
-			nspace * sizeof(int));
+		nassign = ckrealloc(nassign, nspace * sizeof(int));
 		for (i = value; i < nspace; i++) {
 		    nassign[i] = 0;
 		}
@@ -509,7 +508,7 @@ ValidateFormat(
 	}
     }
 
-    TclStackFree(interp, nassign);
+    ckfree(nassign);
     return TCL_OK;
 
   badIndex:
@@ -523,7 +522,7 @@ ValidateFormat(
     }
 
   error:
-    TclStackFree(interp, nassign);
+    ckfree(nassign);
     return TCL_ERROR;
 }
 
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index eb9a9be..84c1ea9 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -57,7 +57,7 @@ static const TclIntStubs tclIntStubs = {
     0, /* 0 */
     0, /* 1 */
     0, /* 2 */
-    TclAllocateFreeObjects, /* 3 */
+    0, /* 3 */
     0, /* 4 */
     TclCleanupChildren, /* 5 */
     TclCleanupCommand, /* 6 */
@@ -269,8 +269,8 @@ static const TclIntStubs tclIntStubs = {
     TclpFindExecutable, /* 212 */
     TclGetObjNameOfExecutable, /* 213 */
     TclSetObjNameOfExecutable, /* 214 */
-    TclStackAlloc, /* 215 */
-    TclStackFree, /* 216 */
+    0, /* 215 */
+    0, /* 216 */
     TclPushStackFrame, /* 217 */
     TclPopStackFrame, /* 218 */
     0, /* 219 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b757185..2878c8d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6720,7 +6720,7 @@ TestNRELevels(
     Interp *iPtr = (Interp *) interp;
     static ptrdiff_t *refDepth = NULL;
     ptrdiff_t depth;
-    Tcl_Obj *levels[6];
+    Tcl_Obj *levels[5];
     int i = 0;
     NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
 
@@ -6734,16 +6734,14 @@ TestNRELevels(
     levels[1] = Tcl_NewIntObj(iPtr->numLevels);
     levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
     levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
-    levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
-	    - iPtr->execEnvPtr->execStackPtr->stackWords);
 
     while (cbPtr) {
 	i++;
 	cbPtr = cbPtr->nextPtr;
     }
-    levels[5] = Tcl_NewIntObj(i);
+    levels[4] = Tcl_NewIntObj(i);
 
-    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
+    Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels));
     return TCL_OK;
 }
 
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
deleted file mode 100755
index c3acb2a..0000000
--- a/generic/tclThreadAlloc.c
+++ /dev/null
@@ -1,1081 +0,0 @@
-/*
- * tclThreadAlloc.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"
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-
-/*
- * 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
-
-/*
- * 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 NOBJALLOC	800
-
-/* Actual definition moved to tclInt.h */
-#define NOBJHIGH	ALLOC_NOBJHIGH
-
-/*
- * 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 */
-
-    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 */
-} Bucket;
-
-/*
- * 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 {
-    struct Cache *nextPtr;	/* Linked list of cache entries */
-    Tcl_ThreadId owner;		/* Which thread's cache is this? */
-    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
-    int numObjects;		/* Number of objects for thread */
-    int totalAssigned;		/* Total space assigned to thread */
-    Bucket buckets[NBUCKETS];	/* The buckets for this thread */
-} Cache;
-
-/*
- * 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. */
-    int numMove;		/* Num blocks to move to share. */
-    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
-} bucketInfo[NBUCKETS];
-
-/*
- * Static functions defined in this file.
- */
-
-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);
-static Block *	Ptr2Block(char *ptr);
-static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
-static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
-
-/*
- * Local variables defined in this file and initialized at startup.
- */
-
-static Tcl_Mutex *listLockPtr;
-static Tcl_Mutex *objLockPtr;
-static Cache sharedCache;
-static Cache *sharedPtr = &sharedCache;
-static Cache *firstCachePtr = &sharedCache;
-
-/*
- *----------------------------------------------------------------------
- *
- * GetCache ---
- *
- *	Gets per-thread memory cache, allocating it if necessary.
- *
- * Results:
- *	Pointer to cache.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static Cache *
-GetCache(void)
-{
-    Cache *cachePtr;
-
-    /*
-     * Check for first-time initialization.
-     */
-
-    if (listLockPtr == NULL) {
-	Tcl_Mutex *initLockPtr;
-	unsigned int i;
-
-	initLockPtr = Tcl_GetAllocMutex();
-	Tcl_MutexLock(initLockPtr);
-	if (listLockPtr == NULL) {
-	    listLockPtr = TclpNewAllocMutex();
-	    objLockPtr = TclpNewAllocMutex();
-	    for (i = 0; i < NBUCKETS; ++i) {
-		bucketInfo[i].blockSize = MINALLOC << i;
-		bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
-		bucketInfo[i].numMove = i < NBUCKETS - 1 ?
-			1 << (NBUCKETS - 2 - i) : 1;
-		bucketInfo[i].lockPtr = TclpNewAllocMutex();
-	    }
-	}
-	Tcl_MutexUnlock(initLockPtr);
-    }
-
-    /*
-     * 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");
-	}
-	Tcl_MutexLock(listLockPtr);
-	cachePtr->nextPtr = firstCachePtr;
-	firstCachePtr = cachePtr;
-	Tcl_MutexUnlock(listLockPtr);
-	cachePtr->owner = Tcl_GetCurrentThread();
-	TclpSetAllocCache(cachePtr);
-    }
-    return cachePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFreeAllocCache --
- *
- *	Flush and delete a cache, removing from list of caches.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFreeAllocCache(
-    void *arg)
-{
-    Cache *cachePtr = arg;
-    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);
-	}
-    }
-
-    /*
-     * Flush objs.
-     */
-
-    if (cachePtr->numObjects > 0) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
-	Tcl_MutexUnlock(objLockPtr);
-    }
-
-    /*
-     * Remove from pool list.
-     */
-
-    Tcl_MutexLock(listLockPtr);
-    nextPtrPtr = &firstCachePtr;
-    while (*nextPtrPtr != cachePtr) {
-	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
-    }
-    *nextPtrPtr = cachePtr->nextPtr;
-    cachePtr->nextPtr = NULL;
-    Tcl_MutexUnlock(listLockPtr);
-    free(cachePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpAlloc --
- *
- *	Allocate memory.
- *
- * Results:
- *	Pointer to memory just beyond Block pointer.
- *
- * Side effects:
- *	May allocate more blocks for a bucket.
- *
- *----------------------------------------------------------------------
- */
-
-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
-
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
-
-    /*
-     * 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;
-	    cachePtr->buckets[bucket].numFree--;
-	    cachePtr->buckets[bucket].numRemoves++;
-	    cachePtr->buckets[bucket].totalAssigned += reqSize;
-	}
-    }
-    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;
-    }
-
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
-
-    /*
-     * 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 (cachePtr != sharedPtr &&
-	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
-	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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
-
-    cachePtr = TclpGetAllocCache();
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
-
-    /*
-     * 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadAllocObj --
- *
- *	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
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclThreadAllocObj(void)
-{
-    register Cache *cachePtr = TclpGetAllocCache();
-    register Tcl_Obj *objPtr;
-
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
-
-    /*
-     * Get this thread's obj list structure and move or allocate new objs if
-     * necessary.
-     */
-
-    if (cachePtr->numObjects == 0) {
-	register int numMove;
-
-	Tcl_MutexLock(objLockPtr);
-	numMove = sharedPtr->numObjects;
-	if (numMove > 0) {
-	    if (numMove > NOBJALLOC) {
-		numMove = NOBJALLOC;
-	    }
-	    MoveObjs(sharedPtr, cachePtr, numMove);
-	}
-	Tcl_MutexUnlock(objLockPtr);
-	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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadFreeObj --
- *
- *	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
-TclThreadFreeObj(
-    Tcl_Obj *objPtr)
-{
-    Cache *cachePtr = TclpGetAllocCache();
-
-    if (cachePtr == NULL) {
-	cachePtr = GetCache();
-    }
-
-    /*
-     * 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 (cachePtr->numObjects > NOBJHIGH) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
-	Tcl_MutexUnlock(objLockPtr);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetMemoryInfo --
- *
- *	Return a list-of-lists of memory stats.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	List appended to given dstring.
- *
- *----------------------------------------------------------------------
- */
-
-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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MoveObjs --
- *
- *	Move Tcl_Obj's between caches.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Block2Ptr, Ptr2Block --
- *
- *	Convert between internal blocks and user pointers.
- *
- * Results:
- *	User pointer or internal block.
- *
- * Side effects:
- *	Invalid blocks will abort the server.
- *
- *----------------------------------------------------------------------
- */
-
-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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-LockBucket(
-    Cache *cachePtr,
-    int bucket)
-{
-#if 0
-    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
-	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-	cachePtr->buckets[bucket].numWaits++;
-	sharedPtr->buckets[bucket].numWaits++;
-    }
-#else
-    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-#endif
-    cachePtr->buckets[bucket].numLocks++;
-    sharedPtr->buckets[bucket].numLocks++;
-}
-
-static void
-UnlockBucket(
-    Cache *cachePtr,
-    int bucket)
-{
-    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PutBlocks --
- *
- *	Return unused blocks to the shared cache.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetBlocks --
- *
- *	Get more blocks for a bucket.
- *
- * Results:
- *	1 if blocks where allocated, 0 otherwise.
- *
- * Side effects:
- *	Cache may be filled with available blocks.
- *
- *----------------------------------------------------------------------
- */
-
-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) {
-		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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadAlloc --
- *
- *	This procedure is used to destroy all private resources used in this
- *	file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeThreadAlloc(void)
-{
-    unsigned int i;
-
-    for (i = 0; i < NBUCKETS; ++i) {
-	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
-	bucketInfo[i].lockPtr = NULL;
-    }
-
-    TclpFreeAllocMutex(objLockPtr);
-    objLockPtr = NULL;
-
-    TclpFreeAllocMutex(listLockPtr);
-    listLockPtr = NULL;
-
-    TclpFreeAllocCache(NULL);
-}
-
-#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetMemoryInfo --
- *
- *	Return a list-of-lists of memory stats.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	List appended to given dstring.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_GetMemoryInfo(
-    Tcl_DString *dsPtr)
-{
-    Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadAlloc --
- *
- *	This procedure is used to destroy all private resources used in this
- *	file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeThreadAlloc(void)
-{
-    Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use");
-}
-#endif /* TCL_THREADS && USE_THREAD_ALLOC */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index d5fb6f6..ffbaa17 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1650,7 +1650,7 @@ CallTraceFunction(
      * Copy the command characters into a new string.
      */
 
-    commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1);
+    commandCopy = ckalloc((unsigned) numChars + 1);
     memcpy(commandCopy, command, (size_t) numChars);
     commandCopy[numChars] = '\0';
 
@@ -1661,7 +1661,7 @@ CallTraceFunction(
     traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr,
 	    iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);
 
-    TclStackFree(interp, commandCopy);
+    ckfree(commandCopy);
     return traceCode;
 }
 
@@ -2237,7 +2237,7 @@ StringTraceProc(
      * which uses strings for everything.
      */
 
-    argv = (const char **) TclStackAlloc(interp,
+    argv = (const char **) ckalloc(
 	    (unsigned) ((objc + 1) * sizeof(const char *)));
     for (i = 0; i < objc; i++) {
 	argv[i] = Tcl_GetString(objv[i]);
@@ -2252,7 +2252,7 @@ StringTraceProc(
 
     data->proc(data->clientData, interp, level, (char *) command,
 	    cmdPtr->proc, cmdPtr->clientData, objc, argv);
-    TclStackFree(interp, (void *) argv);
+    ckfree((void *) argv);
 
     return TCL_OK;
 }
diff --git a/tests/nre.test b/tests/nre.test
index 295f02e..17f9a51 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -25,8 +25,8 @@ if {[testConstraint testnrelevels]} {
     namespace eval testnre {
 	namespace path ::tcl::mathop
 	#
-	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
-	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
+	# cmdFrame level, callFrame level and callback depth 
 	#
 	variable last [testnrelevels] 
 	proc depthDiff {} {
diff --git a/tests/tailcall.test b/tests/tailcall.test
index e9ec188..af496fc 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -24,8 +24,8 @@ testConstraint testnrelevels [llength [info commands testnrelevels]]
 if {[testConstraint testnrelevels]} {
     namespace eval testnre {
 	#
-	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
-	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	# [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels,
+	# cmdFrame level, callFrame level and callback depth 
 	#
 	variable last [testnrelevels] 
 	proc depthDiff {} {
@@ -66,7 +66,7 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup
     a 0
 } -cleanup {
     rename a {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
     set a { i {
@@ -83,7 +83,7 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup
     apply $a 0
 } -cleanup {
     unset a
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
     proc a i {
@@ -101,7 +101,7 @@ test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename b {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
     namespace eval ::ns {
@@ -124,7 +124,7 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename b {}
     namespace delete ::ns
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
     proc b i {
@@ -142,7 +142,7 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename b {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup {
     #
@@ -167,7 +167,7 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known
     rename a {}
     rename c {}
     rename d {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup {
     catch {rename foo {}}
@@ -188,7 +188,7 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup
 } -cleanup {
     rename a {}
     rename foo {}
-} -result {0 0 0 0 0 0}
+} -result {0 0 0 0 0}
 
 test tailcall-1 {tailcall} -body {
     namespace eval a {
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 20ba896..2b5f867 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -304,7 +304,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclPreserve.o tclProc.o tclRegexp.o \
 	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
 	tclStrToD.o tclThread.o \
-	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
+	tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
 	tclTomMathInterface.o \
 	tclAssembly.o
@@ -445,7 +445,6 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclTestObj.c \
 	$(GENERIC_DIR)/tclTestProcBodyObj.c \
 	$(GENERIC_DIR)/tclThread.c \
-	$(GENERIC_DIR)/tclThreadAlloc.c \
 	$(GENERIC_DIR)/tclThreadJoin.c \
 	$(GENERIC_DIR)/tclThreadStorage.c \
 	$(GENERIC_DIR)/tclTimer.c \
@@ -1007,11 +1006,8 @@ regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c
 tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
 	$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
 
-# On Unix we want to use the normal malloc/free implementation, so we
-# specifically set the USE_TCLALLOC flag.
-
 tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
-	$(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c
 
 tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c
@@ -1286,9 +1282,6 @@ tclTimer.o: $(GENERIC_DIR)/tclTimer.c
 tclThread.o: $(GENERIC_DIR)/tclThread.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c
 
-tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c
-
 tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c
 
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index d01624c..f6645fd 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -452,8 +452,8 @@ TclpCreateProcess(
      * deallocated later
      */
 
-    dsArray = TclStackAlloc(interp, argc * sizeof(Tcl_DString));
-    newArgv = TclStackAlloc(interp, (argc+1) * sizeof(char *));
+    dsArray = ckalloc(argc * sizeof(Tcl_DString));
+    newArgv = ckalloc((argc+1) * sizeof(char *));
     newArgv[argc] = NULL;
     for (i = 0; i < argc; i++) {
 	newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
@@ -524,8 +524,8 @@ TclpCreateProcess(
     for (i = 0; i < argc; i++) {
 	Tcl_DStringFree(&dsArray[i]);
     }
-    TclStackFree(interp, newArgv);
-    TclStackFree(interp, dsArray);
+    ckfree(newArgv);
+    ckfree(dsArray);
 
     if (pid == -1) {
 	Tcl_AppendResult(interp, "couldn't fork child process: ",
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 0469d7a..a4db0df 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -676,12 +676,11 @@ TclpInetNtoa(
 #endif
 }
 
-#ifdef TCL_THREADS
+#if defined(TCL_THREADS)
 /*
  * Additions by AOL for specialized thread memory allocator.
  */
 
-#ifdef USE_THREAD_ALLOC
 static volatile int initialized = 0;
 static pthread_key_t key;
 
@@ -718,6 +717,7 @@ TclpFreeAllocMutex(
     free(lockPtr);
 }
 
+
 void
 TclpFreeAllocCache(
     void *ptr)
@@ -760,8 +760,9 @@ TclpSetAllocCache(
 {
     pthread_setspecific(key, arg);
 }
-#endif /* USE_THREAD_ALLOC */
+#endif
 
+#ifdef TCL_THREADS
 void *
 TclpThreadCreateKey(void)
 {