rm tcl/tk 8.6.7

1 files changed, 0 insertions, 1185 deletions

diff --git a/tcl8.6/generic/tclThreadAlloc.c b/tcl8.6/generic/tclThreadAlloc.c
deleted file mode 100644
index 2ee758e..0000000
--- a/tcl8.6/generic/tclThreadAlloc.c
+++ /dev/null
@@ -1,1185 +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 */
-    Block *lastPtr;		/* End of block list */
-    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 */
-    Tcl_Obj *lastPtr;		/* Last object in this cache */
-    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);
-static void	PutObjs(Cache *fromPtr, 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;
-
-#if defined(HAVE_FAST_TSD)
-static __thread Cache *tcachePtr;
-
-# define GETCACHE(cachePtr)			\
-    do {					\
-	if (!tcachePtr) {			\
-	    tcachePtr = GetCache();		\
-	}					\
-	(cachePtr) = tcachePtr;			\
-    } while (0)
-#else
-# define GETCACHE(cachePtr)			\
-    do {					\
-	(cachePtr) = TclpGetAllocCache();	\
-	if ((cachePtr) == NULL) {		\
-	    (cachePtr) = GetCache();		\
-	}					\
-    } while (0)
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = TclpSysAlloc(sizeof(Cache), 0);
-	if (cachePtr == NULL) {
-	    Tcl_Panic("alloc: could not allocate new cache");
-	}
-        memset(cachePtr, 0, sizeof(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) {
-	PutObjs(cachePtr, cachePtr->numObjects);
-    }
-
-    /*
-     * Remove from pool list.
-     */
-
-    Tcl_MutexLock(listLockPtr);
-    nextPtrPtr = &firstCachePtr;
-    while (*nextPtrPtr != cachePtr) {
-	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
-    }
-    *nextPtrPtr = cachePtr->nextPtr;
-    cachePtr->nextPtr = NULL;
-    Tcl_MutexUnlock(listLockPtr);
-    TclpSysFree(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
-
-    GETCACHE(cachePtr);
-
-    /*
-     * Increment the requested size to include room for the Block structure.
-     * Call TclpSysAlloc() 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 = TclpSysAlloc(size, 0);
-	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;
-    }
-
-    GETCACHE(cachePtr);
-
-    /*
-     * Get the block back from the user pointer and call system free directly
-     * for large blocks. Otherwise, push the block back on the bucket and move
-     * blocks to the shared cache if there are now too many free.
-     */
-
-    blockPtr = Ptr2Block(ptr);
-    bucket = blockPtr->sourceBucket;
-    if (bucket == NBUCKETS) {
-	cachePtr->totalAssigned -= blockPtr->blockReqSize;
-	TclpSysFree(blockPtr);
-	return;
-    }
-
-    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
-    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
-    cachePtr->buckets[bucket].firstPtr = blockPtr;
-    if (cachePtr->buckets[bucket].numFree == 0) {
-	cachePtr->buckets[bucket].lastPtr = 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
-
-    GETCACHE(cachePtr);
-
-    /*
-     * If the block is not a system block and fits in place, simply return the
-     * existing pointer. Otherwise, if the block is a system block and the new
-     * size would also require a system block, call TclpSysRealloc() 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 = TclpSysRealloc(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;
-    register Tcl_Obj *objPtr;
-
-    GETCACHE(cachePtr);
-
-    /*
-     * 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 = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
-	    if (newObjsPtr == NULL) {
-		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
-	    }
-	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
-	    objPtr = cachePtr->firstObjPtr;	/* NULL */
-	    while (--numMove >= 0) {
-		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
-		objPtr = newObjsPtr + numMove;
-	    }
-	    cachePtr->firstObjPtr = newObjsPtr;
-	}
-    }
-
-    /*
-     * Pop the first object.
-     */
-
-    objPtr = cachePtr->firstObjPtr;
-    cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    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;
-
-    GETCACHE(cachePtr);
-
-    /*
-     * Get this thread's list and push on the free Tcl_Obj.
-     */
-
-    objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
-    cachePtr->firstObjPtr = objPtr;
-    if (cachePtr->numObjects == 0) {
-	cachePtr->lastPtr = 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) {
-	PutObjs(cachePtr, NOBJALLOC);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.twoPtrValue.ptr1;
-    }
-    fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    /*
-     * Move all objects as a block - they are already linked to each other, we
-     * just have to update the first and last.
-     */
-
-    toPtr->lastPtr = objPtr;
-    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
-    toPtr->firstObjPtr = fromFirstObjPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PutObjs --
- *
- *	Move Tcl_Obj's from thread cache to shared cache.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PutObjs(
-    Cache *fromPtr,
-    int numMove)
-{
-    int keep = fromPtr->numObjects - numMove;
-    Tcl_Obj *firstPtr, *lastPtr = NULL;
-
-    fromPtr->numObjects = keep;
-    firstPtr = fromPtr->firstObjPtr;
-    if (keep == 0) {
-	fromPtr->firstObjPtr = NULL;
-    } else {
-	do {
-	    lastPtr = firstPtr;
-	    firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
-	} while (--keep > 0);
-	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
-    }
-
-    /*
-     * Move all objects as a block - they are already linked to each other, we
-     * just have to update the first and last.
-     */
-
-    Tcl_MutexLock(objLockPtr);
-    fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
-    sharedPtr->firstObjPtr = firstPtr;
-    if (sharedPtr->numObjects == 0) {
-	sharedPtr->lastPtr = fromPtr->lastPtr;
-    }
-    sharedPtr->numObjects += numMove;
-    Tcl_MutexUnlock(objLockPtr);
-
-    fromPtr->lastPtr = lastPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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)
-{
-    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-    cachePtr->buckets[bucket].numLocks++;
-    sharedPtr->buckets[bucket].numLocks++;
-}
-
-static void
-UnlockBucket(
-    Cache *cachePtr,
-    int bucket)
-{
-    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PutBlocks --
- *
- *	Return unused blocks to the shared cache.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PutBlocks(
-    Cache *cachePtr,
-    int bucket,
-    int numMove)
-{
-    /*
-     * We have numFree.  Want to shed numMove. So compute how many
-     * Blocks to keep.
-     */
-
-    int keep = cachePtr->buckets[bucket].numFree - numMove;
-    Block *lastPtr = NULL, *firstPtr;
-
-    cachePtr->buckets[bucket].numFree = keep;
-    firstPtr = cachePtr->buckets[bucket].firstPtr;
-    if (keep == 0) {
-	cachePtr->buckets[bucket].firstPtr = NULL;
-    } else {
-	do {
-	    lastPtr = firstPtr;
-	    firstPtr = firstPtr->nextBlock;
-	} while (--keep > 0);
-	lastPtr->nextBlock = NULL;
-    }
-
-    /*
-     * Aquire the lock and place the list of blocks at the front of the shared
-     * cache bucket.
-     */
-
-    LockBucket(cachePtr, bucket);
-    cachePtr->buckets[bucket].lastPtr->nextBlock
-	    = sharedPtr->buckets[bucket].firstPtr;
-    sharedPtr->buckets[bucket].firstPtr = firstPtr;
-    if (sharedPtr->buckets[bucket].numFree == 0) {
-	sharedPtr->buckets[bucket].lastPtr
-		= cachePtr->buckets[bucket].lastPtr;
-    }
-    sharedPtr->buckets[bucket].numFree += numMove;
-    UnlockBucket(cachePtr, bucket);
-
-    cachePtr->buckets[bucket].lastPtr = lastPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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].lastPtr =
-			sharedPtr->buckets[bucket].lastPtr;
-		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;
-		cachePtr->buckets[bucket].lastPtr = blockPtr;
-		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 = TclpSysAlloc(size, 0);
-	    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;
-	}
-	cachePtr->buckets[bucket].lastPtr = blockPtr;
-	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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadAllocThread --
- *
- *	This procedure is used to destroy single thread private resources
- *	defined in this file. Called either during Tcl_FinalizeThread() or
- *	Tcl_Finalize().
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeThreadAllocThread(void)
-{
-    Cache *cachePtr = TclpGetAllocCache();
-    if (cachePtr != NULL) {
-	TclpFreeAllocCache(cachePtr);
-    }
-}
-
-#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:
- */