/* * 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.1.1.2 2009/03/23 15:10:40 duncan 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 /* * Alignment for allocated memory. */ #if defined(__APPLE__) #define ALLOCALIGN 16 #else #define ALLOCALIGN 8 #endif /* * 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[ALLOCALIGN]; } Block; #define b_next b.u.next #define b_bucket b.u.s.bucket #define b_magic1 b.u.s.magic1 #define b_magic2 b.u.s.magic2 #define MAGIC 0xef #define b_reqsize 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 + (ALLOCALIGN-1)) & ~(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; 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]; /* * 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; unsigned int i; initLockPtr = Tcl_GetAllocMutex(); Tcl_MutexLock(initLockPtr); if (listLockPtr == NULL) { listLockPtr = TclpNewAllocMutex(); objLockPtr = TclpNewAllocMutex(); for (i = 0; i < NBUCKETS; ++i) { binfo[i].blocksize = MINALLOC << i; binfo[i].maxblocks = 1 << (NBUCKETS - 1 - i); binfo[i].nmove = i < NBUCKETS-1 ? 1 << (NBUCKETS - 2 - i) : 1; 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 unsigned 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]; 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%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() { unsigned 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 * this file. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ void TclFinalizeThreadAlloc() { Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use."); } #endif /* TCL_THREADS */