diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-18 17:31:11 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-18 17:31:11 (GMT) |
commit | 066971b1e6e77991d9161bb0216a63ba94ea04f9 (patch) | |
tree | 6de02f79b7a4bb08a329581aa67b444fb9001bfd /tcl8.6/generic/tclAlloc.c | |
parent | ba065c2de121da1c1dfddd0aa587d10e7e150f05 (diff) | |
parent | 9966985d896629eede849a84f18e406d1164a16c (diff) | |
download | blt-066971b1e6e77991d9161bb0216a63ba94ea04f9.zip blt-066971b1e6e77991d9161bb0216a63ba94ea04f9.tar.gz blt-066971b1e6e77991d9161bb0216a63ba94ea04f9.tar.bz2 |
Merge commit '9966985d896629eede849a84f18e406d1164a16c' as 'tcl8.6'
Diffstat (limited to 'tcl8.6/generic/tclAlloc.c')
-rw-r--r-- | tcl8.6/generic/tclAlloc.c | 759 |
1 files changed, 759 insertions, 0 deletions
diff --git a/tcl8.6/generic/tclAlloc.c b/tcl8.6/generic/tclAlloc.c new file mode 100644 index 0000000..cda1f38 --- /dev/null +++ b/tcl8.6/generic/tclAlloc.c @@ -0,0 +1,759 @@ +/* + * tclAlloc.c -- + * + * This is a very fast storage allocator. It allocates blocks of a small + * number of different sizes, and keeps free lists of each size. Blocks + * that don't exactly fit are passed up to the next larger size. Blocks + * over a certain size are directly allocated from the system. + * + * Copyright (c) 1983 Regents of the University of California. + * Copyright (c) 1996-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. + * + * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +/* + * Windows and Unix use an alternative allocator when building with threads + * that has significantly reduced lock contention. + */ + +#include "tclInt.h" +#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) + +#if USE_TCLALLOC + +/* + * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait + * until Tcl uses config.h properly. + */ + +#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__) +typedef unsigned long caddr_t; +#endif + +/* + * The overhead on a block is at least 8 bytes. When free, this space contains + * a pointer to the next free block, and the bottom two bits must be zero. + * When in use, the first byte is set to MAGIC, and the second byte is the + * size index. The remaining bytes are for alignment. If range checking is + * enabled then a second word holds the size of the requested block, less 1, + * rounded up to a multiple of sizeof(RMAGIC). The order of elements is + * critical: ov.magic must overlay the low order bits of ov.next, and ov.magic + * can not be a valid ov.next bit pattern. + */ + +union overhead { + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ + struct { + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ +#ifndef NDEBUG + unsigned short rmagic; /* range magic number */ + unsigned long size; /* actual block size */ + unsigned short unused2; /* padding to 8-byte align */ +#endif + } ovu; +#define overMagic0 ovu.magic0 +#define overMagic1 ovu.magic1 +#define bucketIndex ovu.index +#define rangeCheckMagic ovu.rmagic +#define realBlockSize ovu.size +}; + + +#define MAGIC 0xef /* magic # on accounting info */ +#define RMAGIC 0x5555 /* magic # on range info */ + +#ifndef NDEBUG +#define RSLOP sizeof(unsigned short) +#else +#define RSLOP 0 +#endif + +#define OVERHEAD (sizeof(union overhead) + RSLOP) + +/* + * Macro to make it easier to refer to the end-of-block guard magic. + */ + +#define BLOCK_END(overPtr) \ + (*(unsigned short *)((caddr_t)((overPtr) + 1) + (overPtr)->realBlockSize)) + +/* + * nextf[i] is the pointer to the next free block of size 2^(i+3). The + * smallest allocatable block is MINBLOCK bytes. The overhead information + * precedes the data area returned to the user. + */ + +#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) +#define NBUCKETS (13 - (MINBLOCK >> 4)) +#define MAXMALLOC (1<<(NBUCKETS+2)) +static union overhead *nextf[NBUCKETS]; + +/* + * The following structure is used to keep track of all system memory + * currently owned by Tcl. When finalizing, all this memory will be returned + * to the system. + */ + +struct block { + struct block *nextPtr; /* Linked list. */ + struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte + * alignment for suballocated blocks. */ +}; + +static struct block *blockList; /* Tracks the suballocated blocks. */ +static struct block bigBlocks={ /* Big blocks aren't suballocated. */ + &bigBlocks, &bigBlocks +}; + +/* + * The allocator is protected by a special mutex that must be explicitly + * initialized. Futhermore, because Tcl_Alloc may be used before anything else + * in Tcl, we make this module self-initializing after all with the allocInit + * variable. + */ + +#ifdef TCL_THREADS +static Tcl_Mutex *allocMutexPtr; +#endif +static int allocInit = 0; + +#ifdef MSTATS + +/* + * numMallocs[i] is the difference between the number of mallocs and frees for + * a given block size. + */ + +static unsigned int numMallocs[NBUCKETS+1]; +#endif + +#if !defined(NDEBUG) +#define ASSERT(p) if (!(p)) Tcl_Panic(# p) +#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p) +#else +#define ASSERT(p) +#define RANGE_ASSERT(p) +#endif + +/* + * Prototypes for functions used only in this file. + */ + +static void MoreCore(int bucket); + +/* + *------------------------------------------------------------------------- + * + * TclInitAlloc -- + * + * Initialize the memory system. + * + * Results: + * None. + * + * Side effects: + * Initialize the mutex used to serialize allocations. + * + *------------------------------------------------------------------------- + */ + +void +TclInitAlloc(void) +{ + if (!allocInit) { + allocInit = 1; +#ifdef TCL_THREADS + allocMutexPtr = Tcl_GetAllocMutex(); +#endif + } +} + +/* + *------------------------------------------------------------------------- + * + * TclFinalizeAllocSubsystem -- + * + * Release all resources being used by this subsystem, including + * aggressively freeing all memory allocated by TclpAlloc() that has not + * yet been released with TclpFree(). + * + * After this function is called, all memory allocated with TclpAlloc() + * should be considered unusable. + * + * Results: + * None. + * + * Side effects: + * This subsystem is self-initializing, since memory can be allocated + * before Tcl is formally initialized. After this call, this subsystem + * has been reset to its initial state and is usable again. + * + *------------------------------------------------------------------------- + */ + +void +TclFinalizeAllocSubsystem(void) +{ + unsigned int i; + struct block *blockPtr, *nextPtr; + + Tcl_MutexLock(allocMutexPtr); + for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) { + nextPtr = blockPtr->nextPtr; + TclpSysFree(blockPtr); + } + blockList = NULL; + + for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) { + nextPtr = blockPtr->nextPtr; + TclpSysFree(blockPtr); + blockPtr = nextPtr; + } + bigBlocks.nextPtr = &bigBlocks; + bigBlocks.prevPtr = &bigBlocks; + + for (i=0 ; i<NBUCKETS ; i++) { + nextf[i] = NULL; +#ifdef MSTATS + numMallocs[i] = 0; +#endif + } +#ifdef MSTATS + numMallocs[i] = 0; +#endif + Tcl_MutexUnlock(allocMutexPtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclpAlloc -- + * + * Allocate more memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +TclpAlloc( + unsigned int numBytes) /* Number of bytes to allocate. */ +{ + register union overhead *overPtr; + register long bucket; + register unsigned amount; + struct block *bigBlockPtr = NULL; + + if (!allocInit) { + /* + * We have to make the "self initializing" because Tcl_Alloc may be + * used before any other part of Tcl. E.g., see main() for tclsh! + */ + + TclInitAlloc(); + } + Tcl_MutexLock(allocMutexPtr); + + /* + * First the simple case: we simple allocate big blocks directly. + */ + + if (numBytes >= MAXMALLOC - OVERHEAD) { + if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) { + bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) + (sizeof(struct block) + OVERHEAD + numBytes), 0); + } + if (bigBlockPtr == NULL) { + Tcl_MutexUnlock(allocMutexPtr); + return NULL; + } + bigBlockPtr->nextPtr = bigBlocks.nextPtr; + bigBlocks.nextPtr = bigBlockPtr; + bigBlockPtr->prevPtr = &bigBlocks; + bigBlockPtr->nextPtr->prevPtr = bigBlockPtr; + + overPtr = (union overhead *) (bigBlockPtr + 1); + overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; + overPtr->bucketIndex = 0xff; +#ifdef MSTATS + numMallocs[NBUCKETS]++; +#endif + +#ifndef NDEBUG + /* + * Record allocated size of block and bound space with magic numbers. + */ + + overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); + overPtr->rangeCheckMagic = RMAGIC; + BLOCK_END(overPtr) = RMAGIC; +#endif + + Tcl_MutexUnlock(allocMutexPtr); + return (void *)(overPtr+1); + } + + /* + * Convert amount of memory requested into closest block size stored in + * hash buckets which satisfies request. Account for space used per block + * for accounting. + */ + + amount = MINBLOCK; /* size of first bucket */ + bucket = MINBLOCK >> 4; + + while (numBytes + OVERHEAD > amount) { + amount <<= 1; + if (amount == 0) { + Tcl_MutexUnlock(allocMutexPtr); + return NULL; + } + bucket++; + } + ASSERT(bucket < NBUCKETS); + + /* + * If nothing in hash bucket right now, request more memory from the + * system. + */ + + if ((overPtr = nextf[bucket]) == NULL) { + MoreCore(bucket); + if ((overPtr = nextf[bucket]) == NULL) { + Tcl_MutexUnlock(allocMutexPtr); + return NULL; + } + } + + /* + * Remove from linked list + */ + + nextf[bucket] = overPtr->next; + overPtr->overMagic0 = overPtr->overMagic1 = MAGIC; + overPtr->bucketIndex = (unsigned char) bucket; + +#ifdef MSTATS + numMallocs[bucket]++; +#endif + +#ifndef NDEBUG + /* + * Record allocated size of block and bound space with magic numbers. + */ + + overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); + overPtr->rangeCheckMagic = RMAGIC; + BLOCK_END(overPtr) = RMAGIC; +#endif + + Tcl_MutexUnlock(allocMutexPtr); + return ((char *)(overPtr + 1)); +} + +/* + *---------------------------------------------------------------------- + * + * MoreCore -- + * + * Allocate more memory to the indicated bucket. + * + * Assumes Mutex is already held. + * + * Results: + * None. + * + * Side effects: + * Attempts to get more memory from the system. + * + *---------------------------------------------------------------------- + */ + +static void +MoreCore( + int bucket) /* What bucket to allocat to. */ +{ + register union overhead *overPtr; + register long size; /* size of desired block */ + long amount; /* amount to allocate */ + int numBlocks; /* how many blocks we get */ + struct block *blockPtr; + + /* + * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a + * VAX, I think) or for a negative arg. + */ + + size = 1 << (bucket + 3); + ASSERT(size > 0); + + amount = MAXMALLOC; + numBlocks = amount / size; + ASSERT(numBlocks*size == amount); + + blockPtr = (struct block *) TclpSysAlloc((unsigned) + (sizeof(struct block) + amount), 1); + /* no more room! */ + if (blockPtr == NULL) { + return; + } + blockPtr->nextPtr = blockList; + blockList = blockPtr; + + overPtr = (union overhead *) (blockPtr + 1); + + /* + * Add new memory allocated to that on free list for this hash bucket. + */ + + nextf[bucket] = overPtr; + while (--numBlocks > 0) { + overPtr->next = (union overhead *)((caddr_t)overPtr + size); + overPtr = (union overhead *)((caddr_t)overPtr + size); + } + overPtr->next = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * TclpFree -- + * + * Free memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpFree( + char *oldPtr) /* Pointer to memory to free. */ +{ + register long size; + register union overhead *overPtr; + struct block *bigBlockPtr; + + if (oldPtr == NULL) { + return; + } + + Tcl_MutexLock(allocMutexPtr); + overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead)); + + ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */ + ASSERT(overPtr->overMagic1 == MAGIC); + if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) { + Tcl_MutexUnlock(allocMutexPtr); + return; + } + + RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); + RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); + size = overPtr->bucketIndex; + if (size == 0xff) { +#ifdef MSTATS + numMallocs[NBUCKETS]--; +#endif + + bigBlockPtr = (struct block *) overPtr - 1; + bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr; + bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr; + TclpSysFree(bigBlockPtr); + + Tcl_MutexUnlock(allocMutexPtr); + return; + } + ASSERT(size < NBUCKETS); + overPtr->next = nextf[size]; /* also clobbers overMagic */ + nextf[size] = overPtr; + +#ifdef MSTATS + numMallocs[size]--; +#endif + + Tcl_MutexUnlock(allocMutexPtr); +} + +/* + *---------------------------------------------------------------------- + * + * TclpRealloc -- + * + * Reallocate memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +TclpRealloc( + char *oldPtr, /* Pointer to alloced block. */ + unsigned int numBytes) /* New size of memory. */ +{ + int i; + union overhead *overPtr; + struct block *bigBlockPtr; + int expensive; + unsigned long maxSize; + + if (oldPtr == NULL) { + return TclpAlloc(numBytes); + } + + Tcl_MutexLock(allocMutexPtr); + + overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead)); + + ASSERT(overPtr->overMagic0 == MAGIC); /* make sure it was in use */ + ASSERT(overPtr->overMagic1 == MAGIC); + if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) { + Tcl_MutexUnlock(allocMutexPtr); + return NULL; + } + + RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); + RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); + i = overPtr->bucketIndex; + + /* + * If the block isn't in a bin, just realloc it. + */ + + if (i == 0xff) { + struct block *prevPtr, *nextPtr; + bigBlockPtr = (struct block *) overPtr - 1; + prevPtr = bigBlockPtr->prevPtr; + nextPtr = bigBlockPtr->nextPtr; + bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, + sizeof(struct block) + OVERHEAD + numBytes); + if (bigBlockPtr == NULL) { + Tcl_MutexUnlock(allocMutexPtr); + return NULL; + } + + if (prevPtr->nextPtr != bigBlockPtr) { + /* + * If the block has moved, splice the new block into the list + * where the old block used to be. + */ + + prevPtr->nextPtr = bigBlockPtr; + nextPtr->prevPtr = bigBlockPtr; + } + + overPtr = (union overhead *) (bigBlockPtr + 1); + +#ifdef MSTATS + numMallocs[NBUCKETS]++; +#endif + +#ifndef NDEBUG + /* + * Record allocated size of block and update magic number bounds. + */ + + overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); + BLOCK_END(overPtr) = RMAGIC; +#endif + + Tcl_MutexUnlock(allocMutexPtr); + return (char *)(overPtr+1); + } + maxSize = 1 << (i+3); + expensive = 0; + if (numBytes+OVERHEAD > maxSize) { + expensive = 1; + } else if (i>0 && numBytes+OVERHEAD < maxSize/2) { + expensive = 1; + } + + if (expensive) { + void *newPtr; + + Tcl_MutexUnlock(allocMutexPtr); + + newPtr = TclpAlloc(numBytes); + if (newPtr == NULL) { + return NULL; + } + maxSize -= OVERHEAD; + if (maxSize < numBytes) { + numBytes = maxSize; + } + memcpy(newPtr, oldPtr, (size_t) numBytes); + TclpFree(oldPtr); + return newPtr; + } + + /* + * Ok, we don't have to copy, it fits as-is + */ + +#ifndef NDEBUG + overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); + BLOCK_END(overPtr) = RMAGIC; +#endif + + Tcl_MutexUnlock(allocMutexPtr); + return(oldPtr); +} + +/* + *---------------------------------------------------------------------- + * + * mstats -- + * + * Prints two lines of numbers, one showing the length of the free list + * for each size category, the second showing the number of mallocs - + * frees for each size category. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#ifdef MSTATS +void +mstats( + char *s) /* Where to write info. */ +{ + register int i, j; + register union overhead *overPtr; + int totalFree = 0, totalUsed = 0; + + Tcl_MutexLock(allocMutexPtr); + + fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s); + for (i = 0; i < NBUCKETS; i++) { + for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) { + fprintf(stderr, " %d", j); + } + totalFree += j * (1 << (i + 3)); + } + + fprintf(stderr, "\nused:\t"); + for (i = 0; i < NBUCKETS; i++) { + fprintf(stderr, " %d", numMallocs[i]); + totalUsed += numMallocs[i] * (1 << (i + 3)); + } + + fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n", + totalUsed, totalFree); + fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", + MAXMALLOC, numMallocs[NBUCKETS]); + + Tcl_MutexUnlock(allocMutexPtr); +} +#endif + +#else /* !USE_TCLALLOC */ + +/* + *---------------------------------------------------------------------- + * + * TclpAlloc -- + * + * Allocate more memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +TclpAlloc( + unsigned int numBytes) /* Number of bytes to allocate. */ +{ + return (char *) malloc(numBytes); +} + +/* + *---------------------------------------------------------------------- + * + * TclpFree -- + * + * Free memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +void +TclpFree( + char *oldPtr) /* Pointer to memory to free. */ +{ + free(oldPtr); + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclpRealloc -- + * + * Reallocate memory. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +char * +TclpRealloc( + char *oldPtr, /* Pointer to alloced block. */ + unsigned int numBytes) /* New size of memory. */ +{ + return (char *) realloc(oldPtr, numBytes); +} + +#endif /* !USE_TCLALLOC */ +#endif /* !TCL_THREADS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |