Attachment "2557696.patch" to
ticket [2557696fff]
added by
dgp
2009-08-25 04:02:31.
Index: generic/tclAlloc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclAlloc.c,v
retrieving revision 1.27
diff -u -r1.27 tclAlloc.c
--- generic/tclAlloc.c 17 Dec 2007 15:28:27 -0000 1.27
+++ generic/tclAlloc.c 24 Aug 2009 20:59:15 -0000
@@ -27,660 +27,7 @@
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
#if USE_TCLALLOC
-
-#ifdef TCL_DEBUG
-# define DEBUG
-/* #define MSTATS */
-# define RCHECK
-#endif
-
-/*
- * 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(__MINGW32__) || 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 */
-#ifdef RCHECK
- 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 */
-
-#ifdef RCHECK
-#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];
-#include <stdio.h>
-#endif
-
-#if defined(DEBUG) || defined(RCHECK)
-#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;
-
- 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 + OVERHEAD >= MAXMALLOC) {
- 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
-
-#ifdef RCHECK
- /*
- * 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
-
-#ifdef RCHECK
- /*
- * 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
-
-#ifdef RCHECK
- /*
- * 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
- */
-
-#ifdef RCHECK
- 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
-
+#error Tcl 8.6 drops support for USE_TCLALLOC=1 builds
#else /* !USE_TCLALLOC */
/*
Index: generic/tclCkalloc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCkalloc.c,v
retrieving revision 1.36
diff -u -r1.36 tclCkalloc.c
--- generic/tclCkalloc.c 18 Jun 2009 09:41:26 -0000 1.36
+++ generic/tclCkalloc.c 24 Aug 2009 20:59:15 -0000
@@ -1288,10 +1288,6 @@
Tcl_MutexUnlock(ckallocMutexPtr);
#endif
-
-#if USE_TCLALLOC
- TclFinalizeAllocSubsystem();
-#endif
}
/*
Index: generic/tclEvent.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEvent.c,v
retrieving revision 1.91
diff -u -r1.91 tclEvent.c
--- generic/tclEvent.c 22 Jul 2009 08:41:59 -0000 1.91
+++ generic/tclEvent.c 24 Aug 2009 20:59:15 -0000
@@ -1026,9 +1026,6 @@
TclInitThreadStorage(); /* Creates master hash table for
* thread local storage */
-#if USE_TCLALLOC
- TclInitAlloc(); /* Process wide mutex init */
-#endif
#ifdef TCL_MEM_DEBUG
TclInitDbCkalloc(); /* Process wide mutex init */
#endif
Index: unix/Makefile.in
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/Makefile.in,v
retrieving revision 1.274
diff -u -r1.274 Makefile.in
--- unix/Makefile.in 23 Jul 2009 23:02:00 -0000 1.274
+++ unix/Makefile.in 24 Aug 2009 20:59:16 -0000
@@ -996,11 +996,8 @@
tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
-# On Unix we want to use the normal malloc/free implementation, so we
-# specifically set the USE_TCLALLOC flag.
-
tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
- $(CC) -c $(CC_SWITCHES) -DUSE_TCLALLOC=0 $(GENERIC_DIR)/tclAlloc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c
tclAsync.o: $(GENERIC_DIR)/tclAsync.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c
Index: win/makefile.bc
===================================================================
RCS file: /cvsroot/tcl/tcl/win/makefile.bc,v
retrieving revision 1.38
diff -u -r1.38 makefile.bc
--- win/makefile.bc 10 Apr 2009 14:19:45 -0000 1.38
+++ win/makefile.bc 24 Aug 2009 20:59:16 -0000
@@ -110,12 +110,8 @@
# -DTCL_MEM_DEBUG Enables the debugging memory allocator.
# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
-# -DUSE_TCLALLOC=0 Disables the Tcl memory allocator in favor
-# of the native malloc implementation. This is
-# needed when using Purify.
#
#DEBUGDEFINES = -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
-#DEBUGDEFINES = -DUSE_TCLALLOC=0
######################################################################
# Do not modify below this line
