diff options
Diffstat (limited to 'tcl8.6/generic/tclThreadAlloc.c')
| -rw-r--r-- | tcl8.6/generic/tclThreadAlloc.c | 1185 |
1 files changed, 1185 insertions, 0 deletions
diff --git a/tcl8.6/generic/tclThreadAlloc.c b/tcl8.6/generic/tclThreadAlloc.c new file mode 100644 index 0000000..018f006 --- /dev/null +++ b/tcl8.6/generic/tclThreadAlloc.c @@ -0,0 +1,1185 @@ +/* + * 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 used + * in this file. + * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread). + * + * 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: + */ |