reversed accidental commit of unfinished sources

3 files changed, 34 insertions, 990 deletions

diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 6452ec5..099da71 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -15,957 +15,13 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclAlloc.c,v 1.14 2002/02/27 06:39:26 hobbs Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.15 2002/02/27 07:08:28 hobbs Exp $
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
-#if defined(TCL_THREADS) && !defined(MAC_TCL) && !defined(WIN32)
-
-/* 
- * tclAlloc.c --
- *
- *	Special purpose allocator for threaded Tcl.
- *
- *	Fast cache memory allocator designed to avoid lock
- *  	contention.  The basic strategy is to allocate memory in
- *  	fixed size blocks from block caches.  
- */
-
-#include "tclInt.h"
-#include <pthread.h>
-#include <errno.h>
-
-/*
- * 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
-#define NOBJHIGH	1200
-
-/*
- * The following defines the number of buckets in the bucket
- * cache and those block sizes from (1<<4) to (1<<(3+NBUCKETS))
- */
-
-#define NBUCKETS	  11
-#define MAXALLOC	  16284
-
-/*
- * 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 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. */
-        } b_s;
-    } b_u;
-    size_t b_reqsize;		  /* Requested allocation size. */
-} Block;
-#define b_next		b_u.next
-#define b_bucket	b_u.b_s.bucket
-#define b_magic1	b_u.b_s.magic1
-#define b_magic2	b_u.b_s.magic2
-#define MAGIC		0xef
-
-/*
- * The following structure defines a bucket of blocks with
- * various accouting and statistics information.
- */
-
-typedef struct Bucket {
-    Block *firstPtr;
-    int nfree;
-    int nget;
-    int nput;
-    int nwait;
-    int nlock;
-    int nrequest;
-} Bucket;
-
-/*
- * The following structure defines a cache of buckets and objs.
- */
-
-typedef struct Cache {
-    struct  Cache *nextPtr;
-    pthread_t      owner;
-    int            busy;
-    Tcl_Obj       *firstObjPtr;
-    int            nobjs;
-    int	           nsysalloc;
-    Bucket         buckets[NBUCKETS];
-} Cache;
-
-/*
- * The following array specifies various per-bucket 
- * limits and locks.  The values are statically initialized
- * to avoid calculating them repeatedly.
- */
-
-struct binfo {
-    size_t blocksize;	/* Bucket blocksize. */
-    int maxblocks;	/* Max blocks before move to share. */
-    int nmove;		/* Num blocks to move to share. */
-    pthread_mutex_t lock; /* Share bucket lock. */
-} binfo[NBUCKETS] = {
-    {   16, 1024, 512, PTHREAD_MUTEX_INITIALIZER},
-    {   32,  512, 256, PTHREAD_MUTEX_INITIALIZER},
-    {   64,  256, 128, PTHREAD_MUTEX_INITIALIZER},
-    {  128,  128,  64, PTHREAD_MUTEX_INITIALIZER},
-    {  256,   64,  32, PTHREAD_MUTEX_INITIALIZER},
-    {  512,   32,  16, PTHREAD_MUTEX_INITIALIZER},
-    { 1024,   16,   8, PTHREAD_MUTEX_INITIALIZER},
-    { 2048,    8,   4, PTHREAD_MUTEX_INITIALIZER},
-    { 4096,    4,   2, PTHREAD_MUTEX_INITIALIZER},
-    { 8192,    2,   1, PTHREAD_MUTEX_INITIALIZER},
-    {16284,    1,   1, PTHREAD_MUTEX_INITIALIZER},
-};
-
-/*
- * Static functions defined in this file.
- */
-
-static void LockBucket(Cache *cachePtr, int bucket);
-static void UnlockBucket(Cache *cachePtr, int bucket);
-static void PutBlocks(Cache *cachePtr, int bucket, int nmove);
-static int  GetBlocks(Cache *cachePtr, int bucket);
-static Block *Ptr2Block(char *ptr);
-static char *Block2Ptr(Block *blockPtr, int bucket, unsigned int reqsize);
-static void FreeCache(void *arg);
-static void MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove);
-
-/*
- * Local variables defined in this file and initialized at
- * startup.
- */
-
-static int initialized = 0;
-static pthread_mutex_t listlock = PTHREAD_MUTEX_INITIALIZER;
-static pthread_mutex_t objlock  = PTHREAD_MUTEX_INITIALIZER;
-static pthread_once_t once = PTHREAD_ONCE_INIT;
-static pthread_key_t key;
-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 void
-Init(void)
-{
-    int err;
-
-    err = pthread_key_create(&key, FreeCache);
-    if (err != 0) {
-	panic("alloc: pthread_key_create: %s", strerror(err));
-    }
-    initialized = 1;
-}
-
-static Cache *
-GetCache(void)
-{
-    Cache *cachePtr;
-    int err;
-
-    /*
-     * Check for first-time initialization.
-     */
-
-    if (!initialized) {
-	pthread_once(&once, Init);
-    }
-
-    /*
-     * Get this thread's cache, allocating if necessary.
-     */
-
-    cachePtr = pthread_getspecific(key);
-    if (cachePtr == NULL) {
-    	cachePtr = calloc(1, sizeof(Cache));
-    	if (cachePtr == NULL) {
-	    panic("alloc: could not allocate new cache");
-    	}
-    	pthread_mutex_lock(&listlock);
-    	cachePtr->nextPtr = firstCachePtr;
-    	firstCachePtr = cachePtr;
-    	pthread_mutex_unlock(&listlock);
-    	cachePtr->owner = pthread_self();
-	err = pthread_setspecific(key, cachePtr);
-	if (err != 0) {
-	    panic("alloc: pthread_setspecific: %s", strerror(err));
-	}
-    }
-    cachePtr->busy = 1;
-    return cachePtr;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- *  FreeCache --
- *
- *	Flush and delete a cache, removing from all-caches list.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeCache(void *arg)
-{
-    Cache *cachePtr = arg;
-    Cache **nextPtrPtr;
-    register int   bucket;
-    int	err;
-
-    /*
-     * Reset the cache and continue to finalize the thread until
-     * it appears idle.
-     */
-
-    if (cachePtr->busy) {
-    	err = pthread_setspecific(key, cachePtr);
-        if (err != 0) {
-	    panic("alloc: pthread_setspecific: %s", strerror(err));
-        }
-    	Tcl_FinalizeThread();
-	cachePtr->busy = 0;
-	return;
-    }
-
-    /*
-     * Flush blocks.
-     */
-
-    for (bucket = 0; bucket < NBUCKETS; ++bucket) {
-	if (cachePtr->buckets[bucket].nfree > 0) {
-	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].nfree);
-	}
-    }
-
-    /*
-     * Flush objs.
-     */
-
-    if (cachePtr->nobjs > 0) {
-    	pthread_mutex_lock(&objlock);
-    	MoveObjs(cachePtr, sharedPtr, cachePtr->nobjs);
-    	pthread_mutex_unlock(&objlock);
-    }
-
-    /*
-     * Remove from pool list.
-     */
-
-    pthread_mutex_lock(&listlock);
-    nextPtrPtr = &firstCachePtr;
-    while (*nextPtrPtr != cachePtr) {
-	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
-    }
-    *nextPtrPtr = cachePtr->nextPtr;
-    cachePtr->nextPtr = NULL;
-    pthread_mutex_unlock(&listlock);
-
-    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 = GetCache();
-    Block         *blockPtr;
-    register int   bucket;
-    size_t  	   size;
-    
-    /*
-     * 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->nsysalloc += reqsize;
-	}
-    } else {
-    	bucket = 0;
-    	while (binfo[bucket].blocksize < size) {
-    	    ++bucket;
-    	}
-    	if (cachePtr->buckets[bucket].nfree || GetBlocks(cachePtr, bucket)) {
-	    blockPtr = cachePtr->buckets[bucket].firstPtr;
-	    cachePtr->buckets[bucket].firstPtr = blockPtr->b_next;
-	    --cachePtr->buckets[bucket].nfree;
-    	    ++cachePtr->buckets[bucket].nget;
-	    cachePtr->buckets[bucket].nrequest += 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 = GetCache();
-    Block *blockPtr;
-    int bucket;
- 
-    if (ptr == NULL) {
-	return;
-    }
-
-    /*
-     * 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->b_bucket;
-    if (bucket == NBUCKETS) {
-	cachePtr->nsysalloc -= blockPtr->b_reqsize;
-	free(blockPtr);
-    } else {
-	cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
-	blockPtr->b_next = cachePtr->buckets[bucket].firstPtr;
-	cachePtr->buckets[bucket].firstPtr = blockPtr;
-	++cachePtr->buckets[bucket].nfree;
-	++cachePtr->buckets[bucket].nput;
-    	if (cachePtr != sharedPtr &&
-	    cachePtr->buckets[bucket].nfree > binfo[bucket].maxblocks) {
-	    PutBlocks(cachePtr, bucket, binfo[bucket].nmove);
-	}
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- *  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 = GetCache();
-    Block *blockPtr;
-    void *new;
-    size_t size, min;
-    int bucket;
-
-    if (ptr == NULL) {
-	return (TclpAlloc(reqsize));
-    }
-
-    /*
-     * 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->b_bucket;
-    if (bucket != NBUCKETS) {
-	if (bucket > 0) {
-	    min = binfo[bucket-1].blocksize;
-	} else {
-	    min = 0;
-	}
-	if (size > min && size <= binfo[bucket].blocksize) {
-	    cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
-	    cachePtr->buckets[bucket].nrequest += reqsize;
-	    return Block2Ptr(blockPtr, bucket, reqsize);
-	}
-    } else if (size > MAXALLOC) {
-	cachePtr->nsysalloc -= blockPtr->b_reqsize;
-	cachePtr->nsysalloc += reqsize;
-	blockPtr = realloc(blockPtr, size);
-	if (blockPtr == NULL) {
-	    return NULL;
-	}
-	return Block2Ptr(blockPtr, NBUCKETS, reqsize);
-    }
-
-    /*
-     * Finally, perform an expensive malloc/copy/free.
-     */
-
-    new = TclpAlloc(reqsize);
-    if (new != NULL) {
-	if (reqsize > blockPtr->b_reqsize) {
-	    reqsize = blockPtr->b_reqsize;
-	}
-    	memcpy(new, ptr, reqsize);
-    	TclpFree(ptr);
-    }
-    return new;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclThreadAllocObj(void)
-{
-    register Cache *cachePtr = GetCache();
-    register int nmove;
-    register Tcl_Obj *objPtr;
-    Tcl_Obj *newObjsPtr;
-
-    /*
-     * Get this thread's obj list structure and move
-     * or allocate new objs if necessary.
-     */
-     
-    if (cachePtr->nobjs == 0) {
-    	pthread_mutex_lock(&objlock);
-	nmove = sharedPtr->nobjs;
-	if (nmove > 0) {
-	    if (nmove > NOBJALLOC) {
-		nmove = NOBJALLOC;
-	    }
-	    MoveObjs(sharedPtr, cachePtr, nmove);
-	}
-    	pthread_mutex_unlock(&objlock);
-	if (cachePtr->nobjs == 0) {
-	    cachePtr->nobjs = nmove = NOBJALLOC;
-	    newObjsPtr = malloc(sizeof(Tcl_Obj) * nmove);
-	    if (newObjsPtr == NULL) {
-		panic("alloc: could not allocate %d new objects", nmove);
-	    }
-	    while (--nmove >= 0) {
-		objPtr = &newObjsPtr[nmove];
-		objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
-		cachePtr->firstObjPtr = objPtr;
-	    }
-	}
-    }
-
-    /*
-     * Pop the first object.
-     */
-
-    objPtr = cachePtr->firstObjPtr;
-    cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
-    --cachePtr->nobjs;
-    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.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclThreadFreeObj(Tcl_Obj *objPtr)
-{
-    Cache *cachePtr = GetCache();
-
-    /*
-     * Get this thread's list and push on the free Tcl_Obj.
-     */
-     
-    objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
-    cachePtr->firstObjPtr = objPtr;
-    
-    /*
-     * If the number of free objects has exceeded the high
-     * water mark, move some blocks to the shared list.
-     */
-     
-    ++cachePtr->nobjs;
-    if (cachePtr->nobjs > NOBJHIGH) {
-	pthread_mutex_lock(&objlock);
-	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
-	pthread_mutex_unlock(&objlock);
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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];
-    int n;
-
-    pthread_mutex_lock(&listlock);
-    cachePtr = firstCachePtr;
-    while (cachePtr != NULL) {
-	Tcl_DStringStartSublist(dsPtr);
-	if (cachePtr == sharedPtr) {
-    	    Tcl_DStringAppendElement(dsPtr, "shared");
-	} else {
-	    sprintf(buf, "thread%d", (int) cachePtr->owner);
-    	    Tcl_DStringAppendElement(dsPtr, buf);
-	}
-	for (n = 0; n < NBUCKETS; ++n) {
-    	    sprintf(buf, "%d %d %d %d %d %d %d",
-		binfo[n].blocksize,
-		cachePtr->buckets[n].nfree,
-		cachePtr->buckets[n].nget,
-		cachePtr->buckets[n].nput,
-		cachePtr->buckets[n].nrequest,
-		cachePtr->buckets[n].nlock,
-		cachePtr->buckets[n].nwait);
-	    Tcl_DStringAppendElement(dsPtr, buf);
-	}
-	Tcl_DStringEndSublist(dsPtr);
-	    cachePtr = cachePtr->nextPtr;
-    }
-    pthread_mutex_unlock(&listlock);
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * MoveObjs --
- *
- *	Move Tcl_Obj's between caches.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *  	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove)
-{
-    register Tcl_Obj *objPtr;
-
-    toPtr->nobjs += nmove;
-    fromPtr->nobjs -= nmove;
-    while (--nmove >= 0) {
-	objPtr = fromPtr->firstObjPtr;
-	fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
-	objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr;
-	toPtr->firstObjPtr = objPtr;
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- *  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->b_magic1 = blockPtr->b_magic2 = MAGIC;
-    blockPtr->b_bucket = bucket;
-    blockPtr->b_reqsize = 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->b_magic1 != MAGIC
-#if RCHECK
-	|| ((unsigned char *) ptr)[blockPtr->b_reqsize] != MAGIC
-#endif
-	|| blockPtr->b_magic2 != MAGIC) {
-	panic("alloc: invalid block: %p: %x %x %x\n",
-	    blockPtr, blockPtr->b_magic1, blockPtr->b_magic2,
-	    ((unsigned char *) ptr)[blockPtr->b_reqsize]);
-    }
-    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)
-{
-    int err;
-
-    err = pthread_mutex_trylock(&binfo[bucket].lock);
-    if (err == EBUSY) {
-	err = pthread_mutex_lock(&binfo[bucket].lock);
-	if (err != 0) {
-	    panic("alloc: pthread_mutex_lock: %s", strerror(err));
-	}
-	++cachePtr->buckets[bucket].nwait;
-	++sharedPtr->buckets[bucket].nwait;
-    } else if (err != 0) {
-	panic("alloc: pthread_mutex_trylock: %s", strerror(err));
-    }
-    ++cachePtr->buckets[bucket].nlock;
-    ++sharedPtr->buckets[bucket].nlock;
-}
-
-
-static void
-UnlockBucket(Cache *cachePtr, int bucket)
-{
-    int err;
-
-    err = pthread_mutex_unlock(&binfo[bucket].lock);
-    if (err != 0) {
-	panic("alloc: pthread_mutex_unlock: %s", strerror(err));
-    }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- *  PutBlocks --
- *
- *	Return unused blocks to the shared cache.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PutBlocks(Cache *cachePtr, int bucket, int nmove)
-{
-    register Block *lastPtr, *firstPtr;
-    register int n = nmove;
-
-    /*
-     * 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->b_next;
-    }
-    cachePtr->buckets[bucket].firstPtr = lastPtr->b_next;
-    cachePtr->buckets[bucket].nfree -= nmove;
-
-    /*
-     * Aquire the lock and place the list of blocks at the front
-     * of the shared cache bucket.
-     */
-
-    LockBucket(cachePtr, bucket);
-    lastPtr->b_next = sharedPtr->buckets[bucket].firstPtr;
-    sharedPtr->buckets[bucket].firstPtr = firstPtr;
-    sharedPtr->buckets[bucket].nfree += nmove;
-    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;
-    register size_t size;
-
-    /*
-     * First, atttempt to move blocks from the shared cache.  Note
-     * the potentially dirty read of nfree 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].nfree > 0) {
-	LockBucket(cachePtr, bucket);
-	if (sharedPtr->buckets[bucket].nfree > 0) {
-
-	    /*
-	     * Either move the entire list or walk the list to find
-	     * the last block to move.
-	     */
-
-	    n = binfo[bucket].nmove;
-	    if (n >= sharedPtr->buckets[bucket].nfree) {
-		cachePtr->buckets[bucket].firstPtr = sharedPtr->buckets[bucket].firstPtr;
-		cachePtr->buckets[bucket].nfree = sharedPtr->buckets[bucket].nfree;
-		sharedPtr->buckets[bucket].firstPtr = NULL;
-		sharedPtr->buckets[bucket].nfree = 0;
-	    } else {
-		blockPtr = sharedPtr->buckets[bucket].firstPtr;
-		cachePtr->buckets[bucket].firstPtr = blockPtr;
-		sharedPtr->buckets[bucket].nfree -= n;
-		cachePtr->buckets[bucket].nfree = n;
-		while (--n > 0) {
-    		    blockPtr = blockPtr->b_next;
-		}
-		sharedPtr->buckets[bucket].firstPtr = blockPtr->b_next;
-		blockPtr->b_next = NULL;
-	    }
-	}
-	UnlockBucket(cachePtr, bucket);
-    }
-    
-    if (cachePtr->buckets[bucket].nfree == 0) {
-
-	/*
-	 * If no blocks could be moved from shared, first look for a
-	 * larger block in this cache to split up.
-	 */
-
-	size = 0;		/* lint */
-    	blockPtr = NULL;
-	n = NBUCKETS;
-	while (--n > bucket) {
-    	    if (cachePtr->buckets[n].nfree > 0) {
-		size = binfo[n].blocksize;
-		blockPtr = cachePtr->buckets[n].firstPtr;
-		cachePtr->buckets[n].firstPtr = blockPtr->b_next;
-		--cachePtr->buckets[n].nfree;
-		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 / binfo[bucket].blocksize;
-	cachePtr->buckets[bucket].nfree = n;
-	cachePtr->buckets[bucket].firstPtr = blockPtr;
-	while (--n > 0) {
-	    blockPtr->b_next = (Block *) 
-		((char *) blockPtr + binfo[bucket].blocksize);
-	    blockPtr = blockPtr->b_next;
-	}
-	blockPtr->b_next = NULL;
-    }
-    return 1;
-}
-
-/*
- * END TCL_THREADS MEMORY ALLOCATOR
- */
-
-#elif USE_TCLALLOC
+#if USE_TCLALLOC
 
 #ifdef TCL_DEBUG
 #   define DEBUG
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 145d6b8..e685e77 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.82 2002/02/27 06:39:26 hobbs Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.83 2002/02/27 07:08:28 hobbs Exp $
  */
 
 #ifndef _TCLINT
@@ -2125,8 +2125,6 @@ EXTERN int	TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
-EXTERN int	TclCompileGetsCmd _ANSI_ARGS_((Tcl_Interp *interp,
-		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 EXTERN int	TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
@@ -2246,39 +2244,15 @@ EXTERN int	TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
 	TclIncrObjsFreed(); \
     }
 
-#elif defined(TCL_THREADS)
-
-/*
- * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's
- * from per-thread caches.
- */
-
-EXTERN Tcl_Obj *TclThreadAllocObj _ANSI_ARGS_((void));
-EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
-
-#  define TclNewObj(objPtr) \
-    (objPtr) = TclThreadAllocObj(); \
-    (objPtr)->refCount = 0; \
-    (objPtr)->bytes    = tclEmptyStringRep; \
-    (objPtr)->length   = 0; \
-    (objPtr)->typePtr  = NULL
-
-#  define TclDecrRefCount(objPtr) \
-    if (--(objPtr)->refCount <= 0) { \
-	if (((objPtr)->bytes != NULL) \
-		&& ((objPtr)->bytes != tclEmptyStringRep)) { \
-	    ckfree((char *) (objPtr)->bytes); \
-	} \
-	if (((objPtr)->typePtr != NULL) \
-		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
-	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
-	} \
-	TclThreadFreeObj((objPtr)); \
-    }
-
 #else /* not TCL_MEM_DEBUG */
 
+#ifdef TCL_THREADS
+/* declared in tclObj.c */
+extern Tcl_Mutex tclObjMutex;
+#endif
+
 #  define TclNewObj(objPtr) \
+    Tcl_MutexLock(&tclObjMutex); \
     if (tclFreeObjList == NULL) { \
 	TclAllocateFreeObjects(); \
     } \
@@ -2289,7 +2263,8 @@ EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
-    TclIncrObjsAllocated();
+    TclIncrObjsAllocated(); \
+    Tcl_MutexUnlock(&tclObjMutex)
 
 #  define TclDecrRefCount(objPtr) \
     if (--(objPtr)->refCount <= 0) { \
@@ -2301,9 +2276,11 @@ EXTERN void TclThreadFreeObj _ANSI_ARGS_((Tcl_Obj *));
 		&& ((objPtr)->typePtr->freeIntRepProc != NULL)) { \
 	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
 	} \
+	Tcl_MutexLock(&tclObjMutex); \
 	(objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
 	tclFreeObjList = (objPtr); \
 	TclIncrObjsFreed(); \
+	Tcl_MutexUnlock(&tclObjMutex); \
     }
 #endif /* TCL_MEM_DEBUG */
 
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 8bf059b..15b84ca 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclObj.c,v 1.31 2002/02/27 06:39:27 hobbs Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.32 2002/02/27 07:08:28 hobbs Exp $
  */
 
 #include "tclInt.h"
@@ -30,8 +30,15 @@ TCL_DECLARE_MUTEX(tableMutex)
  * Head of the list of free Tcl_Obj structs we maintain.
  */
 
-#ifndef TCL_THREADS
 Tcl_Obj *tclFreeObjList = NULL;
+
+/*
+ * The object allocator is single threaded.  This mutex is referenced
+ * by the TclNewObj macro, however, so must be visible.
+ */
+
+#ifdef TCL_THREADS
+Tcl_Mutex tclObjMutex;
 #endif
 
 /*
@@ -239,6 +246,7 @@ TclInitObjSubsystem()
     Tcl_RegisterObjType(&tclCmdNameType);
 
 #ifdef TCL_COMPILE_STATS
+    Tcl_MutexLock(&tclObjMutex);
     tclObjsAlloced = 0;
     tclObjsFreed = 0;
     {
@@ -247,6 +255,7 @@ TclInitObjSubsystem()
 	    tclObjsShared[i] = 0;
 	}
     }
+    Tcl_MutexUnlock(&tclObjMutex);
 #endif
 }
 
@@ -277,9 +286,9 @@ TclFinalizeCompExecEnv()
         typeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
-#ifndef TCL_THREADS
+    Tcl_MutexLock(&tclObjMutex);
     tclFreeObjList = NULL;
-#endif
+    Tcl_MutexUnlock(&tclObjMutex);
 
     TclFinalizeCompilation();
     TclFinalizeExecution();
@@ -511,10 +520,9 @@ Tcl_NewObj()
      * we maintain.
      */
 
+    Tcl_MutexLock(&tclObjMutex);
 #ifdef PURIFY
     objPtr = (Tcl_Obj *) Tcl_Ckalloc(sizeof(Tcl_Obj));
-#elif defined(TCL_THREADS)
-    objPtr = TclThreadAllocObj();
 #else
     if (tclFreeObjList == NULL) {
 	TclAllocateFreeObjects();
@@ -529,6 +537,7 @@ Tcl_NewObj()
 #ifdef TCL_COMPILE_STATS
     tclObjsAlloced++;
 #endif /* TCL_COMPILE_STATS */
+    Tcl_MutexUnlock(&tclObjMutex);
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -583,7 +592,9 @@ Tcl_DbNewObj(file, line)
     objPtr->length   = 0;
     objPtr->typePtr  = NULL;
 #ifdef TCL_COMPILE_STATS
+    Tcl_MutexLock(&tclObjMutex);
     tclObjsAlloced++;
+    Tcl_MutexUnlock(&tclObjMutex);
 #endif /* TCL_COMPILE_STATS */
     return objPtr;
 }
@@ -627,7 +638,6 @@ Tcl_DbNewObj(file, line)
 void
 TclAllocateFreeObjects()
 {
-#ifndef TCL_THREADS
     size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
     char *basePtr;
     register Tcl_Obj *prevPtr, *objPtr;
@@ -651,7 +661,6 @@ TclAllocateFreeObjects()
 	objPtr++;
     }
     tclFreeObjList = prevPtr;
-#endif
 }
 #undef OBJS_TO_ALLOC_EACH_TIME
 
@@ -703,10 +712,9 @@ TclFreeObj(objPtr)
      * Tcl_Obj structs we maintain.
      */
 
+    Tcl_MutexLock(&tclObjMutex);
 #if defined(TCL_MEM_DEBUG) || defined(PURIFY)
     ckfree((char *) objPtr);
-#elif defined(TCL_THREADS)
-    TclThreadFreeObj(objPtr);
 #else
     objPtr->internalRep.otherValuePtr = (VOID *) tclFreeObjList;
     tclFreeObjList = objPtr;
@@ -715,6 +723,7 @@ TclFreeObj(objPtr)
 #ifdef TCL_COMPILE_STATS
     tclObjsFreed++;
 #endif /* TCL_COMPILE_STATS */
+    Tcl_MutexUnlock(&tclObjMutex);
 }
 
 /*
@@ -2577,6 +2586,7 @@ Tcl_DbIsShared(objPtr, file, line)
     }
 #endif
 #ifdef TCL_COMPILE_STATS
+    Tcl_MutexLock(&tclObjMutex);
     if ((objPtr)->refCount <= 1) {
 	tclObjsShared[1]++;
     } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
@@ -2584,6 +2594,7 @@ Tcl_DbIsShared(objPtr, file, line)
     } else {
 	tclObjsShared[0]++;
     }
+    Tcl_MutexUnlock(&tclObjMutex);
 #endif
     return ((objPtr)->refCount > 1);
 }