/*

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

 *

 * RCS: @(#) $Id: tclThreadAlloc.c,v 1.4.2.7 2005/12/20 22:16:34 dkf Exp $ 

 */

#include "tclInt.h"

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)

#ifdef WIN32

#include "tclWinInt.h"

#else

extern Tcl_Mutex *TclpNewAllocMutex(void);

extern void *TclpGetAllocCache(void);

extern void TclpSetAllocCache(void *);

#endif

/*

 * 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 accounting and statistics information.

 */

typedef struct Bucket {

    Block *firstPtr;

    long nfree;

    long nget;

    long nput;

    long nwait;

    long nlock;

    long nrequest;

} Bucket;

/*

 * The following structure defines a cache of buckets and objs.

 */

typedef struct Cache {

    struct Cache  *nextPtr;

    Tcl_ThreadId   owner;

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

    Tcl_Mutex *lockPtr; /* Share bucket lock. */

} binfo[NBUCKETS] = {

    {   16, 1024, 512, NULL},

    {   32,  512, 256, NULL},

    {   64,  256, 128, NULL},

    {  128,  128,  64, NULL},

    {  256,   64,  32, NULL},

    {  512,   32,  16, NULL},

    { 1024,   16,   8, NULL},

    { 2048,    8,   4, NULL},

    { 4096,    4,   2, NULL},

    { 8192,    2,   1, NULL},

    {16284,    1,   1, NULL},

};

/*

 * 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 MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove);

/*

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

    	int i;

	initLockPtr = Tcl_GetAllocMutex();

	Tcl_MutexLock(initLockPtr);

	if (listLockPtr == NULL) {

	    listLockPtr = TclpNewAllocMutex();

	    objLockPtr = TclpNewAllocMutex();

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

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

	    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 int   bucket;

    /*

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

    	Tcl_MutexLock(objLockPtr);

    	MoveObjs(cachePtr, sharedPtr, cachePtr->nobjs);

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

    Block         *blockPtr;

    register int   bucket;

    size_t  	   size;

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

{

    if (ptr != NULL) {

	Cache  *cachePtr = TclpGetAllocCache();

	Block *blockPtr;

	int bucket;

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

    Block *blockPtr;

    void *new;

    size_t size, min;

    int bucket;

    if (ptr == NULL) {

	return TclpAlloc(reqsize);

    }

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

    register int nmove;

    register Tcl_Obj *objPtr;

    Tcl_Obj *newObjsPtr;

    if (cachePtr == NULL) {

	cachePtr = GetCache();

    }

    /*

     * Get this thread's obj list structure and move

     * or allocate new objs if necessary.

     */

    if (cachePtr->nobjs == 0) {

    	Tcl_MutexLock(objLockPtr);

	nmove = sharedPtr->nobjs;

	if (nmove > 0) {

	    if (nmove > NOBJALLOC) {

		nmove = NOBJALLOC;

	    }

	    MoveObjs(sharedPtr, cachePtr, nmove);

	}

    	Tcl_MutexUnlock(objLockPtr);

	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 = 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->nobjs;

    /*

     * If the number of free objects has exceeded the high

     * water mark, move some blocks to the shared list.

     */

    if (cachePtr->nobjs > 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];

    int n;

    Tcl_MutexLock(listLockPtr);

    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, "%lu %ld %ld %ld %ld %ld %ld",

		(unsigned long) 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;

    }

    Tcl_MutexUnlock(listLockPtr);

}

/*

 *----------------------------------------------------------------------

 *

 * 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 = fromPtr->firstObjPtr;

    Tcl_Obj *fromFirstObjPtr = objPtr;

    toPtr->nobjs += nmove;

    fromPtr->nobjs -= nmove;

    /*

     * 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 (--nmove) {

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

{

#if 0

    if (Tcl_MutexTryLock(binfo[bucket].lockPtr) != TCL_OK) {

	Tcl_MutexLock(binfo[bucket].lockPtr);

    	++cachePtr->buckets[bucket].nwait;

    	++sharedPtr->buckets[bucket].nwait;

    }

#else

    Tcl_MutexLock(binfo[bucket].lockPtr);

#endif

    ++cachePtr->buckets[bucket].nlock;

    ++sharedPtr->buckets[bucket].nlock;

}

static void

UnlockBucket(Cache *cachePtr, int bucket)

{

    Tcl_MutexUnlock(binfo[bucket].lockPtr);

}

/*

 *----------------------------------------------------------------------

 *

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

	 */

    	blockPtr = NULL;

	n = NBUCKETS;

	size = 0; /* lint */

	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;

}

/*

 *----------------------------------------------------------------------

 *

 * TclFinalizeThreadAlloc --

 *

 *	This procedure is used to destroy all private resources used in

 *	this file.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

void

TclFinalizeThreadAlloc()

{

    int i;

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

        TclpFreeAllocMutex(binfo[i].lockPtr); 

        binfo[i].lockPtr = NULL;

    }

    TclpFreeAllocMutex(objLockPtr);

    objLockPtr = NULL;

    TclpFreeAllocMutex(listLockPtr);

    listLockPtr = NULL;

    TclpFreeAllocCache(NULL);

}

#else /* ! defined(TCL_THREADS) && ! defined(USE_THREAD_ALLOC) */

/*

 *----------------------------------------------------------------------

 *

 * TclFinalizeThreadAlloc --

 *

 *	This procedure is used to destroy all private resources used in