diff options
46 files changed, 1897 insertions, 1987 deletions
diff --git a/README.mig-alloc-reform b/README.mig-alloc-reform new file mode 100644 index 0000000..302812a --- /dev/null +++ b/README.mig-alloc-reform @@ -0,0 +1,71 @@ +What is mig-alloc-reform? + 1. A massive simplification of the memory management in Tcl core. + a. removal of the Tcl stack, each BC allocates its own stacklet + b. TclStackAlloc is gone, replaced with ckalloc; goodbye to sometimes + hard sync problems + c. removal of the allocCache slot in struct Interp + d. retirement of the (unused) Tcl allocator USE_TCLALLOC; replacement + with a single-thread special case of zippy + e. unify all allocator options in a single file tclAlloc.c + d. exploit fast TSD via __thread where available (autoconferry still + missing, enable by hand with -DHAVE_FAST_TSD) + f. small improvements in zippy's memory usage: + . try to split blocks in the shared cache before allocating new + ones from the system + . use the same bucket for Tcl_Objs and smallest allocs + + 2. New allocator options + a. purify build (but stop using them, see below). This is suitable to + use with a preloaded malloc replacement + b. (~NEW) native build: call to sys malloc, but maintain zippy's + Tcl_Obj caches (per thread, if threads enabled). Can be switched to + run as a purify build via an env var at startup. This is suitable to + use with a preloaded malloc replacement. The threaded variant is new. + c. zippy build + d. (NEW) multi build: this is a build that can function as any of the + other three. Per default it runs as zippy, but can be switched to + native or purify via an env var at startup. May or may not be used + for deployment, but it will definitely be very useful for + development: no need to recompile in order to valgrind, just set an + env var! + + How do you use it? Options are: + 1. Don't pay any attention to it, build as always. You will get the same + allocator as before + 2. Select the build you want with compiler flags + -DTCL_ALLOCATOR=(aNATIVE|aPURIFY|aZIPPY|aMULTI) + 3. Select behaviour at startup: native can be switched to purify, multi + can be switched to any of the others. Define the env var + TCL_ALLOCATOR when starting up and you're good to go + + +** PERFORMANCE NOTES ** + * do enable HAVE_FAST_TSD on threaded build where available! Without + that it is probably slower than before. Note that __thread is not + available on macosx, but the "slow" version should be quite fast there + (or so they say) + * not measured, but: purify, native and zippy builds should be just as + fast as before. The obj-alloc macros have been removed while + developing. It is not certain that they provide a speedup, this will + be measured and acted accordingly + * multi build should be a only a tad slower, may even be suitable as + default build on all platforms + * zippy stats not enabled by default, -DZIPPY_STATS switches them on + +** TO DO LIST ** + * DEFINITELY + - test like crazy + - timings: versus older version (in unthreaded, fast-tsd and slow-tsd + builds). Determine if the obj-alloc macros should be reenabled + - autoconferry to auto-detect HAVE_FAST_TSD + - autoconferry to choose allocator flags? Keep USE_THREAD_ALLOC and + USE_TCLALLOC for back compat with external build scripts only (and + set them too!), but set also the new variants + TCL_ALLOCATOR=(aNATIVE|aPURIFY|aZIPPY|aMULTI) + - Makefile.in and autoconferry changes in windows, mac + - choose allocators from the command line instead of env vars? + - verify interaction with memdebug (should be 'none', but ...) + + * MAYBE + - build zippy as malloc-replacement, compile always aNATIVE and + preload alternatives diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index ae61e85..31bbb8b 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -1,155 +1,146 @@ /* * 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. + * This is the generic part of the Tcl allocator. It handles the + * freeObjLists and defines which main allocator will be used. * - * 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. + * Copyright (c) 2013 by Miguel Sofer. All rights reserved. * * 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(__MINGW32__) || defined(__BORLANDC__) -typedef unsigned long caddr_t; -#endif +#include "tclAlloc.h" /* - * 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. + * Parameters for the per-thread Tcl_Obj cache: + * - if >NOBJHIGH free objects, move some to the shared cache + * - if no objects are available, create NOBJALLOC of them */ -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 NOBJHIGH 1200 +#define NOBJALLOC ((NOBJHIGH*2)/3) -#define OVERHEAD (sizeof(union overhead) + RSLOP) /* - * Macro to make it easier to refer to the end-of-block guard magic. + * The Tcl_Obj per-thread cache. */ -#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]; +typedef struct Cache { + Tcl_Obj *firstObjPtr; /* List of free objects for thread */ + int numObjects; /* Number of objects for thread */ + void *allocCachePtr; +} Cache; + +static Cache sharedCache; +#define sharedPtr (&sharedCache) + +#if defined(TCL_THREADS) +static Tcl_Mutex *objLockPtr; + +static Cache * GetCache(void); +static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove); + +#if defined(HAVE_FAST_TSD) +static __thread Cache *tcachePtr; + +# define GETCACHE(cachePtr) \ + do { \ + if (!tcachePtr) { \ + tcachePtr = GetCache(); \ + } \ + (cachePtr) = tcachePtr; \ + } while (0) + +#else /* THREADS, not HAVE_FAST_TSD */ +# define GETCACHE(cachePtr) \ + do { \ + (cachePtr) = TclpGetAllocCache(); \ + if ((cachePtr) == NULL) { \ + (cachePtr) = GetCache(); \ + } \ + } while (0) +#endif /* FAST TSD */ + +#else /* NOT THREADS */ +#define GETCACHE(cachePtr) \ + (cachePtr) = (&sharedCache) +#endif /* THREADS */ + /* - * 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. + *---------------------------------------------------------------------- + * + * GetCache --- + * + * Gets per-thread memory cache, allocating it if necessary. + * + * Results: + * Pointer to cache. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- */ -struct block { - struct block *nextPtr; /* Linked list. */ - struct block *prevPtr; /* Linked list for big blocks, ensures 8-byte - * alignment for suballocated blocks. */ -}; +#if defined(TCL_THREADS) +static Cache * +GetCache(void) +{ + Cache *cachePtr; -static struct block *blockList; /* Tracks the suballocated blocks. */ -static struct block bigBlocks={ /* Big blocks aren't suballocated. */ - &bigBlocks, &bigBlocks -}; + /* + * Get this thread's cache, allocating if necessary. + */ + cachePtr = TclpGetAllocCache(); + if (cachePtr == NULL) { + cachePtr = calloc(1, sizeof(Cache)); + if (cachePtr == NULL) { + Tcl_Panic("alloc: could not allocate new cache"); + } + cachePtr->allocCachePtr= NULL; + TclpSetAllocCache(cachePtr); + } + return cachePtr; +} +#endif + /* - * 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. + * TclSetSharedAllocCache, TclSetAllocCache, TclGetAllocCache + * + * These are utility functions for the loadable allocator. */ -#ifdef TCL_THREADS -static Tcl_Mutex *allocMutexPtr; -#endif -static int allocInit = 0; - -#ifdef MSTATS +void +TclSetSharedAllocCache( + void *allocCachePtr) +{ + sharedPtr->allocCachePtr = allocCachePtr; +} -/* - * numMallocs[i] is the difference between the number of mallocs and frees for - * a given block size. - */ +void +TclSetAllocCache( + void *allocCachePtr) +{ + Cache *cachePtr; -static unsigned int numMallocs[NBUCKETS+1]; -#endif + GETCACHE(cachePtr); + cachePtr->allocCachePtr = allocCachePtr; +} -#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 +void * +TclGetAllocCache(void) +{ + Cache *cachePtr; -/* - * Prototypes for functions used only in this file. - */ + GETCACHE(cachePtr); + return cachePtr->allocCachePtr; +} -static void MoreCore(int bucket); - + /* *------------------------------------------------------------------------- * @@ -161,7 +152,8 @@ static void MoreCore(int bucket); * None. * * Side effects: - * Initialize the mutex used to serialize allocations. + * Initialize the mutex used to serialize obj allocations. + * Call the allocator-specific initialization. * *------------------------------------------------------------------------- */ @@ -169,76 +161,67 @@ static void MoreCore(int bucket); void TclInitAlloc(void) { - if (!allocInit) { - allocInit = 1; -#ifdef TCL_THREADS - allocMutexPtr = Tcl_GetAllocMutex(); + /* + * Set the params for the correct allocator + */ + +#if defined(TCL_THREADS) + Tcl_Mutex *initLockPtr; + + TCL_THREADED = 1; + initLockPtr = Tcl_GetAllocMutex(); + Tcl_MutexLock(initLockPtr); + objLockPtr = TclpNewAllocMutex(); + TclXpInitAlloc(); + Tcl_MutexUnlock(initLockPtr); +#else + TCL_THREADED = 0; + TclXpInitAlloc(); +#endif /* THREADS */ + +#ifdef PURIFY + TCL_PURIFY = 1; +#else + TCL_PURIFY = (getenv("TCL_PURIFY") != NULL); #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(). + * TclFinalizeAlloc -- * - * After this function is called, all memory allocated with TclpAlloc() - * should be considered unusable. + * This procedure is used to destroy all private resources used in this + * file. * * 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. + * Call the allocator-specific finalization. * - *------------------------------------------------------------------------- + *---------------------------------------------------------------------- */ void -TclFinalizeAllocSubsystem(void) +TclFinalizeAlloc(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; +#if defined(TCL_THREADS) - for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) { - nextPtr = blockPtr->nextPtr; - TclpSysFree(blockPtr); - blockPtr = nextPtr; - } - bigBlocks.nextPtr = &bigBlocks; - bigBlocks.prevPtr = &bigBlocks; + TclpFreeAllocMutex(objLockPtr); + objLockPtr = NULL; - for (i=0 ; i<NBUCKETS ; i++) { - nextf[i] = NULL; -#ifdef MSTATS - numMallocs[i] = 0; -#endif - } -#ifdef MSTATS - numMallocs[i] = 0; + TclpFreeAllocCache(NULL); #endif - Tcl_MutexUnlock(allocMutexPtr); + TclXpFinalizeAlloc(); } /* *---------------------------------------------------------------------- * - * TclpAlloc -- + * TclFreeAllocCache -- * - * Allocate more memory. + * Flush and delete a cache, removing from list of caches. * * Results: * None. @@ -249,387 +232,174 @@ TclFinalizeAllocSubsystem(void) *---------------------------------------------------------------------- */ -char * -TclpAlloc( - unsigned int numBytes) /* Number of bytes to allocate. */ +#if defined(TCL_THREADS) +void +TclFreeAllocCache( + void *arg) { - 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); - + Cache *cachePtr = arg; + /* - * First the simple case: we simple allocate big blocks directly. + * Flush objs. */ - 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); + if (cachePtr->numObjects > 0) { + Tcl_MutexLock(objLockPtr); + MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects); + Tcl_MutexUnlock(objLockPtr); } /* - * Convert amount of memory requested into closest block size stored in - * hash buckets which satisfies request. Account for space used per block - * for accounting. + * Flush the external allocator cache */ - 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)); + TclXpFreeAllocCache(cachePtr->allocCachePtr); } +#endif /* *---------------------------------------------------------------------- * - * MoreCore -- - * - * Allocate more memory to the indicated bucket. + * TclSmallAlloc -- * - * Assumes Mutex is already held. + * Allocate a Tcl_Obj sized block from the per-thread cache. * * Results: - * None. + * Pointer to uninitialized memory. * * Side effects: - * Attempts to get more memory from the system. + * May move blocks from shared cached or allocate new blocks if + * list is empty. * *---------------------------------------------------------------------- */ -static void -MoreCore( - int bucket) /* What bucket to allocat to. */ +void * +TclSmallAlloc(void) { - 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; + register Cache *cachePtr; + register Tcl_Obj *objPtr; + int numMove; + Tcl_Obj *newObjsPtr; + + GETCACHE(cachePtr); /* - * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a - * VAX, I think) or for a negative arg. + * Pop the first object. */ - 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; + if(cachePtr->firstObjPtr) { + haveObj: + objPtr = cachePtr->firstObjPtr; + cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr; + cachePtr->numObjects--; + return objPtr; } - blockPtr->nextPtr = blockList; - blockList = blockPtr; - - overPtr = (union overhead *) (blockPtr + 1); /* - * Add new memory allocated to that on free list for this hash bucket. + * Do it AFTER looking at the queue, so that it doesn't slow down + * non-purify small allocs. */ - - nextf[bucket] = overPtr; - while (--numBlocks > 0) { - overPtr->next = (union overhead *)((caddr_t)overPtr + size); - overPtr = (union overhead *)((caddr_t)overPtr + size); + + if (TCL_PURIFY) { + Tcl_Obj *objPtr = (Tcl_Obj *) TclpAlloc(sizeof(Tcl_Obj)); + if (objPtr == NULL) { + Tcl_Panic("alloc: could not allocate a new object"); + } + return objPtr; } - 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; + + /* + * Get this thread's obj list structure and move or allocate new objs if + * necessary. + */ - if (oldPtr == NULL) { - return; +#if defined(TCL_THREADS) + Tcl_MutexLock(objLockPtr); + numMove = sharedPtr->numObjects; + if (numMove > 0) { + if (numMove > NOBJALLOC) { + numMove = NOBJALLOC; + } + MoveObjs(sharedPtr, cachePtr, numMove); } - - 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; + Tcl_MutexUnlock(objLockPtr); + if (cachePtr->firstObjPtr) { + goto haveObj; } - - 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; +#endif + cachePtr->numObjects = numMove = NOBJALLOC; + newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove); + if (newObjsPtr == NULL) { + Tcl_Panic("alloc: could not allocate %d new objects", numMove); } - ASSERT(size < NBUCKETS); - overPtr->next = nextf[size]; /* also clobbers overMagic */ - nextf[size] = overPtr; - -#ifdef MSTATS - numMallocs[size]--; -#endif - - Tcl_MutexUnlock(allocMutexPtr); + while (--numMove >= 0) { + objPtr = &newObjsPtr[numMove]; + objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; + cachePtr->firstObjPtr = objPtr; + } + goto haveObj; } + /* *---------------------------------------------------------------------- * - * TclpRealloc -- + * TclSmallFree -- * - * Reallocate memory. + * Return a free Tcl_Obj-sized block to the per-thread cache. * * Results: * None. * * Side effects: - * None. + * May move free blocks to shared list upon hitting high water mark. * *---------------------------------------------------------------------- */ -char * -TclpRealloc( - char *oldPtr, /* Pointer to alloced block. */ - unsigned int numBytes) /* New size of memory. */ +void +TclSmallFree( + void *ptr) { - 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; + Cache *cachePtr; + Tcl_Obj *objPtr = ptr; + + if (TCL_PURIFY) { + TclpFree((char *) ptr); + return; } - - RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC); - RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC); - i = overPtr->bucketIndex; + + GETCACHE(cachePtr); /* - * If the block isn't in a bin, just realloc it. + * Get this thread's list and push on the free Tcl_Obj. */ - 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; - } + objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; + cachePtr->firstObjPtr = objPtr; + cachePtr->numObjects++; +#if defined(TCL_THREADS) /* - * Ok, we don't have to copy, it fits as-is + * If the number of free objects has exceeded the high water mark, move + * some blocks to the shared list. */ -#ifndef NDEBUG - overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1); - BLOCK_END(overPtr) = RMAGIC; + if (cachePtr->numObjects > NOBJHIGH) { + Tcl_MutexLock(objLockPtr); + MoveObjs(cachePtr, sharedPtr, NOBJALLOC); + Tcl_MutexUnlock(objLockPtr); + } #endif - - Tcl_MutexUnlock(allocMutexPtr); - return(oldPtr); } /* *---------------------------------------------------------------------- * - * mstats -- + * MoveObjs -- * - * 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. + * Move Tcl_Obj's between caches. * * Results: * None. @@ -640,115 +410,38 @@ TclpRealloc( *---------------------------------------------------------------------- */ -#ifdef MSTATS -void -mstats( - char *s) /* Where to write info. */ +#if defined(TCL_THREADS) +static void +MoveObjs( + Cache *fromPtr, + Cache *toPtr, + int numMove) { - register int i, j; - register union overhead *overPtr; - int totalFree = 0, totalUsed = 0; + register Tcl_Obj *objPtr = fromPtr->firstObjPtr; + Tcl_Obj *fromFirstObjPtr = objPtr; - Tcl_MutexLock(allocMutexPtr); + toPtr->numObjects += numMove; + fromPtr->numObjects -= numMove; - 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)); - } + /* + * 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. + */ - fprintf(stderr, "\nused:\t"); - for (i = 0; i < NBUCKETS; i++) { - fprintf(stderr, " %d", numMallocs[i]); - totalUsed += numMallocs[i] * (1 << (i + 3)); + while (--numMove) { + objPtr = objPtr->internalRep.otherValuePtr; } + fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr; - 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]); + /* + * Move all objects as a block - they are already linked to each other, we + * just have to update the first and last. + */ - Tcl_MutexUnlock(allocMutexPtr); + objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr; + toPtr->firstObjPtr = fromFirstObjPtr; } #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: diff --git a/generic/tclAlloc.h b/generic/tclAlloc.h new file mode 100644 index 0000000..0cecac6 --- /dev/null +++ b/generic/tclAlloc.h @@ -0,0 +1,49 @@ +/* + * tclAlloc.h -- + * + * This defines the interface for pluggable memory allocators for Tcl. + * + * Copyright (c) 2013 by Miguel Sofer. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef _TCLALLOC +#define _TCLALLOC + +/* + * These functions must be exported by the allocator. + */ + +char * TclpAlloc(unsigned int reqSize); +char * TclpRealloc(char *ptr, unsigned int reqSize); +void TclpFree(char *ptr); +void * TclSmallAlloc(void); +void TclSmallFree(void *ptr); + +void TclInitAlloc(void); +void TclFinalizeAlloc(void); +void TclFreeAllocCache(void *ptr); + +/* + * The allocator should allow for "purify mode" by checking the environment + * variable TCL_PURIFY at initialization. If it is set to any value, it should + * just shunt to plain malloc. This is used for debugging; the value can be + * treated as a constant, it does not change in a running process. + */ + +/* + * This macro is used to properly align the memory allocated by Tcl, giving + * the same alignment as the native malloc. + */ + +#if defined(__APPLE__) +#define ALLOCALIGN 16 +#else +#define ALLOCALIGN (2*sizeof(void *)) +#endif + +#define ALIGN(x) (((x) + ALLOCALIGN - 1) & ~(ALLOCALIGN - 1)) + +#endif diff --git a/generic/tclAllocNative.c b/generic/tclAllocNative.c new file mode 100644 index 0000000..596ccd3 --- /dev/null +++ b/generic/tclAllocNative.c @@ -0,0 +1,36 @@ +/* + * tclAllocNative.c -- + * + * This is the basic native allocator for Tcl, using zippy's per-thread + * free obj lists. + * + * Copyright (c) 2013 by Miguel Sofer. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#define OBJQ_ONLY 1 +#include "tclAllocZippy.c" + +char * +TclpAlloc( + unsigned int reqSize) +{ + return malloc(reqSize); +} + +char * +TclpRealloc( + char *ptr, + unsigned int reqSize) +{ + return realloc(ptr, reqSize); +} + +void +TclpFree( + char *ptr) +{ + free(ptr); +} diff --git a/generic/tclAllocPurify.c b/generic/tclAllocPurify.c new file mode 100644 index 0000000..aa870ad --- /dev/null +++ b/generic/tclAllocPurify.c @@ -0,0 +1,66 @@ +/* + * tclAllocPurify.c -- + * + * This is the native allocator for Tcl, suitable for preloading anything else. + * + * Copyright (c) 2013 by Miguel Sofer. All rights reserved. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +/* This is needed just for sizeof(Tcl_Obj) and malloc*/ + +#include "tclInt.h" + +char * +TclpAlloc( + unsigned int reqSize) +{ + return malloc(reqSize); +} + +char * +TclpRealloc( + char *ptr, + unsigned int reqSize) +{ + return realloc(ptr, reqSize); +} + +void +TclpFree( + char *ptr) +{ + free(ptr); +} + +void * +TclSmallAlloc(void) +{ + return malloc(sizeof(Tcl_Obj)); +} + +void +TclSmallFree( + void *ptr) +{ + free(ptr); +} + +void +TclInitAlloc(void) +{ +} + +void +TclFinalizeAlloc(void) +{ +} + +void +TclFreeAllocCache( + void *ptr) +{ +} + diff --git a/generic/tclThreadAlloc.c b/generic/tclAllocZippy.c index abd5af5..9126046 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclAllocZippy.c @@ -1,5 +1,5 @@ /* - * tclThreadAlloc.c -- + * tclAllocZippy.c -- * * This is a very fast storage allocator for used with threads (designed * avoid lock contention). The basic strategy is to allocate memory in @@ -13,8 +13,24 @@ */ #include "tclInt.h" -#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) +#define NATIVE_T (defined(OBJQ_ONLY) && defined(TCL_THREADS)) +#define NATIVE_U (defined(OBJQ_ONLY) && !defined(TCL_THREADS)) +#define NATIVE (NATIVE_T || NATIVE_U) +#define ZIPPY_T (!defined(OBJQ_ONLY) && defined(TCL_THREADS)) +#define ZIPPY_U (!defined(OBJQ_ONLY) && !defined(TCL_THREADS)) +#define ZIPPY (ZIPPY_T || ZIPPY_U) + +/* + * 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 NOBJHIGH 1200 +#define NOBJALLOC ((2*NOBJHIGH)/3) + +#if ZIPPY /* * If range checking is enabled, an additional byte will be allocated to store * the magic number at the end of the requested memory. @@ -29,15 +45,18 @@ #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. + * This macro is used to properly align the memory allocated by Tcl, giving + * the same alignment as the native malloc. */ -#define NOBJALLOC 800 +#if defined(__APPLE__) +#define TCL_ALLOCALIGN 16 +#else +#define TCL_ALLOCALIGN (2*sizeof(void *)) +#endif + +#define ALIGN(x) (((x) + TCL_ALLOCALIGN - 1) & ~(TCL_ALLOCALIGN - 1)) -/* Actual definition moved to tclInt.h */ -#define NOBJHIGH ALLOC_NOBJHIGH /* * The following union stores accounting information for each block including @@ -87,14 +106,17 @@ typedef struct Bucket { long numFree; /* Number of blocks available */ /* All fields below for accounting only */ - +#if ZIPPY 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 */ +#endif } Bucket; +#endif /* ZIPPY */ + /* * 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 @@ -103,14 +125,17 @@ typedef struct Bucket { */ 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 */ +#if ZIPPY + struct Cache *nextPtr; /* Linked list of cache entries */ int totalAssigned; /* Total space assigned to thread */ Bucket buckets[NBUCKETS]; /* The buckets for this thread */ + Tcl_ThreadId owner; /* Which thread's cache is this? */ +#endif } Cache; +#if ZIPPY /* * The following array specifies various per-bucket limits and locks. The * values are statically initialized to avoid calculating them repeatedly. @@ -119,32 +144,54 @@ typedef struct Cache { static struct { size_t blockSize; /* Bucket blocksize. */ int maxBlocks; /* Max blocks before move to share. */ +#if ZIPPY_T int numMove; /* Num blocks to move to share. */ Tcl_Mutex *lockPtr; /* Share bucket lock. */ +#endif } bucketInfo[NBUCKETS]; +#endif /* ZIPPY */ + /* * Static functions defined in this file. */ +#if ZIPPY + +#if ZIPPY_T 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); +#else /* ZIPPY_U */ +#define GetBlocks(cachePtr, bucket) 0 +#endif /* ZIPPY_U */ + +static void InitBuckets(void); static Block * Ptr2Block(char *ptr); static char * Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize); +#endif /* ZIPPY */ + +#ifdef TCL_THREADS static void MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove); +#endif /* * 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; + +#ifdef TCL_THREADS + +static Tcl_Mutex *objLockPtr; + +#if ZIPPY_T +static Tcl_Mutex *listLockPtr; static Cache *firstCachePtr = &sharedCache; +#endif #if defined(HAVE_FAST_TSD) static __thread Cache *tcachePtr; @@ -156,7 +203,7 @@ static __thread Cache *tcachePtr; } \ (cachePtr) = tcachePtr; \ } while (0) -#else +#else /* FAST_TSD */ # define GETCACHE(cachePtr) \ do { \ (cachePtr) = TclpGetAllocCache(); \ @@ -164,6 +211,12 @@ static __thread Cache *tcachePtr; (cachePtr) = GetCache(); \ } \ } while (0) +#endif /* FAST_TSD */ + +#else /* TCL_THREADS */ + +#define GETCACHE(cachePtr) \ + (cachePtr) = sharedPtr #endif /* @@ -182,35 +235,30 @@ static __thread Cache *tcachePtr; *---------------------------------------------------------------------- */ +#if ZIPPY +static void +InitBuckets(void) +{ + int i; + + for (i = 0; i < NBUCKETS; ++i) { + bucketInfo[i].blockSize = MINALLOC << i; + bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i); +#if ZIPPY_T + bucketInfo[i].numMove = i < NBUCKETS - 1 ? + 1 << (NBUCKETS - 2 - i) : 1; + bucketInfo[i].lockPtr = TclpNewAllocMutex(); +#endif + } +} +#endif + +#ifdef TCL_THREADS 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. */ @@ -221,15 +269,18 @@ GetCache(void) if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } +#if ZIPPY_T Tcl_MutexLock(listLockPtr); cachePtr->nextPtr = firstCachePtr; firstCachePtr = cachePtr; Tcl_MutexUnlock(listLockPtr); cachePtr->owner = Tcl_GetCurrentThread(); - TclpSetAllocCache(cachePtr); +#endif + TclpSetAllocCache(cachePtr); } return cachePtr; } +#endif /* *---------------------------------------------------------------------- @@ -246,12 +297,13 @@ GetCache(void) * *---------------------------------------------------------------------- */ - +#ifdef TCL_THREADS void TclFreeAllocCache( void *arg) { Cache *cachePtr = arg; +#if ZIPPY_T Cache **nextPtrPtr; register unsigned int bucket; @@ -266,16 +318,6 @@ TclFreeAllocCache( } /* - * Flush objs. - */ - - if (cachePtr->numObjects > 0) { - Tcl_MutexLock(objLockPtr); - MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects); - Tcl_MutexUnlock(objLockPtr); - } - - /* * Remove from pool list. */ @@ -287,8 +329,21 @@ TclFreeAllocCache( *nextPtrPtr = cachePtr->nextPtr; cachePtr->nextPtr = NULL; Tcl_MutexUnlock(listLockPtr); +#endif + + /* + * Flush objs. + */ + + if (cachePtr->numObjects > 0) { + Tcl_MutexLock(objLockPtr); + MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects); + Tcl_MutexUnlock(objLockPtr); + } + free(cachePtr); } +#endif /* TCL_THREADS */ /* *---------------------------------------------------------------------- @@ -305,6 +360,7 @@ TclFreeAllocCache( * *---------------------------------------------------------------------- */ +#if ZIPPY char * TclpAlloc( @@ -314,7 +370,7 @@ TclpAlloc( 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 */ @@ -356,9 +412,11 @@ TclpAlloc( if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) { blockPtr = cachePtr->buckets[bucket].firstPtr; cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock; +#if ZIPPY_T cachePtr->buckets[bucket].numFree--; cachePtr->buckets[bucket].numRemoves++; cachePtr->buckets[bucket].totalAssigned += reqSize; +#endif } } if (blockPtr == NULL) { @@ -417,10 +475,12 @@ TclpFree( cachePtr->buckets[bucket].numFree++; cachePtr->buckets[bucket].numInserts++; +#if ZIPPY_T if (cachePtr != sharedPtr && cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) { PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove); } +#endif } /* @@ -516,11 +576,12 @@ TclpRealloc( } return newPtr; } +#endif /* OBJQ_ONLY */ /* *---------------------------------------------------------------------- * - * TclThreadAllocObj -- + * TclSmallAlloc -- * * Allocate a Tcl_Obj from the per-thread cache. * @@ -538,11 +599,13 @@ TclpRealloc( *---------------------------------------------------------------------- */ -Tcl_Obj * -TclThreadAllocObj(void) +void * +TclSmallAlloc(void) { register Cache *cachePtr; register Tcl_Obj *objPtr; + register int numMove; + GETCACHE(cachePtr); @@ -551,9 +614,8 @@ TclThreadAllocObj(void) * necessary. */ +#if ZIPPY_T if (cachePtr->numObjects == 0) { - register int numMove; - Tcl_MutexLock(objLockPtr); numMove = sharedPtr->numObjects; if (numMove > 0) { @@ -563,19 +625,21 @@ TclThreadAllocObj(void) MoveObjs(sharedPtr, cachePtr, numMove); } Tcl_MutexUnlock(objLockPtr); - if (cachePtr->numObjects == 0) { - Tcl_Obj *newObjsPtr; + } +#endif - cachePtr->numObjects = numMove = NOBJALLOC; - newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove); - if (newObjsPtr == NULL) { - Tcl_Panic("alloc: could not allocate %d new objects", numMove); - } - while (--numMove >= 0) { - objPtr = &newObjsPtr[numMove]; - objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; - cachePtr->firstObjPtr = objPtr; - } + if (cachePtr->numObjects == 0) { + Tcl_Obj *newObjsPtr; + + cachePtr->numObjects = numMove = NOBJALLOC; + newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove); + if (newObjsPtr == NULL) { + Tcl_Panic("alloc: could not allocate %d new objects", numMove); + } + while (--numMove >= 0) { + objPtr = &newObjsPtr[numMove]; + objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; + cachePtr->firstObjPtr = objPtr; } } @@ -584,7 +648,7 @@ TclThreadAllocObj(void) */ objPtr = cachePtr->firstObjPtr; - cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; + cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr; cachePtr->numObjects--; return objPtr; } @@ -592,7 +656,7 @@ TclThreadAllocObj(void) /* *---------------------------------------------------------------------- * - * TclThreadFreeObj -- + * TclSmallFree -- * * Return a free Tcl_Obj to the per-thread cache. * @@ -610,18 +674,19 @@ TclThreadAllocObj(void) */ void -TclThreadFreeObj( - Tcl_Obj *objPtr) +TclSmallFree( + void *ptr) { Cache *cachePtr; - + Tcl_Obj *objPtr = ptr; + GETCACHE(cachePtr); /* * Get this thread's list and push on the free Tcl_Obj. */ - objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; + objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr; cachePtr->firstObjPtr = objPtr; cachePtr->numObjects++; @@ -629,12 +694,13 @@ TclThreadFreeObj( * If the number of free objects has exceeded the high water mark, move * some blocks to the shared list. */ - +#if ZIPPY_T if (cachePtr->numObjects > NOBJHIGH) { Tcl_MutexLock(objLockPtr); MoveObjs(cachePtr, sharedPtr, NOBJALLOC); Tcl_MutexUnlock(objLockPtr); } +#endif } /* @@ -653,6 +719,7 @@ TclThreadFreeObj( *---------------------------------------------------------------------- */ +#if ZIPPY_T void Tcl_GetMemoryInfo( Tcl_DString *dsPtr) @@ -687,6 +754,7 @@ Tcl_GetMemoryInfo( } Tcl_MutexUnlock(listLockPtr); } +#endif /* *---------------------------------------------------------------------- @@ -704,6 +772,8 @@ Tcl_GetMemoryInfo( *---------------------------------------------------------------------- */ +#ifdef TCL_THREADS + static void MoveObjs( Cache *fromPtr, @@ -722,18 +792,19 @@ MoveObjs( */ while (--numMove) { - objPtr = objPtr->internalRep.twoPtrValue.ptr1; + objPtr = objPtr->internalRep.otherValuePtr; } - fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1; + 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.twoPtrValue.ptr1 = toPtr->firstObjPtr; + objPtr->internalRep.otherValuePtr = toPtr->firstObjPtr; toPtr->firstObjPtr = fromFirstObjPtr; } +#endif /* *---------------------------------------------------------------------- @@ -751,6 +822,8 @@ MoveObjs( *---------------------------------------------------------------------- */ +#if ZIPPY + static char * Block2Ptr( Block *blockPtr, @@ -789,6 +862,7 @@ Ptr2Block( #endif return blockPtr; } +#endif /* ZIPPY */ /* *---------------------------------------------------------------------- @@ -807,6 +881,8 @@ Ptr2Block( *---------------------------------------------------------------------- */ +#if ZIPPY_T + static void LockBucket( Cache *cachePtr, @@ -824,6 +900,7 @@ UnlockBucket( { Tcl_MutexUnlock(bucketInfo[bucket].lockPtr); } +#endif /* ZIPPY_T */ /* *---------------------------------------------------------------------- @@ -841,6 +918,8 @@ UnlockBucket( *---------------------------------------------------------------------- */ +#if ZIPPY_T + static void PutBlocks( Cache *cachePtr, @@ -873,6 +952,7 @@ PutBlocks( sharedPtr->buckets[bucket].numFree += numMove; UnlockBucket(cachePtr, bucket); } +#endif /* *---------------------------------------------------------------------- @@ -890,6 +970,7 @@ PutBlocks( *---------------------------------------------------------------------- */ +#if ZIPPY_T static int GetBlocks( Cache *cachePtr, @@ -936,7 +1017,7 @@ GetBlocks( } UnlockBucket(cachePtr, bucket); } - + if (cachePtr->buckets[bucket].numFree == 0) { register size_t size; @@ -966,6 +1047,7 @@ GetBlocks( size = MAXALLOC; blockPtr = malloc(size); if (blockPtr == NULL) { + Tcl_Panic("FOO\n"); return 0; } } @@ -986,11 +1068,12 @@ GetBlocks( } return 1; } +#endif /* ZIPPY_T */ /* *---------------------------------------------------------------------- * - * TclFinalizeThreadAlloc -- + * TclFinalizeAlloc -- * * This procedure is used to destroy all private resources used in this * file. @@ -1005,8 +1088,26 @@ GetBlocks( */ void -TclFinalizeThreadAlloc(void) +TclInitAlloc(void) +{ +#ifdef TCL_THREADS +#if ZIPPY_T + listLockPtr = TclpNewAllocMutex(); + InitBuckets(); +#endif + objLockPtr = TclpNewAllocMutex(); +#endif + +#if ZIPPY_U + InitBuckets(); +#endif +} + +void +TclFinalizeAlloc(void) { +#ifdef TCL_THREADS +#if ZIPPY_T unsigned int i; for (i = 0; i < NBUCKETS; ++i) { @@ -1014,63 +1115,17 @@ TclFinalizeThreadAlloc(void) bucketInfo[i].lockPtr = NULL; } - TclpFreeAllocMutex(objLockPtr); - objLockPtr = NULL; - TclpFreeAllocMutex(listLockPtr); listLockPtr = NULL; +#endif + + TclpFreeAllocMutex(objLockPtr); + objLockPtr = NULL; TclpFreeAllocCache(NULL); +#endif } -#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 diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 0f05d06..6e62d4d 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1164,11 +1164,9 @@ NewAssemblyEnv( * generation*/ int flags) /* Compilation flags (TCL_EVAL_DIRECT) */ { - Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; - /* Tcl interpreter */ - AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv)); + AssemblyEnv* assemEnvPtr = ckalloc(sizeof(AssemblyEnv)); /* Assembler environment under construction */ - Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse* parsePtr = ckalloc(sizeof(Tcl_Parse)); /* Parse of one line of assembly code */ assemEnvPtr->envPtr = envPtr; @@ -1213,11 +1211,6 @@ static void FreeAssemblyEnv( AssemblyEnv* assemEnvPtr) /* Environment to free */ { - CompileEnv* envPtr = assemEnvPtr->envPtr; - /* Compilation environment being used for code - * generation */ - Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; - /* Tcl interpreter */ BasicBlock* thisBB; /* Pointer to a basic block being deleted */ BasicBlock* nextBB; /* Pointer to a deleted basic block's * successor */ @@ -1246,8 +1239,8 @@ FreeAssemblyEnv( */ Tcl_DeleteHashTable(&assemEnvPtr->labelHash); - TclStackFree(interp, assemEnvPtr->parsePtr); - TclStackFree(interp, assemEnvPtr); + ckfree(assemEnvPtr->parsePtr); + ckfree(assemEnvPtr); } /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4d5b715..b32f5b1 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -725,12 +725,6 @@ Tcl_CreateInterp(void) * cache was already initialised by the call to alloc the interp struct. */ -#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) - iPtr->allocCache = TclpGetAllocCache(); -#else - iPtr->allocCache = NULL; -#endif - iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); iPtr->deferredCallbacks = NULL; @@ -2358,8 +2352,7 @@ TclInvokeStringCommand( { Command *cmdPtr = clientData; int i, result; - const char **argv = - TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *)); + const char **argv = ckalloc((unsigned)(objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); @@ -2372,7 +2365,7 @@ TclInvokeStringCommand( result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv); - TclStackFree(interp, (void *) argv); + ckfree((void *) argv); return result; } @@ -2407,8 +2400,7 @@ TclInvokeObjectCommand( Command *cmdPtr = clientData; Tcl_Obj *objPtr; int i, length, result; - Tcl_Obj **objv = - TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *))); + Tcl_Obj **objv = ckalloc((unsigned)(argc * sizeof(Tcl_Obj *))); for (i = 0; i < argc; i++) { length = strlen(argv[i]); @@ -2444,7 +2436,7 @@ TclInvokeObjectCommand( objPtr = objv[i]; Tcl_DecrRefCount(objPtr); } - TclStackFree(interp, objv); + ckfree(objv); return result; } @@ -4575,7 +4567,7 @@ TEOV_NotFound( Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; - newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc); + newObjv = ckalloc((int) sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's @@ -4614,7 +4606,7 @@ TEOV_NotFound( for (i = 0; i < handlerObjc; ++i) { Tcl_DecrRefCount(newObjv[i]); } - TclStackFree(interp, newObjv); + ckfree(newObjv); return TCL_ERROR; } @@ -4652,7 +4644,7 @@ TEOV_NotFoundCallback( for (i = 0; i < objc; ++i) { Tcl_DecrRefCount(objv[i]); } - TclStackFree(interp, objv); + ckfree(objv); return result; } @@ -4949,12 +4941,11 @@ TclEvalEx( * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); - CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); - Tcl_Obj **stackObjArray = - TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); - int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int)); - int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int)); + Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); + CmdFrame *eeFramePtr = ckalloc(sizeof(CmdFrame)); + Tcl_Obj **stackObjArray = ckalloc(minObjs * sizeof(Tcl_Obj *)); + int *expandStack = ckalloc(minObjs * sizeof(int)); + int *linesStack = ckalloc(minObjs * sizeof(int)); /* TIP #280 Structures for tracking of command * locations. */ int *clNext = NULL; /* Pointer for the tracking of invisible @@ -5350,11 +5341,11 @@ TclEvalEx( if (eeFramePtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eeFramePtr->data.eval.path); } - TclStackFree(interp, linesStack); - TclStackFree(interp, expandStack); - TclStackFree(interp, stackObjArray); - TclStackFree(interp, eeFramePtr); - TclStackFree(interp, parsePtr); + ckfree(linesStack); + ckfree(expandStack); + ckfree(stackObjArray); + ckfree(eeFramePtr); + ckfree(parsePtr); return code; } @@ -5990,7 +5981,7 @@ TclNREvalObjEx( * should be pushed, as needed by alias and ensemble redirections. */ - eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame)); + eoFramePtr = ckalloc(sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; @@ -6112,7 +6103,7 @@ TclNREvalObjEx( */ int pc = 0; - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame)); *ctxPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { @@ -6153,7 +6144,7 @@ TclNREvalObjEx( Tcl_DecrRefCount(ctxPtr->data.eval.path); } - TclStackFree(interp, ctxPtr); + ckfree(ctxPtr); } /* @@ -6232,7 +6223,7 @@ TEOEx_ListCallback( if (eoFramePtr) { iPtr->cmdFramePtr = eoFramePtr->nextPtr; - TclStackFree(interp, eoFramePtr); + ckfree(eoFramePtr); } TclDecrRefCount(listPtr); diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 70e64f0..ce57cd5 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -1311,10 +1311,6 @@ TclFinalizeMemorySubsystem(void) Tcl_MutexUnlock(ckallocMutexPtr); #endif - -#if USE_TCLALLOC - TclFinalizeAllocSubsystem(); -#endif } /* diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index eb2a303..1035ea3 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2416,7 +2416,7 @@ TclNRForObjCmd( return TCL_ERROR; } - TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); + TclCkSmallAlloc(sizeof(ForIterData), iterPtr); iterPtr->cond = objv[2]; iterPtr->body = objv[4]; iterPtr->next = objv[3]; @@ -2444,7 +2444,7 @@ ForSetupCallback( if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); } - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); return result; } TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL); @@ -2482,7 +2482,7 @@ TclNRForIterCallback( Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp))); } - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); return result; } @@ -2499,11 +2499,11 @@ ForCondCallback( if (result != TCL_OK) { Tcl_DecrRefCount(boolObj); - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); return result; } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) { Tcl_DecrRefCount(boolObj); - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); return TCL_ERROR; } Tcl_DecrRefCount(boolObj); @@ -2520,7 +2520,7 @@ ForCondCallback( return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr, iterPtr->word); } - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); return result; } @@ -2560,7 +2560,7 @@ ForPostNextCallback( if ((result != TCL_BREAK) && (result != TCL_OK)) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" loop-end command)"); - TclSmallFreeEx(interp, iterPtr); + TclSmallFree(iterPtr); } return result; } @@ -2660,7 +2660,7 @@ EachloopCmd( * allocation for better performance. */ - statePtr = TclStackAlloc(interp, + statePtr = ckalloc( sizeof(struct ForeachState) + 3 * numLists * sizeof(int) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, @@ -2883,7 +2883,7 @@ ForeachCleanup( if (statePtr->resultList != NULL) { TclDecrRefCount(statePtr->resultList); } - TclStackFree(interp, statePtr); + ckfree(statePtr); } /* diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c70ba23..8f092b0 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1339,7 +1339,7 @@ TclInfoFrame( * Execution of bytecode. Talk to the BC engine to fill out the frame. */ - CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *fPtr = ckalloc(sizeof(CmdFrame)); *fPtr = *framePtr; @@ -1373,7 +1373,7 @@ TclInfoFrame( ADD_PAIR("cmd", Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len)); - TclStackFree(interp, fPtr); + ckfree(fPtr); break; } @@ -3059,7 +3059,7 @@ Tcl_LsearchObjCmd( int j; if (sortInfo.indexc > 1) { - TclStackFree(interp, sortInfo.indexv); + ckfree(sortInfo.indexv); } if (i > objc-4) { if (startPtr != NULL) { @@ -3095,7 +3095,7 @@ Tcl_LsearchObjCmd( break; default: sortInfo.indexv = - TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); + ckalloc(sizeof(int) * sortInfo.indexc); } /* @@ -3206,7 +3206,7 @@ Tcl_LsearchObjCmd( if (offset > listc-1) { if (sortInfo.indexc > 1) { - TclStackFree(interp, sortInfo.indexv); + ckfree(sortInfo.indexv); } if (allMatches || inlineReturn) { Tcl_ResetResult(interp); @@ -3531,7 +3531,7 @@ Tcl_LsearchObjCmd( done: if (sortInfo.indexc > 1) { - TclStackFree(interp, sortInfo.indexv); + ckfree(sortInfo.indexv); } return result; } @@ -3825,7 +3825,7 @@ Tcl_LsortObjCmd( break; default: sortInfo.indexv = - TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); + ckalloc(sizeof(int) * sortInfo.indexc); allocatedIndexVector = 1; /* Cannot use indexc field, as it * might be decreased by 1 later. */ } @@ -3924,6 +3924,7 @@ Tcl_LsortObjCmd( /* * Do not shrink the actual memory block used; that doesn't * work with TclStackAlloc-allocated memory. [Bug 2918962] + * FIXME: TclStackAlloc is now retired, we could shrink it. */ for (i = 0; i < sortInfo.indexc; i++) { @@ -3961,7 +3962,7 @@ Tcl_LsortObjCmd( * begins sorting it into the sublists as it appears. */ - elementArray = TclStackAlloc(interp, length * sizeof(SortElement)); + elementArray = ckalloc(length * sizeof(SortElement)); for (i=0; i < length; i++){ idx = groupSize * i + groupOffset; @@ -4085,7 +4086,7 @@ Tcl_LsortObjCmd( } done1: - TclStackFree(interp, elementArray); + ckfree(elementArray); done: if (sortInfo.sortMode == SORTMODE_COMMAND) { @@ -4095,7 +4096,7 @@ Tcl_LsortObjCmd( } done2: if (allocatedIndexVector) { - TclStackFree(interp, sortInfo.indexv); + ckfree(sortInfo.indexv); } return sortInfo.resultCode; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index f9f2a28..ae4113c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1903,7 +1903,7 @@ StringMapCmd( * adapt this code... */ - mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc); + mapElemv = ckalloc(sizeof(Tcl_Obj *) * mapElemc); Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); for (i=2 ; i<mapElemc ; i+=2) { @@ -2014,10 +2014,10 @@ StringMapCmd( * case. */ - mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *)); - mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int)); + mapStrings = ckalloc(mapElemc*2*sizeof(Tcl_UniChar *)); + mapLens = ckalloc(mapElemc * 2 * sizeof(int)); if (nocase) { - u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar)); + u2lc = ckalloc(mapElemc * sizeof(Tcl_UniChar)); } for (index = 0; index < mapElemc; index++) { mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], @@ -2067,10 +2067,10 @@ StringMapCmd( } } if (nocase) { - TclStackFree(interp, u2lc); + ckfree(u2lc); } - TclStackFree(interp, mapLens); - TclStackFree(interp, mapStrings); + ckfree(mapLens); + ckfree(mapStrings); } if (p != ustring1) { /* @@ -2082,7 +2082,7 @@ StringMapCmd( Tcl_SetObjResult(interp, resultPtr); done: if (mapWithDict) { - TclStackFree(interp, mapElemv); + ckfree(mapElemv); } if (copySource) { Tcl_DecrRefCount(sourceObj); @@ -3853,7 +3853,7 @@ TclNRSwitchObjCmd( */ matchFound: - ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + ctxPtr = ckalloc(sizeof(CmdFrame)); *ctxPtr = *iPtr->cmdFramePtr; if (splitObjs) { @@ -3970,7 +3970,7 @@ SwitchPostProc( (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } - TclStackFree(interp, ctxPtr); + ckfree(ctxPtr); return result; } @@ -4750,7 +4750,7 @@ TclNRWhileObjCmd( * We reuse [for]'s callback, passing a NULL for the 'next' script. */ - TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr); + TclCkSmallAlloc(sizeof(ForIterData), iterPtr); iterPtr->cond = objv[1]; iterPtr->body = objv[2]; iterPtr->next = NULL; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 4751455..c7cfb97 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -1682,8 +1682,7 @@ TclCompileDictUpdateCmd( duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1)); duiPtr->length = numVars; - keyTokenPtrs = TclStackAlloc(interp, - sizeof(Tcl_Token *) * numVars); + keyTokenPtrs = ckalloc(sizeof(Tcl_Token *) * numVars); tokenPtr = TokenAfter(dictVarTokenPtr); for (i=0 ; i<numVars ; i++) { @@ -1721,7 +1720,7 @@ TclCompileDictUpdateCmd( if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { failedUpdateInfoAssembly: ckfree(duiPtr); - TclStackFree(interp, keyTokenPtrs); + ckfree(keyTokenPtrs); return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } bodyTokenPtr = tokenPtr; @@ -1786,7 +1785,7 @@ TclCompileDictUpdateCmd( Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset)); } - TclStackFree(interp, keyTokenPtrs); + ckfree(keyTokenPtrs); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } @@ -2604,10 +2603,9 @@ CompileEachloopCmd( */ numLists = (numWords - 2)/2; - varcList = TclStackAlloc(interp, numLists * sizeof(int)); + varcList = ckalloc(numLists * sizeof(int)); memset(varcList, 0, numLists * sizeof(int)); - varvList = (const char ***) TclStackAlloc(interp, - numLists * sizeof(const char **)); + varvList = (const char ***) ckalloc(numLists * sizeof(const char **)); memset((char*) varvList, 0, numLists * sizeof(const char **)); /* @@ -2859,8 +2857,8 @@ CompileEachloopCmd( ckfree(varvList[loopIndex]); } } - TclStackFree(interp, (void *)varvList); - TclStackFree(interp, varcList); + ckfree((void *)varvList); + ckfree(varcList); return code; } @@ -5531,7 +5529,7 @@ TclCompileReturnCmd( * Allocate some working space. */ - objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *)); + objv = ckalloc(numOptionWords * sizeof(Tcl_Obj *)); /* * Scan through the return options. If any are unknown at compile time, @@ -5555,7 +5553,7 @@ TclCompileReturnCmd( while (--objc >= 0) { TclDecrRefCount(objv[objc]); } - TclStackFree(interp, objv); + ckfree(objv); if (TCL_ERROR == status) { /* * Something was bogus in the return options. Clear the error message, @@ -6102,7 +6100,7 @@ PushVarName( * assemble the corresponding token. */ - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); + elemTokenPtr = ckalloc(sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; @@ -6155,7 +6153,7 @@ PushVarName( * token. */ - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); + elemTokenPtr = ckalloc(n * sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; @@ -6244,7 +6242,7 @@ PushVarName( varTokenPtr[removedParen].size++; } if (allocedTokens) { - TclStackFree(interp, elemTokenPtr); + ckfree(elemTokenPtr); } *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index f73beca..5c1e6eb 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -737,7 +737,7 @@ TclCompileSubstCmd( return TCL_ERROR; } - objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); + objv = ckalloc(/*numArgs*/ numOpts * sizeof(Tcl_Obj *)); for (objc = 0; objc < /*numArgs*/ numOpts; objc++) { objv[objc] = Tcl_NewObj(); @@ -770,7 +770,7 @@ TclCompileSubstCmd( while (--objc >= 0) { TclDecrRefCount(objv[objc]); } - TclStackFree(interp, objv); + ckfree(objv); if (/*toSubst == NULL*/ code != TCL_OK) { return TCL_ERROR; } @@ -1431,8 +1431,8 @@ IssueSwitchChainedTests( contFixIndex = -1; contFixCount = 0; - fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens); - fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens); + fixupArray = ckalloc(sizeof(JumpFixup) * numBodyTokens); + fixupTargetArray = ckalloc(sizeof(int) * numBodyTokens); memset(fixupTargetArray, 0, numBodyTokens * sizeof(int)); fixupCount = 0; foundDefault = 0; @@ -1631,8 +1631,8 @@ IssueSwitchChainedTests( } } } - TclStackFree(interp, fixupTargetArray); - TclStackFree(interp, fixupArray); + ckfree(fixupTargetArray); + ckfree(fixupArray); envPtr->currStackDepth = savedStackDepth + 1; } @@ -1694,7 +1694,7 @@ IssueSwitchJumpTable( jtPtr = ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); - finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2)); + finalFixups = ckalloc(sizeof(int) * (numBodyTokens/2)); foundDefault = 0; mustGenerate = 1; @@ -1833,7 +1833,7 @@ IssueSwitchJumpTable( * Clean up all our temporary space and return. */ - TclStackFree(interp, finalFixups); + ckfree(finalFixups); envPtr->currStackDepth = savedStackDepth + 1; } @@ -2139,12 +2139,12 @@ TclCompileTryCmd( numHandlers = numWords >> 2; numWords -= numHandlers * 4; if (numHandlers > 0) { - handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers); - matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers); + handlerTokens = ckalloc(sizeof(Tcl_Token*)*numHandlers); + matchClauses = ckalloc(sizeof(Tcl_Obj *) * numHandlers); memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers); - matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers); - resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers); - optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers); + matchCodes = ckalloc(sizeof(int) * numHandlers); + resultVarIndices = ckalloc(sizeof(int) * numHandlers); + optionVarIndices = ckalloc(sizeof(int) * numHandlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *tmpObj, **objv; @@ -2303,11 +2303,11 @@ TclCompileTryCmd( TclDecrRefCount(matchClauses[i]); } } - TclStackFree(interp, optionVarIndices); - TclStackFree(interp, resultVarIndices); - TclStackFree(interp, matchCodes); - TclStackFree(interp, matchClauses); - TclStackFree(interp, handlerTokens); + ckfree(optionVarIndices); + ckfree(resultVarIndices); + ckfree(matchCodes); + ckfree(matchClauses); + ckfree(handlerTokens); } return result; } @@ -2384,8 +2384,8 @@ IssueTryInstructions( * Slight overallocation, but reduces size of this function. */ - addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); + addrsToFix = ckalloc(sizeof(int)*numHandlers); + forwardsToFix = ckalloc(sizeof(int)*numHandlers); for (i=0 ; i<numHandlers ; i++) { sprintf(buf, "%d", matchCodes[i]); @@ -2474,8 +2474,8 @@ IssueTryInstructions( for (i=0 ; i<numHandlers ; i++) { FIXJUMP(addrsToFix[i]); } - TclStackFree(interp, forwardsToFix); - TclStackFree(interp, addrsToFix); + ckfree(forwardsToFix); + ckfree(addrsToFix); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } @@ -2539,8 +2539,8 @@ IssueTryFinallyInstructions( * Slight overallocation, but reduces size of this function. */ - addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); - forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers); + addrsToFix = ckalloc(sizeof(int)*numHandlers); + forwardsToFix = ckalloc(sizeof(int)*numHandlers); for (i=0 ; i<numHandlers ; i++) { sprintf(buf, "%d", matchCodes[i]); @@ -2674,8 +2674,8 @@ IssueTryFinallyInstructions( for (i=0 ; i<numHandlers-1 ; i++) { FIXJUMP(addrsToFix[i]); } - TclStackFree(interp, forwardsToFix); - TclStackFree(interp, addrsToFix); + ckfree(forwardsToFix); + ckfree(addrsToFix); } /* @@ -3113,7 +3113,7 @@ PushVarName( * assemble the corresponding token. */ - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); + elemTokenPtr = ckalloc(sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; @@ -3166,7 +3166,7 @@ PushVarName( * token. */ - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); + elemTokenPtr = ckalloc(n * sizeof(Tcl_Token)); allocedTokens = 1; elemTokenPtr->type = TCL_TOKEN_TEXT; elemTokenPtr->start = elName; @@ -3254,7 +3254,7 @@ PushVarName( varTokenPtr[removedParen].size++; } if (allocedTokens) { - TclStackFree(interp, elemTokenPtr); + ckfree(elemTokenPtr); } *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 346f446..0938e3b 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -917,7 +917,7 @@ ParseExpr( case SCRIPT: { Tcl_Parse *nestedPtr = - TclStackAlloc(interp, sizeof(Tcl_Parse)); + ckalloc(sizeof(Tcl_Parse)); tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; tokenPtr->type = TCL_TOKEN_COMMAND; @@ -952,7 +952,7 @@ ParseExpr( break; } } - TclStackFree(interp, nestedPtr); + ckfree(nestedPtr); end = start; start = tokenPtr->start; scanned = end - start; @@ -1835,7 +1835,7 @@ Tcl_ParseExpr( OpNode *opTree = NULL; /* Will point to the tree of operators. */ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */ - Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *exprParsePtr = ckalloc(sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ if (numBytes < 0) { @@ -1857,7 +1857,7 @@ Tcl_ParseExpr( } Tcl_FreeParse(exprParsePtr); - TclStackFree(interp, exprParsePtr); + ckfree(exprParsePtr); ckfree(opTree); return code; } @@ -2127,7 +2127,7 @@ TclCompileExpr( OpNode *opTree = NULL; /* Will point to the tree of operators */ Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ int code = ParseExpr(interp, script, numBytes, &opTree, litList, @@ -2155,7 +2155,7 @@ TclCompileExpr( } Tcl_FreeParse(parsePtr); - TclStackFree(interp, parsePtr); + ckfree(parsePtr); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); ckfree(opTree); @@ -2198,7 +2198,7 @@ ExecConstantExprTree( * bytecode, so there's no need to tend to TIP 280 issues. */ - envPtr = TclStackAlloc(interp, sizeof(CompileEnv)); + envPtr = ckalloc(sizeof(CompileEnv)); TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0); CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr, 0 /* optimize */); @@ -2206,7 +2206,7 @@ ExecConstantExprTree( Tcl_IncrRefCount(byteCodeObj); TclInitByteCodeObj(byteCodeObj, envPtr); TclFreeCompileEnv(envPtr); - TclStackFree(interp, envPtr); + ckfree(envPtr); byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1; TclNRExecuteByteCode(interp, byteCodePtr); code = TclNRRunCallbacks(interp, TCL_OK, rootPtr); @@ -2263,10 +2263,10 @@ CompileExprTree( switch (nodePtr->lexeme) { case QUESTION: - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = ckalloc(sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = ckalloc(sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; jumpPtr->depth = envPtr->currStackDepth; @@ -2274,13 +2274,13 @@ CompileExprTree( break; case AND: case OR: - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = ckalloc(sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = ckalloc(sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump = ckalloc(sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; jumpPtr->depth = envPtr->currStackDepth; @@ -2386,10 +2386,10 @@ CompileExprTree( envPtr->currStackDepth = jumpPtr->depth + 1; freePtr = jumpPtr; jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); + ckfree(freePtr); freePtr = jumpPtr; jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); + ckfree(freePtr); break; case AND: case OR: @@ -2413,13 +2413,13 @@ CompileExprTree( envPtr->currStackDepth = jumpPtr->depth + 1; freePtr = jumpPtr; jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); + ckfree(freePtr); freePtr = jumpPtr; jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); + ckfree(freePtr); freePtr = jumpPtr; jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); + ckfree(freePtr); break; default: TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); @@ -2623,9 +2623,8 @@ TclSortingOpCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } else { TclOpCmdClientData *occdPtr = clientData; - Tcl_Obj **litObjv = TclStackAlloc(interp, - 2 * (objc-2) * sizeof(Tcl_Obj *)); - OpNode *nodes = TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode)); + Tcl_Obj **litObjv = ckalloc(2 * (objc-2) * sizeof(Tcl_Obj *)); + OpNode *nodes = ckalloc(2 * (objc-2) * sizeof(OpNode)); unsigned char lexeme; int i, lastAnd = 1; Tcl_Obj *const *litObjPtrPtr = litObjv; @@ -2665,8 +2664,8 @@ TclSortingOpCmd( code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr); - TclStackFree(interp, nodes); - TclStackFree(interp, litObjv); + ckfree(nodes); + ckfree(litObjv); } return code; } @@ -2752,7 +2751,7 @@ TclVariadicOpCmd( return code; } else { Tcl_Obj *const *litObjv = objv + 1; - OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode)); + OpNode *nodes = ckalloc((objc-1) * sizeof(OpNode)); int i, lastOp = OT_LITERAL; nodes[0].lexeme = START; @@ -2785,7 +2784,7 @@ TclVariadicOpCmd( code = ExecConstantExprTree(interp, nodes, 0, &litObjv); - TclStackFree(interp, nodes); + ckfree(nodes); return code; } } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 4069cf0..e8f778a 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1315,7 +1315,7 @@ TclInitCompileEnv( * ...) which may make change the type as well. */ - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame)); int pc = 0; *ctxPtr = *invoker; @@ -1368,7 +1368,7 @@ TclInitCompileEnv( } } - TclStackFree(interp, ctxPtr); + ckfree(ctxPtr); } envPtr->extCmdMapPtr->start = envPtr->line; @@ -1574,7 +1574,7 @@ TclCompileScript( /* TIP #280 */ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat, cmdLine, *clNext; - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); Tcl_DStringInit(&ds); @@ -2012,7 +2012,7 @@ TclCompileScript( } envPtr->numSrcBytes = p - script; - TclStackFree(interp, parsePtr); + ckfree(parsePtr); Tcl_DStringFree(&ds); } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index e31d708..891f07a 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -2399,14 +2399,14 @@ DictForNRCmd( "must have exactly two variable names", -1)); return TCL_ERROR; } - searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch)); + searchPtr = ckalloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj, &done) != TCL_OK) { - TclStackFree(interp, searchPtr); + ckfree(searchPtr); return TCL_ERROR; } if (done) { - TclStackFree(interp, searchPtr); + ckfree(searchPtr); return TCL_OK; } TclListObjGetElements(NULL, objv[1], &varc, &varv); @@ -2456,7 +2456,7 @@ DictForNRCmd( TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(searchPtr); - TclStackFree(interp, searchPtr); + ckfree(searchPtr); return TCL_ERROR; } @@ -2538,7 +2538,7 @@ DictForLoopCallback( TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); Tcl_DictObjDone(searchPtr); - TclStackFree(interp, searchPtr); + ckfree(searchPtr); return result; } @@ -2590,10 +2590,10 @@ DictMapNRCmd( "must have exactly two variable names", -1)); return TCL_ERROR; } - storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage)); + storagePtr = ckalloc(sizeof(DictMapStorage)); if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, &valueObj, &done) != TCL_OK) { - TclStackFree(interp, storagePtr); + ckfree(storagePtr); return TCL_ERROR; } if (done) { @@ -2603,7 +2603,7 @@ DictMapNRCmd( * an empty dictionary. */ - TclStackFree(interp, storagePtr); + ckfree(storagePtr); return TCL_OK; } TclNewObj(storagePtr->accumulatorObj); @@ -2659,7 +2659,7 @@ DictMapNRCmd( TclDecrRefCount(storagePtr->scriptObj); TclDecrRefCount(storagePtr->accumulatorObj); Tcl_DictObjDone(&storagePtr->search); - TclStackFree(interp, storagePtr); + ckfree(storagePtr); return TCL_ERROR; } @@ -2749,7 +2749,7 @@ DictMapLoopCallback( TclDecrRefCount(storagePtr->scriptObj); TclDecrRefCount(storagePtr->accumulatorObj); Tcl_DictObjDone(&storagePtr->search); - TclStackFree(interp, storagePtr); + ckfree(storagePtr); return result; } diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 0b585b6..5f8fbee 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1043,11 +1043,9 @@ TclInitSubsystems(void) * implementation of self-initializing locks. */ + TclInitAlloc(); /* Process wide allocator init */ 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 @@ -1221,14 +1219,6 @@ Tcl_Finalize(void) TclFinalizeSynchronization(); /* - * Close down the thread-specific object allocator. - */ - -#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) - TclFinalizeThreadAlloc(); -#endif - - /* * We defer unloading of packages until very late to avoid memory access * issues. Both exit callbacks and synchronization variables may be stored * in packages. @@ -1252,6 +1242,14 @@ Tcl_Finalize(void) TclFinalizeMemorySubsystem(); + /* + * Close down the thread-specific object allocator. + */ + + TclFinalizeAlloc(); + + + alreadyFinalized: TclFinalizeLock(); } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index be2e3ca..2004f4c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -174,11 +174,13 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { typedef struct TEBCdata { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ + Tcl_Obj **tosPtr; const unsigned char *pc; /* These fields are used on return TO this */ - ptrdiff_t *catchTop; /* this level: they record the state when a */ + unsigned long catchDepth; /* this level: they record the state when a */ int cleanup; /* new codePtr was received for NR */ Tcl_Obj *auxObjList; /* execution. */ int checkInterp; + unsigned int capacity; CmdFrame cmdFrame; void *stack[1]; /* Start of the actual combined catch and obj * stacks; the struct will be expanded as @@ -187,7 +189,7 @@ typedef struct TEBCdata { #define TEBC_YIELD() \ do { \ - esPtr->tosPtr = tosPtr; \ + TD->tosPtr = tosPtr; \ TD->pc = pc; \ TD->cleanup = cleanup; \ TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ @@ -197,7 +199,7 @@ typedef struct TEBCdata { do { \ pc = TD->pc; \ cleanup = TD->cleanup; \ - tosPtr = esPtr->tosPtr; \ + tosPtr = TD->tosPtr; \ } while (0) #define PUSH_TAUX_OBJ(objPtr) \ @@ -316,20 +318,6 @@ VarHashCreateVar( } while (0) /* - * Macros used to cache often-referenced Tcl evaluation stack information - * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() - * pair must surround any call inside TclNRExecuteByteCode (and a few other - * procedures that use this scheme) that could result in a recursive call - * to TclNRExecuteByteCode. - */ - -#define CACHE_STACK_INFO() \ - checkInterp = 1 - -#define DECACHE_STACK_INFO() \ - esPtr->tosPtr = tosPtr - -/* * Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT * increments the object's ref count since it makes the stack have another * reference pointing to the object. However, POP_OBJECT does not decrement @@ -703,7 +691,6 @@ static void ValidatePcAndStackTop(ByteCode *codePtr, int checkStack); #endif /* TCL_COMPILE_DEBUG */ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr); -static void DeleteExecStack(ExecStack *esPtr); static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, @@ -719,16 +706,10 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, static const char * GetSrcInfoForPc(const unsigned char *pc, ByteCode *codePtr, int *lengthPtr, const unsigned char **pcBeg); -static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, - int move); static void IllegalExprOperandType(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); -static inline int OFFSET(void *ptr); static void ReleaseDictIterator(Tcl_Obj *objPtr); -/* Useful elsewhere, make available in tclInt.h or stubs? */ -static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); -static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; @@ -865,10 +846,7 @@ TclCreateExecEnv( * [sizeof(Tcl_Obj*)] */ { ExecEnv *eePtr = ckalloc(sizeof(ExecEnv)); - ExecStack *esPtr = ckalloc(sizeof(ExecStack) - + (size_t) (size-1) * sizeof(Tcl_Obj *)); - eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); TclNewBooleanObj(eePtr->constants[1], 1); @@ -878,12 +856,6 @@ TclCreateExecEnv( eePtr->corPtr = NULL; eePtr->rewind = 0; - esPtr->prevPtr = NULL; - esPtr->nextPtr = NULL; - esPtr->markerPtr = NULL; - esPtr->endPtr = &esPtr->stackWords[size-1]; - esPtr->tosPtr = &esPtr->stackWords[-1]; - Tcl_MutexLock(&execMutex); if (!execInitialized) { TclInitAuxDataTypeTable(); @@ -912,44 +884,16 @@ TclCreateExecEnv( *---------------------------------------------------------------------- */ -static void -DeleteExecStack( - ExecStack *esPtr) -{ - if (esPtr->markerPtr && !cachedInExit) { - Tcl_Panic("freeing an execStack which is still in use"); - } - - if (esPtr->prevPtr) { - esPtr->prevPtr->nextPtr = esPtr->nextPtr; - } - if (esPtr->nextPtr) { - esPtr->nextPtr->prevPtr = esPtr->prevPtr; - } - ckfree(esPtr); -} - void TclDeleteExecEnv( ExecEnv *eePtr) /* Execution environment to free. */ { - ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr; - cachedInExit = TclInExit(); /* * Delete all stacks in this exec env. */ - while (esPtr->nextPtr) { - esPtr = esPtr->nextPtr; - } - while (esPtr) { - tmpPtr = esPtr; - esPtr = tmpPtr->prevPtr; - DeleteExecStack(tmpPtr); - } - TclDecrRefCount(eePtr->constants[0]); TclDecrRefCount(eePtr->constants[1]); if (eePtr->callbackPtr && !cachedInExit) { @@ -989,351 +933,6 @@ TclFinalizeExecution(void) } /* - * Auxiliary code to insure that GrowEvaluationStack always returns correctly - * aligned memory. - * - * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN - * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a - * multiple of the wordsize 'sizeof(Tcl_Obj *)'. - */ - -#define WALLOCALIGN \ - (TCL_ALLOCALIGN/sizeof(Tcl_Obj *)) - -/* - * OFFSET computes how many words have to be skipped until the next aligned - * word. Note that we are only interested in the low order bits of ptr, so - * that any possible information loss in PTR2INT is of no consequence. - */ - -static inline int -OFFSET( - void *ptr) -{ - int mask = TCL_ALLOCALIGN-1; - int base = PTR2INT(ptr) & mask; - return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *); -} - -/* - * Given a marker, compute where the following aligned memory starts. - */ - -#define MEMSTART(markerPtr) \ - ((markerPtr) + OFFSET(markerPtr)) - -/* - *---------------------------------------------------------------------- - * - * GrowEvaluationStack -- - * - * This procedure grows a Tcl evaluation stack stored in an ExecEnv, - * copying over the words since the last mark if so requested. A mark is - * set at the beginning of the new area when no copying is requested. - * - * Results: - * Returns a pointer to the first usable word in the (possibly) grown - * stack. - * - * Side effects: - * The size of the evaluation stack may be grown, a marker is set - * - *---------------------------------------------------------------------- - */ - -static Tcl_Obj ** -GrowEvaluationStack( - ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation - * stack to enlarge. */ - int growth, /* How much larger than the current used - * size. */ - int move) /* 1 if move words since last marker. */ -{ - ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; - int newBytes, newElems, currElems; - int needed = growth - (esPtr->endPtr - esPtr->tosPtr); - Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; - int moveWords = 0; - - if (move) { - if (!markerPtr) { - Tcl_Panic("STACK: Reallocating with no previous alloc"); - } - if (needed <= 0) { - return MEMSTART(markerPtr); - } - } else { -#ifndef PURIFY - Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1; - int offset = OFFSET(tmpMarkerPtr); - - if (needed + offset < 0) { - /* - * Put a marker pointing to the previous marker in this stack, and - * store it in esPtr as the current marker. Return a pointer to - * the start of aligned memory. - */ - - esPtr->markerPtr = tmpMarkerPtr; - memStart = tmpMarkerPtr + offset; - esPtr->tosPtr = memStart - 1; - *esPtr->markerPtr = (Tcl_Obj *) markerPtr; - return memStart; - } -#endif - } - - /* - * Reset move to hold the number of words to be moved to new stack (if - * any) and growth to hold the complete stack requirements: add one for - * the marker, (WALLOCALIGN-1) for the maximal possible offset. - */ - - if (move) { - moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1; - } - needed = growth + moveWords + WALLOCALIGN; - - - /* - * Check if there is enough room in the next stack (if there is one, it - * should be both empty and the last one!) - */ - - if (esPtr->nextPtr) { - oldPtr = esPtr; - esPtr = oldPtr->nextPtr; - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; - if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) { - Tcl_Panic("STACK: Stack after current is in use"); - } - if (esPtr->nextPtr) { - Tcl_Panic("STACK: Stack after current is not last"); - } - if (needed <= currElems) { - goto newStackReady; - } - DeleteExecStack(esPtr); - esPtr = oldPtr; - } else { - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; - } - - /* - * We need to allocate a new stack! It needs to store 'growth' words, - * including the elements to be copied over and the new marker. - */ - -#ifndef PURIFY - newElems = 2*currElems; - while (needed > newElems) { - newElems *= 2; - } -#else - newElems = needed; -#endif - - newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *); - - oldPtr = esPtr; - esPtr = ckalloc(newBytes); - - oldPtr->nextPtr = esPtr; - esPtr->prevPtr = oldPtr; - esPtr->nextPtr = NULL; - esPtr->endPtr = &esPtr->stackWords[newElems-1]; - - newStackReady: - eePtr->execStackPtr = esPtr; - - /* - * Store a NULL marker at the beginning of the stack, to indicate that - * this is the first marker in this stack and that rewinding to here - * should actually be a return to the previous stack. - */ - - esPtr->stackWords[0] = NULL; - esPtr->markerPtr = &esPtr->stackWords[0]; - memStart = MEMSTART(esPtr->markerPtr); - esPtr->tosPtr = memStart - 1; - - if (move) { - memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *)); - esPtr->tosPtr += moveWords; - oldPtr->markerPtr = (Tcl_Obj **) *markerPtr; - oldPtr->tosPtr = markerPtr-1; - } - - /* - * Free the old stack if it is now unused. - */ - - if (!oldPtr->markerPtr) { - DeleteExecStack(oldPtr); - } - - return memStart; -} - -/* - *-------------------------------------------------------------- - * - * TclStackAlloc, TclStackRealloc, TclStackFree -- - * - * Allocate memory from the execution stack; it has to be returned later - * with a call to TclStackFree. - * - * Results: - * A pointer to the first byte allocated, or panics if the allocation did - * not succeed. - * - * Side effects: - * The execution stack may be grown. - * - *-------------------------------------------------------------- - */ - -static Tcl_Obj ** -StackAllocWords( - Tcl_Interp *interp, - int numWords) -{ - /* - * Note that GrowEvaluationStack sets a marker in the stack. This marker - * is read when rewinding, e.g., by TclStackFree. - */ - - Interp *iPtr = (Interp *) interp; - ExecEnv *eePtr = iPtr->execEnvPtr; - Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0); - - eePtr->execStackPtr->tosPtr += numWords; - return resPtr; -} - -static Tcl_Obj ** -StackReallocWords( - Tcl_Interp *interp, - int numWords) -{ - Interp *iPtr = (Interp *) interp; - ExecEnv *eePtr = iPtr->execEnvPtr; - Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1); - - eePtr->execStackPtr->tosPtr += numWords; - return resPtr; -} - -void -TclStackFree( - Tcl_Interp *interp, - void *freePtr) -{ - Interp *iPtr = (Interp *) interp; - ExecEnv *eePtr; - ExecStack *esPtr; - Tcl_Obj **markerPtr, *marker; - - if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - ckfree((char *) freePtr); - return; - } - - /* - * Rewind the stack to the previous marker position. The current marker, - * as set in the last call to GrowEvaluationStack, contains a pointer to - * the previous marker. - */ - - eePtr = iPtr->execEnvPtr; - esPtr = eePtr->execStackPtr; - markerPtr = esPtr->markerPtr; - marker = *markerPtr; - - if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) { - Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?", - freePtr, MEMSTART(markerPtr)); - } - - esPtr->tosPtr = markerPtr - 1; - esPtr->markerPtr = (Tcl_Obj **) marker; - if (marker) { - return; - } - - /* - * Return to previous active stack. Note that repeated expansions or - * reallocs could have generated several unused intervening stacks: free - * them too. - */ - - while (esPtr->nextPtr) { - esPtr = esPtr->nextPtr; - } - esPtr->tosPtr = &esPtr->stackWords[-1]; - while (esPtr->prevPtr) { - ExecStack *tmpPtr = esPtr->prevPtr; - if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) { - DeleteExecStack(tmpPtr); - } else { - break; - } - } - if (esPtr->prevPtr) { - eePtr->execStackPtr = esPtr->prevPtr; -#ifdef PURIFY - eePtr->execStackPtr->nextPtr = NULL; - DeleteExecStack(esPtr); -#endif - } else { - eePtr->execStackPtr = esPtr; - } -} - -void * -TclStackAlloc( - Tcl_Interp *interp, - int numBytes) -{ - Interp *iPtr = (Interp *) interp; - int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); - - if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckalloc(numBytes); - } - - return (void *) StackAllocWords(interp, numWords); -} - -void * -TclStackRealloc( - Tcl_Interp *interp, - void *ptr, - int numBytes) -{ - Interp *iPtr = (Interp *) interp; - ExecEnv *eePtr; - ExecStack *esPtr; - Tcl_Obj **markerPtr; - int numWords; - - if (iPtr == NULL || iPtr->execEnvPtr == NULL) { - return (void *) ckrealloc((char *) ptr, numBytes); - } - - eePtr = iPtr->execEnvPtr; - esPtr = eePtr->execStackPtr; - markerPtr = esPtr->markerPtr; - - if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) { - Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?"); - } - - numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *); - return (void *) StackReallocWords(interp, numWords); -} - -/* *-------------------------------------------------------------- * * Tcl_ExprObj -- @@ -1735,7 +1334,7 @@ TclCompileObj( eclPtr = Tcl_GetHashValue(hePtr); redo = 0; - ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + ctxCopyPtr = ckalloc(sizeof(CmdFrame)); *ctxCopyPtr = *invoker; if (invoker->type == TCL_LOCATION_BC) { @@ -1773,7 +1372,7 @@ TclCompileObj( && (ctxCopyPtr->type == TCL_LOCATION_SOURCE)); } - TclStackFree(interp, ctxCopyPtr); + ckfree(ctxCopyPtr); if (!redo) { return codePtr; } @@ -1947,9 +1546,23 @@ TclIncrObj( *---------------------------------------------------------------------- */ #define bcFramePtr (&TD->cmdFrame) -#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1])) -#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth)) -#define esPtr (iPtr->execEnvPtr->execStackPtr) +#define catchStack (TD->stack) +#define initTosPtr ((Tcl_Obj **) &TD->stack[codePtr->maxExceptDepth - 1]) + +/* + * The execution uses a unified stack: first a TEBCdata, immediately + * above it the catch stack, then the execution stack. + * + * Make sure the catch stack is large enough to hold the maximum number of + * catch commands that could ever be executing at the same time (this will + * be no more than the exception range array's depth). Make sure the + * execution stack is large enough to execute this ByteCode. + */ + +// FIXME! The "+1" should not be necessary, temporary until we fix BC issues + +#define capacity2size(cap) \ + (offsetof(TEBCdata, stack) + sizeof(void *)*(cap + codePtr->maxExceptDepth + 1)) int TclNRExecuteByteCode( @@ -1958,11 +1571,7 @@ TclNRExecuteByteCode( { Interp *iPtr = (Interp *) interp; TEBCdata *TD; - int size = sizeof(TEBCdata) - 1 - + (codePtr->maxStackDepth + codePtr->maxExceptDepth) - * sizeof(void *); - int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *); - + if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; } @@ -1981,15 +1590,16 @@ TclNRExecuteByteCode( * execution stack is large enough to execute this ByteCode. */ - TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0); - esPtr->tosPtr = initTosPtr; + TD = ckalloc(capacity2size(codePtr->maxStackDepth)); TD->codePtr = codePtr; - TD->pc = codePtr->codeStart; - TD->catchTop = initCatchTop; + TD->tosPtr = initTosPtr; + TD->pc = codePtr->codeStart; + TD->catchDepth = -1; TD->cleanup = 0; TD->auxObjList = NULL; TD->checkInterp = 0; + TD->capacity = codePtr->maxStackDepth; /* * TIP #280: Initialize the frame. Do not push it yet: it will be pushed @@ -2073,11 +1683,11 @@ TEBCresume( TEBCdata *TD = data[0]; #define auxObjList (TD->auxObjList) -#define catchTop (TD->catchTop) +#define catchDepth (TD->catchDepth) #define codePtr (TD->codePtr) #define checkInterp (TD->checkInterp) - /* Indicates when a check of interp readyness is - * necessary. Set by CACHE_STACK_INFO() */ + /* Indicates when a check of interp readyness + * is necessary. Set by checkInterp = 1 */ /* * Globals: variables that store state, must remain valid at all times. @@ -2140,7 +1750,7 @@ TEBCresume( codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; } - CACHE_STACK_INFO(); + checkInterp = 1; if (result == TCL_OK) { #ifndef TCL_COMPILE_DEBUG if (*pc == INST_POP) { @@ -2260,29 +1870,28 @@ TEBCresume( */ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) { - DECACHE_STACK_INFO(); if (TclAsyncReady(iPtr)) { result = Tcl_AsyncInvoke(interp, result); if (result == TCL_ERROR) { - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } } if (TclCanceled(iPtr)) { if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } } if (TclLimitReady(iPtr->limit)) { if (Tcl_LimitCheck(interp) == TCL_ERROR) { - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } } - CACHE_STACK_INFO(); + checkInterp = 1; } /* @@ -2700,7 +2309,7 @@ TEBCresume( case INST_EXPAND_STKTOP: { int i; - ptrdiff_t moved; + unsigned int reqWords; /* * Make sure that the element at stackTop is a list; if not, just @@ -2714,7 +2323,6 @@ TEBCresume( Tcl_GetObjResult(interp)); goto gotError; } - (void) POP_OBJECT(); /* * Make sure there is enough room in the stack to expand this list @@ -2723,22 +2331,23 @@ TEBCresume( * stack depth, as seen by the compiler. */ - length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1)); - DECACHE_STACK_INFO(); - moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - - (Tcl_Obj **) TD; - if (moved) { - /* - * Change the global data to point to the new stack: move the - * TEBCdataPtr TD, recompute the position of every other - * stack-allocated parameter, update the stack pointers. - */ + reqWords = + /* how many were needed originally */ + codePtr->maxStackDepth + /* plus how many we already consumed in previous expansions */ + + (CURR_DEPTH - TclGetInt4AtPtr(pc+1)) + /* plus how many are needed for this expansion */ + + objc - 1; - esPtr = iPtr->execEnvPtr->execStackPtr; - TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved); + (void) POP_OBJECT(); + if (reqWords > TD->capacity) { + ptrdiff_t depth; + unsigned int size = capacity2size(reqWords); - catchTop += moved; - tosPtr += moved; + depth = tosPtr - initTosPtr; + TD = ckrealloc(TD, size); + TD->capacity = reqWords; + tosPtr = initTosPtr + depth; } /* @@ -2759,9 +2368,8 @@ TEBCresume( bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; - DECACHE_STACK_INFO(); newCodePtr = CompileExprObj(interp, OBJ_AT_TOS); - CACHE_STACK_INFO(); + checkInterp = 1; cleanup = 1; pc++; TEBC_YIELD(); @@ -2846,8 +2454,6 @@ TEBCresume( codePtr, bcFramePtr, pc - codePtr->codeStart); } - DECACHE_STACK_INFO(); - pc += pcAdjustment; TEBC_YIELD(); return TclNREvalObjv(interp, objc, objv, @@ -2994,14 +2600,13 @@ TEBCresume( iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = opnd; iPtr->ensembleRewrite.numInsertedObjs = 1; - DECACHE_STACK_INFO(); pc += 6; TEBC_YIELD(); TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL); TclSkipTailcall(interp); return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN); - + /* * ----------------------------------------------------------------- * Start of INST_LOAD instructions. @@ -3136,10 +2741,9 @@ TEBCresume( * TclPtrGetVar to process fully. */ - DECACHE_STACK_INFO(); objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; if (!objResultPtr) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -3383,10 +2987,9 @@ TEBCresume( part1Ptr = part2Ptr = NULL; doCallPtrSetVar: - DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, valuePtr, storeFlags, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; if (!objResultPtr) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -3647,10 +3250,9 @@ TEBCresume( } Tcl_DecrRefCount(incrPtr); } else { - DECACHE_STACK_INFO(); objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; Tcl_DecrRefCount(incrPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", @@ -3682,10 +3284,9 @@ TEBCresume( } TRACE(("%u => ", opnd)); if (ReadTraced(varPtr)) { - DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL, TCL_TRACE_READS, 0, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, NULL); varPtr = NULL; @@ -3718,10 +3319,9 @@ TEBCresume( 0, 1, arrayPtr, opnd); if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { - DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr, TCL_TRACE_READS, 0, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); @@ -3751,10 +3351,9 @@ TEBCresume( /*createPart1*/0, /*createPart2*/1, &arrayPtr); if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { - DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, TCL_TRACE_READS, 0, -1); - CACHE_STACK_INFO(); + checkInterp = 1; } if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, arrayPtr); @@ -3798,12 +3397,11 @@ TEBCresume( } slowUnsetScalar: - DECACHE_STACK_INFO(); if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags, opnd) != TCL_OK && flags) { goto errorInUnset; } - CACHE_STACK_INFO(); + checkInterp = 1; NEXT_INST_F(6, 0, 0); case INST_UNSET_ARRAY: @@ -3840,7 +3438,6 @@ TEBCresume( } } slowUnsetArray: - DECACHE_STACK_INFO(); varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset", 0, 0, arrayPtr, opnd); if (!varPtr) { @@ -3851,7 +3448,7 @@ TEBCresume( flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) { goto errorInUnset; } - CACHE_STACK_INFO(); + checkInterp = 1; NEXT_INST_F(6, 1, 0); case INST_UNSET_ARRAY_STK: @@ -3871,16 +3468,15 @@ TEBCresume( TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr))); doUnsetStk: - DECACHE_STACK_INFO(); if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) { goto errorInUnset; } - CACHE_STACK_INFO(); + checkInterp = 1; NEXT_INST_V(2, cleanup, 0); errorInUnset: - CACHE_STACK_INFO(); + checkInterp = 1; TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -3901,9 +3497,8 @@ TEBCresume( } varPtr->value.objPtr = NULL; } else { - DECACHE_STACK_INFO(); TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; } NEXT_INST_F(5, 0, 0); } @@ -3937,11 +3532,9 @@ TEBCresume( doArrayExists: if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { - DECACHE_STACK_INFO(); result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY| TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd); - CACHE_STACK_INFO(); if (result == TCL_ERROR) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -4242,18 +3835,16 @@ TEBCresume( if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5352,9 +4943,8 @@ TEBCresume( TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5363,9 +4953,8 @@ TEBCresume( TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (value2Ptr->typePtr? value2Ptr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5423,11 +5012,10 @@ TEBCresume( Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #if 0 - DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); - CACHE_STACK_INFO(); + checkInterp = 1; #endif goto gotError; } else if (l1 == 0) { @@ -5471,11 +5059,10 @@ TEBCresume( Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); #if 0 - DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); - CACHE_STACK_INFO(); + checkInterp = 1; #endif goto gotError; } else if (l1 == 0) { @@ -5494,10 +5081,9 @@ TEBCresume( Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); #if 0 - DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", NULL); - CACHE_STACK_INFO(); + checkInterp = 1; #endif goto gotError; } else { @@ -5580,9 +5166,8 @@ TEBCresume( TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name: "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5601,9 +5186,8 @@ TEBCresume( TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(value2Ptr), O2S(valuePtr), (value2Ptr->typePtr? value2Ptr->typePtr->name: "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, value2Ptr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5750,9 +5334,8 @@ TEBCresume( if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } /* TODO: Consider peephole opt. */ @@ -5770,9 +5353,8 @@ TEBCresume( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } if (type1 == TCL_NUMBER_LONG) { @@ -5797,9 +5379,8 @@ TEBCresume( || IsErroringNaNType(type1)) { TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } switch (type1) { @@ -5843,9 +5424,8 @@ TEBCresume( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } @@ -5861,9 +5441,8 @@ TEBCresume( TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); - DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); - CACHE_STACK_INFO(); + checkInterp = 1; } else { /* * Numeric conversion of NaN -> error. @@ -5871,9 +5450,8 @@ TEBCresume( TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", O2S(objResultPtr))); - DECACHE_STACK_INFO(); TclExprFloatError(interp, *((const double *) ptr1)); - CACHE_STACK_INFO(); + checkInterp = 1; } goto gotError; } @@ -5918,9 +5496,8 @@ TEBCresume( case INST_BREAK: /* - DECACHE_STACK_INFO(); Tcl_ResetResult(interp); - CACHE_STACK_INFO(); + checkInterp = 1; */ result = TCL_BREAK; cleanup = 0; @@ -5928,9 +5505,8 @@ TEBCresume( case INST_CONTINUE: /* - DECACHE_STACK_INFO(); Tcl_ResetResult(interp); - CACHE_STACK_INFO(); + checkInterp = 1; */ result = TCL_CONTINUE; cleanup = 0; @@ -6063,17 +5639,16 @@ TEBCresume( Tcl_IncrRefCount(valuePtr); } } else { - DECACHE_STACK_INFO(); if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ - CACHE_STACK_INFO(); + checkInterp = 1; TRACE_WITH_OBJ(( "%u => ERROR init. index temp %d: ", opnd,varIndex), Tcl_GetObjResult(interp)); TclDecrRefCount(listPtr); goto gotError; } - CACHE_STACK_INFO(); + checkInterp = 1; } valIndex++; } @@ -6105,19 +5680,18 @@ TEBCresume( * stack. */ - *(++catchTop) = CURR_DEPTH; - TRACE(("%u => catchTop=%d, stackTop=%d\n", - TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1), + catchStack[++catchDepth] = INT2PTR(CURR_DEPTH); + TRACE(("%u => catchDepth=%d, stackTop=%d\n", + TclGetUInt4AtPtr(pc+1), (int) (catchDepth), (int) CURR_DEPTH)); NEXT_INST_F(5, 0, 0); case INST_END_CATCH: - catchTop--; - DECACHE_STACK_INFO(); + catchDepth--; Tcl_ResetResult(interp); - CACHE_STACK_INFO(); + checkInterp = 1; result = TCL_OK; - TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1))); + TRACE(("=> catchDepth=%d\n", (int) (catchDepth))); NEXT_INST_F(1, 0, 0); case INST_PUSH_RESULT: @@ -6139,9 +5713,8 @@ TEBCresume( NEXT_INST_F(1, 0, 1); case INST_PUSH_RETURN_OPTIONS: - DECACHE_STACK_INFO(); objResultPtr = Tcl_GetReturnOptions(interp, result); - CACHE_STACK_INFO(); + checkInterp = 1; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); @@ -6218,13 +5791,12 @@ TEBCresume( TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd+1, 1); } - DECACHE_STACK_INFO(); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "key \"%s\" not known in dictionary", TclGetString(OBJ_AT_TOS))); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", TclGetString(OBJ_AT_TOS), NULL); - CACHE_STACK_INFO(); + checkInterp = 1; TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp)); } else { if (*pc == INST_DICT_EXISTS) { @@ -6254,9 +5826,8 @@ TEBCresume( if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { - DECACHE_STACK_INFO(); dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2); - CACHE_STACK_INFO(); + checkInterp = 1; } if (dictPtr == NULL) { TclNewObj(dictPtr); @@ -6328,10 +5899,9 @@ TEBCresume( objResultPtr = dictPtr; } else { Tcl_IncrRefCount(dictPtr); - DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd2); - CACHE_STACK_INFO(); + checkInterp = 1; TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", @@ -6358,9 +5928,8 @@ TEBCresume( if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { - DECACHE_STACK_INFO(); dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; } if (dictPtr == NULL) { TclNewObj(dictPtr); @@ -6464,10 +6033,9 @@ TEBCresume( objResultPtr = dictPtr; } else { Tcl_IncrRefCount(dictPtr); - DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", @@ -6569,10 +6137,9 @@ TEBCresume( if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { - DECACHE_STACK_INFO(); dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, TCL_LEAVE_ERR_MSG, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; if (dictPtr == NULL) { goto gotError; } @@ -6593,7 +6160,6 @@ TEBCresume( while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - DECACHE_STACK_INFO(); if (valuePtr == NULL) { TclObjUnsetVar2(interp, localName(iPtr->varFramePtr, duiPtr->varIndices[i]), @@ -6601,10 +6167,10 @@ TEBCresume( } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, duiPtr->varIndices[i]) == NULL) { - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; } - CACHE_STACK_INFO(); + checkInterp = 1; } NEXT_INST_F(9, 0, 0); @@ -6620,9 +6186,8 @@ TEBCresume( if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { - DECACHE_STACK_INFO(); dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; } if (dictPtr == NULL) { NEXT_INST_F(9, 1, 0); @@ -6648,10 +6213,9 @@ TEBCresume( if (TclIsVarDirectReadable(var2Ptr)) { valuePtr = var2Ptr->value.objPtr; } else { - DECACHE_STACK_INFO(); valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0, duiPtr->varIndices[i]); - CACHE_STACK_INFO(); + checkInterp = 1; } if (valuePtr == NULL) { Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]); @@ -6667,10 +6231,9 @@ TEBCresume( TclDecrRefCount(varPtr->value.objPtr); varPtr->value.objPtr = dictPtr; } else { - DECACHE_STACK_INFO(); objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); - CACHE_STACK_INFO(); + checkInterp = 1; if (objResultPtr == NULL) { if (allocdict) { TclDecrRefCount(dictPtr); @@ -6715,10 +6278,8 @@ TEBCresume( TclDecrRefCount(keysPtr); goto gotError; } - DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, objc, objv, keysPtr); - CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); if (result != TCL_OK) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -6741,10 +6302,8 @@ TEBCresume( while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd, objc, objv, keysPtr); - CACHE_STACK_INFO(); if (result != TCL_OK) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -6858,10 +6417,9 @@ TEBCresume( */ divideByZero: - DECACHE_STACK_INFO(); - Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); + Tcl_SetResult(interp, "divide by zero", TCL_STATIC); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); - CACHE_STACK_INFO(); + checkInterp = 1; goto gotError; /* @@ -6870,12 +6428,11 @@ TEBCresume( */ exponOfZero: - DECACHE_STACK_INFO(); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponentiation of zero by negative power", -1)); + Tcl_SetResult(interp, "exponentiation of zero by negative power", + TCL_STATIC); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); - CACHE_STACK_INFO(); + checkInterp = 1; /* * Almost all error paths feed through here rather than assigning to @@ -6901,10 +6458,9 @@ TEBCresume( const unsigned char *pcBeg; bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg); - DECACHE_STACK_INFO(); TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr); - CACHE_STACK_INFO(); + checkInterp = 1; } iPtr->flags &= ~ERR_ALREADY_LOGGED; @@ -6914,9 +6470,8 @@ TEBCresume( */ while (auxObjList) { - if ((catchTop != initCatchTop) - && (*catchTop > (ptrdiff_t) - auxObjList->internalRep.ptrAndLongRep.value)) { + if ((catchDepth >=0) && (PTR2INT(catchStack[catchDepth]) > + PTR2INT(auxObjList->internalRep.twoPtrValue.ptr1))) { break; } POP_TAUX_OBJ(); @@ -6956,7 +6511,7 @@ TEBCresume( #endif goto abnormalReturn; } - if (catchTop == initCatchTop) { + if (catchDepth == -1) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n", @@ -6991,16 +6546,16 @@ TEBCresume( */ processCatch: - while (CURR_DEPTH > *catchTop) { + while (CURR_DEPTH > PTR2INT(catchStack[catchDepth])) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { - fprintf(stdout, " ... found catch at %d, catchTop=%d, " + fprintf(stdout, " ... found catch at %d, catchDepth=%d, " "unwound to %ld, new pc %u\n", - rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1), - (long) *catchTop, (unsigned) rangePtr->catchOffset); + rangePtr->codeOffset, (int) catchDepth, + PTR2INT(catchStack[catchDepth]), (unsigned) rangePtr->catchOffset); } #endif pc = (codePtr->codeStart + rangePtr->catchOffset); @@ -7049,7 +6604,7 @@ TEBCresume( if (--codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } - TclStackFree(interp, TD); /* free my stack */ + ckfree(TD); /* free my stack */ return result; @@ -7093,10 +6648,9 @@ TEBCresume( #undef codePtr #undef iPtr #undef bcFramePtr -#undef initCatchTop #undef initTosPtr #undef auxObjList -#undef catchTop +#undef catchDepth #undef TCONST /* diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 33c1496..dbbc76b 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1007,7 +1007,7 @@ TclFileAttrsCmd( goto end; } attributeStringsAllocated = (const char **) - TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *)); + ckalloc((1+numObjStrings) * sizeof(char *)); for (index = 0; index < numObjStrings; index++) { Tcl_ListObjIndex(interp, objStrings, index, &objPtr); attributeStringsAllocated[index] = TclGetString(objPtr); @@ -1138,7 +1138,7 @@ TclFileAttrsCmd( end: if (attributeStringsAllocated != NULL) { - TclStackFree(interp, (void *) attributeStringsAllocated); + ckfree((void *) attributeStringsAllocated); } if (objStrings != NULL) { Tcl_DecrRefCount(objStrings); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5d4702b..c8dc3d3 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1449,7 +1449,7 @@ Tcl_GlobObjCmd( if (length <= 0) { goto skipTypes; } - globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData)); + globTypes = ckalloc(sizeof(Tcl_GlobTypeData)); globTypes->type = 0; globTypes->perm = 0; globTypes->macType = NULL; @@ -1669,7 +1669,7 @@ Tcl_GlobObjCmd( if (globTypes->macCreator != NULL) { Tcl_DecrRefCount(globTypes->macCreator); } - TclStackFree(interp, globTypes); + ckfree(globTypes); } return result; } diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1673bce..db00b92 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -931,7 +931,7 @@ Tcl_ExecObjCmd( */ argc = objc - skip; - argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *)); + argv = ckalloc((unsigned)(argc + 1) * sizeof(char *)); /* * Copy the string conversions of each (post option) object into the @@ -949,7 +949,7 @@ Tcl_ExecObjCmd( * Free the argv array. */ - TclStackFree(interp, (void *) argv); + ckfree((void *) argv); if (chan == NULL) { return TCL_ERROR; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 29cdbbb..057246b 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -969,13 +969,12 @@ Tcl_WrongNumArgs( len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned)len + 1); + char *quotedElementStr = ckalloc((unsigned)len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); - TclStackFree(interp, quotedElementStr); + ckfree(quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } @@ -1025,13 +1024,12 @@ Tcl_WrongNumArgs( len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned) len + 1); + char *quotedElementStr = ckalloc((unsigned) len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); - TclStackFree(interp, quotedElementStr); + ckfree(quotedElementStr); } else { Tcl_AppendToObj(objPtr, elementStr, elemLen); } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f0e907f..a18517a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -34,9 +34,9 @@ interface tclInt #declare 2 { # int TclAccessInsertProc(TclAccessProc_ *proc) #} -declare 3 { - void TclAllocateFreeObjects(void) -} +#declare 3 { +# void TclAllocateFreeObjects(void) +#} # Replaced by TclpChdir in 8.1: # declare 4 { # int TclChdir(Tcl_Interp *interp, char *dirName) @@ -289,9 +289,9 @@ declare 64 { #declare 68 { # int TclpAccess(const char *path, int mode) #} -declare 69 { - char *TclpAlloc(unsigned int size) -} +#declare 69 { +# char *TclpAlloc(unsigned int size) +#} #declare 70 { # int TclpCopyFile(const char *source, const char *dest) #} @@ -305,9 +305,9 @@ declare 69 { #declare 73 { # int TclpDeleteFile(const char *path) #} -declare 74 { - void TclpFree(char *ptr) -} +#declare 74 { +# void TclpFree(char *ptr) +#} declare 75 { unsigned long TclpGetClicks(void) } @@ -332,9 +332,9 @@ declare 77 { # Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName, # char *modeString, int permissions) #} -declare 81 { - char *TclpRealloc(char *ptr, unsigned int size) -} +#declare 81 { +# char *TclpRealloc(char *ptr, unsigned int size) +#} #declare 82 { # int TclpRemoveDirectory(const char *path, int recursive, # Tcl_DString *errorPtr) @@ -870,12 +870,12 @@ declare 213 { declare 214 { void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding) } -declare 215 { - void *TclStackAlloc(Tcl_Interp *interp, int numBytes) -} -declare 216 { - void TclStackFree(Tcl_Interp *interp, void *freePtr) -} +#declare 215 { +# void *TclStackAlloc(Tcl_Interp *interp, unsigned int numBytes) +#} +#declare 216 { +# void TclStackFree(Tcl_Interp *interp, void *freePtr) +#} declare 217 { int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame) @@ -894,9 +894,9 @@ declare 225 { Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags) } -declare 226 { - int TclObjBeingDeleted(Tcl_Obj *objPtr) -} +#declare 226 { +# int TclObjBeingDeleted(Tcl_Obj *objPtr) +#} declare 227 { void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]) diff --git a/generic/tclInt.h b/generic/tclInt.h index ddbae7a..45550e2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -10,7 +10,7 @@ * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. - * Copyright (c) 2008 by Miguel Sofer. All rights reserved. + * Copyright (c) 2008-2011 by Miguel Sofer. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -1394,13 +1394,6 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr, (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData)) /* - *---------------------------------------------------------------- - * Data structures related to bytecode compilation and execution. These are - * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c. - *---------------------------------------------------------------- - */ - -/* * Forward declaration to prevent errors when the forward references to * Tcl_Parse and CompileEnv are encountered in the procedure type CompileProc * declared below. @@ -1442,19 +1435,6 @@ typedef int (CompileHookProc)(Tcl_Interp *interp, struct CompileEnv *compEnvPtr, ClientData clientData); /* - * The data structure for a (linked list of) execution stacks. - */ - -typedef struct ExecStack { - struct ExecStack *prevPtr; - struct ExecStack *nextPtr; - Tcl_Obj **markerPtr; - Tcl_Obj **endPtr; - Tcl_Obj **tosPtr; - Tcl_Obj *stackWords[1]; -} ExecStack; - -/* * The data structure defining the execution environment for ByteCode's. * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation * stack that holds command operands and results. The stack grows towards @@ -1491,8 +1471,6 @@ typedef struct CoroutineData { } CoroutineData; typedef struct ExecEnv { - ExecStack *execStackPtr; /* Points to the first item in the evaluation - * stack on the heap. */ Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */ struct Tcl_Interp *interp; struct NRE_callback *callbackPtr; @@ -1773,24 +1751,6 @@ enum PkgPreferOptions { /* *---------------------------------------------------------------- - * This structure shadows the first few fields of the memory cache for the - * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the - * definition there. - * Some macros require knowledge of some fields in the struct in order to - * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer - * to the relevant fields is kept in the objCache field in struct Interp. - *---------------------------------------------------------------- - */ - -typedef struct AllocCache { - 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. */ -} AllocCache; - -/* - *---------------------------------------------------------------- * This structure defines an interpreter, which is a collection of commands * plus other state information related to interpreting commands, such as * variable storage. Primary responsibility for this data structure is in @@ -2122,10 +2082,6 @@ typedef struct Interp { * They are used by the macros defined below. */ - AllocCache *allocCache; - void *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData - * structs for this interp's thread; see - * tclObj.c and tclThreadAlloc.c */ int *asyncReadyPtr; /* Pointer to the asyncReady indicator for * this interp's thread; see tclAsync.c */ /* @@ -2354,17 +2310,6 @@ struct LimitHandler { #define UCHAR(c) ((unsigned char) (c)) /* - * This macro is used to properly align the memory allocated by Tcl, giving - * the same alignment as the native malloc. - */ - -#if defined(__APPLE__) -#define TCL_ALLOCALIGN 16 -#else -#define TCL_ALLOCALIGN (2*sizeof(void *)) -#endif - -/* * This macro is used to determine the offset needed to safely allocate any * data structure in memory. Given a starting offset or size, it "rounds up" * or "aligns" the offset to the next 8-byte boundary so that any data @@ -2750,13 +2695,6 @@ MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType; MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType; -/* - * The head of the list of free Tcl objects, and the total number of Tcl - * objects ever allocated and freed. - */ - -MODULE_SCOPE Tcl_Obj * tclFreeObjList; - #ifdef TCL_COMPILE_STATS MODULE_SCOPE long tclObjsAlloced; MODULE_SCOPE long tclObjsFreed; @@ -2944,7 +2882,6 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); -MODULE_SCOPE void TclFinalizeAllocSubsystem(void); MODULE_SCOPE void TclFinalizeAsync(void); MODULE_SCOPE void TclFinalizeDoubleConversion(void); MODULE_SCOPE void TclFinalizeEncodingSubsystem(void); @@ -2961,7 +2898,6 @@ MODULE_SCOPE void TclFinalizeNotifier(void); MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); -MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadData(void); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const mp_int *a); @@ -3004,7 +2940,6 @@ MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); MODULE_SCOPE void TclInitEmbeddedConfigurationInformation( @@ -3141,8 +3076,6 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); -MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - int numBytes); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, @@ -3999,10 +3932,10 @@ typedef const char *TclDTraceStr; #endif /* TCL_COMPILE_STATS */ # define TclAllocObjStorage(objPtr) \ - TclAllocObjStorageEx(NULL, (objPtr)) + (objPtr) = TclSmallAlloc() # define TclFreeObjStorage(objPtr) \ - TclFreeObjStorageEx(NULL, (objPtr)) + TclSmallFree(objPtr) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ @@ -4037,112 +3970,6 @@ typedef const char *TclDTraceStr; } \ } -#if defined(PURIFY) - -/* - * The PURIFY mode is like the regular mode, but instead of doing block - * Tcl_Obj allocation and keeping a freed list for efficiency, it always - * allocates and frees a single Tcl_Obj so that tools like Purify can better - * track memory leaks. - */ - -# define TclAllocObjStorageEx(interp, objPtr) \ - (objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)) - -# define TclFreeObjStorageEx(interp, objPtr) \ - ckfree((char *) (objPtr)) - -#undef USE_THREAD_ALLOC -#undef USE_TCLALLOC -#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) - -/* - * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from - * per-thread caches. - */ - -MODULE_SCOPE Tcl_Obj * TclThreadAllocObj(void); -MODULE_SCOPE void TclThreadFreeObj(Tcl_Obj *); -MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); -MODULE_SCOPE void TclFreeAllocCache(void *); -MODULE_SCOPE void * TclpGetAllocCache(void); -MODULE_SCOPE void TclpSetAllocCache(void *); -MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex); -MODULE_SCOPE void TclpFreeAllocCache(void *); - -/* - * These macros need to be kept in sync with the code of TclThreadAllocObj() - * and TclThreadFreeObj(). - * - * Note that the optimiser should resolve the case (interp==NULL) at compile - * time. - */ - -# define ALLOC_NOBJHIGH 1200 - -# define TclAllocObjStorageEx(interp, objPtr) \ - do { \ - AllocCache *cachePtr; \ - if (((interp) == NULL) || \ - ((cachePtr = ((Interp *)(interp))->allocCache), \ - (cachePtr->numObjects == 0))) { \ - (objPtr) = TclThreadAllocObj(); \ - } else { \ - (objPtr) = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \ - --cachePtr->numObjects; \ - } \ - } while (0) - -# define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - AllocCache *cachePtr; \ - if (((interp) == NULL) || \ - ((cachePtr = ((Interp *)(interp))->allocCache), \ - (cachePtr->numObjects >= ALLOC_NOBJHIGH))) { \ - TclThreadFreeObj(objPtr); \ - } else { \ - (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \ - cachePtr->firstObjPtr = objPtr; \ - ++cachePtr->numObjects; \ - } \ - } while (0) - -#else /* not PURIFY or USE_THREAD_ALLOC */ - -#if defined(USE_TCLALLOC) && USE_TCLALLOC - MODULE_SCOPE void TclFinalizeAllocSubsystem(); - MODULE_SCOPE void TclInitAlloc(); -#else -# define USE_TCLALLOC 0 -#endif - -#ifdef TCL_THREADS -/* declared in tclObj.c */ -MODULE_SCOPE Tcl_Mutex tclObjMutex; -#endif - -# define TclAllocObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ - if (tclFreeObjList == NULL) { \ - TclAllocateFreeObjects(); \ - } \ - (objPtr) = tclFreeObjList; \ - tclFreeObjList = (Tcl_Obj *) \ - tclFreeObjList->internalRep.twoPtrValue.ptr1; \ - Tcl_MutexUnlock(&tclObjMutex); \ - } while (0) - -# define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ - (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ - } while (0) -#endif - #else /* TCL_MEM_DEBUG */ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, int line); @@ -4165,10 +3992,60 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, # define TclNewListObjDirect(objc, objv) \ TclDbNewListObjDirect(objc, objv, __FILE__, __LINE__) -#undef USE_THREAD_ALLOC #endif /* TCL_MEM_DEBUG */ /* + * Macros that drive the allocator behaviour + */ + +#if defined(TCL_THREADS) +/* + * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from + * per-thread caches. + */ +MODULE_SCOPE void TclpFreeAllocCache(void *); +MODULE_SCOPE void * TclpGetAllocCache(void); +MODULE_SCOPE void TclpSetAllocCache(void *); +MODULE_SCOPE void TclFreeAllocCache(void *); +MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex); +MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void); +#endif + +MODULE_SCOPE char * TclpAlloc(unsigned int size); +MODULE_SCOPE char * TclpRealloc(char * ptr, unsigned int size); +MODULE_SCOPE void TclpFree(char * ptr); + +MODULE_SCOPE void * TclSmallAlloc(); +MODULE_SCOPE void TclSmallFree(void *ptr); +MODULE_SCOPE void TclInitAlloc(void); +MODULE_SCOPE void TclFinalizeAlloc(void); + +#define TclCkSmallAlloc(nbytes, memPtr) \ + do { \ + TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ + memPtr = TclSmallAlloc(); \ + } while (0) + +/* + * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> + */ + +#if defined(PURIFY) && defined(__clang__) +#if __has_feature(attribute_analyzer_noreturn) && \ + !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED) +void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); +#endif +#if !defined(CLANG_ASSERT) +#include <assert.h> +#define CLANG_ASSERT(x) assert(x) +#endif +#elif !defined(CLANG_ASSERT) + #define CLANG_ASSERT(x) +#endif /* PURIFY && __clang__ */ + + + +/* *---------------------------------------------------------------- * Macro used by the Tcl core to set a Tcl_Obj's string representation to a * copy of the "len" bytes starting at "bytePtr". This code works even if the @@ -4703,73 +4580,11 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; {enum { ct_assert_value = 1/(!!(e)) };} /* - *---------------------------------------------------------------- - * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool. - * Only checked at compile time. - * - * ONLY USE FOR CONSTANT nBytes. - * - * DO NOT LET THEM CROSS THREAD BOUNDARIES - *---------------------------------------------------------------- - */ - -#define TclSmallAlloc(nbytes, memPtr) \ - TclSmallAllocEx(NULL, (nbytes), (memPtr)) - -#define TclSmallFree(memPtr) \ - TclSmallFreeEx(NULL, (memPtr)) - -#ifndef TCL_MEM_DEBUG -#define TclSmallAllocEx(interp, nbytes, memPtr) \ - do { \ - Tcl_Obj *objPtr; \ - TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ - TclIncrObjsAllocated(); \ - TclAllocObjStorageEx((interp), (objPtr)); \ - memPtr = (ClientData) (objPtr); \ - } while (0) - -#define TclSmallFreeEx(interp, memPtr) \ - do { \ - TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr)); \ - TclIncrObjsFreed(); \ - } while (0) - -#else /* TCL_MEM_DEBUG */ -#define TclSmallAllocEx(interp, nbytes, memPtr) \ - do { \ - Tcl_Obj *objPtr; \ - TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \ - TclNewObj(objPtr); \ - memPtr = (ClientData) objPtr; \ - } while (0) - -#define TclSmallFreeEx(interp, memPtr) \ - do { \ - Tcl_Obj *objPtr = (Tcl_Obj *) memPtr; \ - objPtr->bytes = NULL; \ - objPtr->typePtr = NULL; \ - objPtr->refCount = 1; \ - TclDecrRefCount(objPtr); \ - } while (0) -#endif /* TCL_MEM_DEBUG */ - -/* * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org> */ -#if defined(PURIFY) && defined(__clang__) -#if __has_feature(attribute_analyzer_noreturn) && \ - !defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED) -void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); -#endif -#if !defined(CLANG_ASSERT) -#include <assert.h> -#define CLANG_ASSERT(x) assert(x) -#endif -#elif !defined(CLANG_ASSERT) #define CLANG_ASSERT(x) -#endif /* PURIFY && __clang__ */ + /* *---------------------------------------------------------------- @@ -4813,8 +4628,8 @@ typedef struct NRE_callback { #if NRE_USE_SMALL_ALLOC #define TCLNR_ALLOC(interp, ptr) \ - TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr)) -#define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) + TclCkSmallAlloc(sizeof(NRE_callback), (ptr)) +#define TCLNR_FREE(interp, ptr) TclSmallFree(ptr) #else #define TCLNR_ALLOC(interp, ptr) \ (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index cf88e5f..5569c79 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -59,8 +59,7 @@ /* Slot 0 is reserved */ /* Slot 1 is reserved */ /* Slot 2 is reserved */ -/* 3 */ -EXTERN void TclAllocateFreeObjects(void); +/* Slot 3 is reserved */ /* Slot 4 is reserved */ /* 5 */ EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, @@ -201,14 +200,12 @@ EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ -/* 69 */ -EXTERN char * TclpAlloc(unsigned int size); +/* Slot 69 is reserved */ /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ -/* 74 */ -EXTERN void TclpFree(char *ptr); +/* Slot 74 is reserved */ /* 75 */ EXTERN unsigned long TclpGetClicks(void); /* 76 */ @@ -218,8 +215,7 @@ EXTERN void TclpGetTime(Tcl_Time *time); /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ -/* 81 */ -EXTERN char * TclpRealloc(char *ptr, unsigned int size); +/* Slot 81 is reserved */ /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -514,10 +510,8 @@ EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); /* 214 */ EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); -/* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); -/* 216 */ -EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); +/* Slot 215 is reserved */ +/* Slot 216 is reserved */ /* 217 */ EXTERN int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, @@ -536,8 +530,7 @@ EXTERN TclPlatformType * TclGetPlatform(void); EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); -/* 226 */ -EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); +/* Slot 226 is reserved */ /* 227 */ EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); @@ -618,7 +611,7 @@ typedef struct TclIntStubs { void (*reserved0)(void); void (*reserved1)(void); void (*reserved2)(void); - void (*tclAllocateFreeObjects) (void); /* 3 */ + void (*reserved3)(void); void (*reserved4)(void); int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */ void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */ @@ -684,19 +677,19 @@ typedef struct TclIntStubs { void (*reserved66)(void); void (*reserved67)(void); void (*reserved68)(void); - char * (*tclpAlloc) (unsigned int size); /* 69 */ + void (*reserved69)(void); void (*reserved70)(void); void (*reserved71)(void); void (*reserved72)(void); void (*reserved73)(void); - void (*tclpFree) (char *ptr); /* 74 */ + void (*reserved74)(void); unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ void (*tclpGetTime) (Tcl_Time *time); /* 77 */ void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); - char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */ + void (*reserved81)(void); void (*reserved82)(void); void (*reserved83)(void); void (*reserved84)(void); @@ -830,8 +823,8 @@ typedef struct TclIntStubs { void (*tclpFindExecutable) (const char *argv0); /* 212 */ Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */ void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */ - void * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */ - void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */ + void (*reserved215)(void); + void (*reserved216)(void); int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */ void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */ void (*reserved219)(void); @@ -841,7 +834,7 @@ typedef struct TclIntStubs { void (*reserved223)(void); TclPlatformType * (*tclGetPlatform) (void); /* 224 */ Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */ - int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */ + void (*reserved226)(void); void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */ void (*reserved228)(void); int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */ @@ -885,8 +878,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 0 is reserved */ /* Slot 1 is reserved */ /* Slot 2 is reserved */ -#define TclAllocateFreeObjects \ - (tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */ +/* Slot 3 is reserved */ /* Slot 4 is reserved */ #define TclCleanupChildren \ (tclIntStubsPtr->tclCleanupChildren) /* 5 */ @@ -990,14 +982,12 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ -#define TclpAlloc \ - (tclIntStubsPtr->tclpAlloc) /* 69 */ +/* Slot 69 is reserved */ /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ -#define TclpFree \ - (tclIntStubsPtr->tclpFree) /* 74 */ +/* Slot 74 is reserved */ #define TclpGetClicks \ (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ @@ -1007,8 +997,7 @@ extern const TclIntStubs *tclIntStubsPtr; /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ -#define TclpRealloc \ - (tclIntStubsPtr->tclpRealloc) /* 81 */ +/* Slot 81 is reserved */ /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -1231,10 +1220,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */ #define TclSetObjNameOfExecutable \ (tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */ -#define TclStackAlloc \ - (tclIntStubsPtr->tclStackAlloc) /* 215 */ -#define TclStackFree \ - (tclIntStubsPtr->tclStackFree) /* 216 */ +/* Slot 215 is reserved */ +/* Slot 216 is reserved */ #define TclPushStackFrame \ (tclIntStubsPtr->tclPushStackFrame) /* 217 */ #define TclPopStackFrame \ @@ -1248,8 +1235,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclGetPlatform) /* 224 */ #define TclTraceDictPath \ (tclIntStubsPtr->tclTraceDictPath) /* 225 */ -#define TclObjBeingDeleted \ - (tclIntStubsPtr->tclObjBeingDeleted) /* 226 */ +/* Slot 226 is reserved */ #define TclSetNsPath \ (tclIntStubsPtr->tclSetNsPath) /* 227 */ /* Slot 228 is reserved */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d5d43ed..7520478 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1133,7 +1133,7 @@ Tcl_CreateAlias( int i; int result; - objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc); + objv = ckalloc((unsigned) sizeof(Tcl_Obj *) * argc); for (i = 0; i < argc; i++) { objv[i] = Tcl_NewStringObj(argv[i], -1); Tcl_IncrRefCount(objv[i]); @@ -1151,7 +1151,7 @@ Tcl_CreateAlias( for (i = 0; i < argc; i++) { Tcl_DecrRefCount(objv[i]); } - TclStackFree(slaveInterp, objv); + ckfree(objv); Tcl_DecrRefCount(targetObjPtr); Tcl_DecrRefCount(slaveObjPtr); @@ -1831,7 +1831,7 @@ AliasObjCmd( if (cmdc <= ALIAS_CMDV_PREALLOC) { cmdv = cmdArr; } else { - cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); + cmdv = ckalloc(cmdc * sizeof(Tcl_Obj *)); } prefv = &aliasPtr->objPtr; @@ -1898,7 +1898,7 @@ AliasObjCmd( Tcl_DecrRefCount(cmdv[i]); } if (cmdv != cmdArr) { - TclStackFree(interp, cmdv); + ckfree(cmdv); } return result; #undef ALIAS_CMDV_PREALLOC diff --git a/generic/tclListObj.c b/generic/tclListObj.c index bd2dbc4..fccec0a 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -73,6 +73,12 @@ const Tcl_ObjType tclListType = { *---------------------------------------------------------------------- */ +#define Elems2Size(n) \ + (sizeof(List) - sizeof(Tcl_Obj *) + n*sizeof(Tcl_Obj *)) + +#define Size2Elems(s) \ + (s - (sizeof(List) - sizeof(Tcl_Obj *)))/sizeof(Tcl_Obj *) + static List * NewListIntRep( int objc, @@ -588,6 +594,7 @@ Tcl_ListObjAppendElement( listRepPtr = ListRepPtr(listPtr); numElems = listRepPtr->elemCount; numRequired = numElems + 1 ; + needGrow = (numRequired > listRepPtr->maxElemCount); isShared = (listRepPtr->refCount > 1); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 304487b..c529ff3 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -465,7 +465,7 @@ TclPushStackFrame( * treated as references to namespace * variables. */ { - *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame)); + *framePtrPtr = ckalloc(sizeof(CallFrame)); return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr, isProcCallFrame); } @@ -477,7 +477,7 @@ TclPopStackFrame( CallFrame *freePtr = ((Interp *) interp)->framePtr; Tcl_PopCallFrame(interp); - TclStackFree(interp, freePtr); + ckfree(freePtr); } /* @@ -2641,8 +2641,7 @@ TclResetShadowedCmdRefs( int found, i; int trailFront = -1; int trailSize = 5; /* Formerly NUM_TRAIL_ELEMS. */ - Namespace **trailPtr = TclStackAlloc(interp, - trailSize * sizeof(Namespace *)); + Namespace **trailPtr = ckalloc(trailSize * sizeof(Namespace *)); /* * Start at the namespace containing the new command, and work up through @@ -2731,13 +2730,12 @@ TclResetShadowedCmdRefs( if (trailFront == trailSize) { int newSize = 2 * trailSize; - trailPtr = TclStackRealloc(interp, trailPtr, - newSize * sizeof(Namespace *)); + trailPtr = ckrealloc(trailPtr, newSize * sizeof(Namespace *)); trailSize = newSize; } trailPtr[trailFront] = nsPtr; } - TclStackFree(interp, trailPtr); + ckfree(trailPtr); } /* @@ -3978,8 +3976,7 @@ NamespacePathCmd( goto badNamespace; } if (nsObjc != 0) { - namespaceList = TclStackAlloc(interp, - sizeof(Tcl_Namespace *) * nsObjc); + namespaceList = ckalloc(sizeof(Tcl_Namespace *) * nsObjc); for (i=0 ; i<nsObjc ; i++) { if (TclGetNamespaceFromObj(interp, nsObjv[i], @@ -3998,7 +3995,7 @@ NamespacePathCmd( result = TCL_OK; badNamespace: if (namespaceList != NULL) { - TclStackFree(interp, namespaceList); + ckfree(namespaceList); } return result; } diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 26fd09f..c595669 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -105,7 +105,7 @@ TclOODeleteContext( TclOODeleteChain(contextPtr->callPtr); if (oPtr != NULL) { - TclStackFree(oPtr->fPtr->interp, contextPtr); + ckfree(contextPtr); DelRef(oPtr); } } @@ -1104,7 +1104,7 @@ TclOOGetCallContext( } returnContext: - contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext)); + contextPtr = ckalloc(sizeof(CallContext)); contextPtr->oPtr = oPtr; AddRef(oPtr); contextPtr->callPtr = callPtr; @@ -1445,7 +1445,7 @@ TclOORenderCallChain( * method (or "object" if it is declared on the instance). */ - objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); + objv = ckalloc(callPtr->numChain * sizeof(Tcl_Obj *)); for (i=0 ; i<callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; @@ -1482,7 +1482,7 @@ TclOORenderCallChain( */ resultObj = Tcl_NewListObj(callPtr->numChain, objv); - TclStackFree(interp, objv); + ckfree(objv); return resultObj; } diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index bacab38..5bfb40e 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -545,7 +545,7 @@ TclOOUnknownDefinition( * Got one match, and only one match! */ - Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1)); + Tcl_Obj **newObjv = ckalloc(sizeof(Tcl_Obj*)*(objc-1)); int result; newObjv[0] = Tcl_NewStringObj(matchedStr, -1); @@ -555,7 +555,7 @@ TclOOUnknownDefinition( } result = Tcl_EvalObjv(interp, objc-1, newObjv, 0); Tcl_DecrRefCount(newObjv[0]); - TclStackFree(interp, newObjv); + ckfree(newObjv); return result; } @@ -1653,7 +1653,7 @@ TclOODefineMixinObjCmd( Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } - mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1)); + mixins = ckalloc(sizeof(Class *) * (objc-1)); for (i=1 ; i<objc ; i++) { Class *clsPtr = GetClassInOuterContext(interp, objv[i], @@ -1677,11 +1677,11 @@ TclOODefineMixinObjCmd( TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins); } - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_OK; freeAndError: - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_ERROR; } @@ -2090,7 +2090,7 @@ ClassMixinSet( return TCL_ERROR; } - mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); + mixins = ckalloc(sizeof(Class *) * mixinc); for (i=0 ; i<mixinc ; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], @@ -2107,11 +2107,11 @@ ClassMixinSet( } TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_OK; freeAndError: - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_ERROR; } @@ -2531,19 +2531,19 @@ ObjMixinSet( return TCL_ERROR; } - mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc); + mixins = ckalloc(sizeof(Class *) * mixinc); for (i=0 ; i<mixinc ; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_ERROR; } } TclOOObjectSetMixins(oPtr, mixinc, mixins); - TclStackFree(interp, mixins); + ckfree(mixins); return TCL_OK; } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 98b4078..44e0128 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -686,7 +686,7 @@ InvokeProcedureMethod( * Allocate the special frame data. */ - fdPtr = TclStackAlloc(interp, sizeof(PMFrameData)); + fdPtr = ckalloc(sizeof(PMFrameData)); /* * Create a call frame for this method. @@ -695,7 +695,7 @@ InvokeProcedureMethod( result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr, objc, objv, fdPtr); if (result != TCL_OK) { - TclStackFree(interp, fdPtr); + ckfree(fdPtr); return result; } pmPtr->refCount++; @@ -719,11 +719,11 @@ InvokeProcedureMethod( pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; Tcl_PopCallFrame(interp); - TclStackFree(interp, fdPtr->framePtr); + ckfree(fdPtr->framePtr); if (--pmPtr->refCount < 1) { DeleteProcedureMethodRecord(pmPtr); } - TclStackFree(interp, fdPtr); + ckfree(fdPtr); return result; } } @@ -774,7 +774,7 @@ FinalizePMCall( if (--pmPtr->refCount < 1) { DeleteProcedureMethodRecord(pmPtr); } - TclStackFree(interp, fdPtr); + ckfree(fdPtr); return result; } @@ -1440,7 +1440,7 @@ FinalizeForwardCall( { Tcl_Obj **argObjs = data[0]; - TclStackFree(interp, argObjs); + ckfree(argObjs); return result; } @@ -1569,7 +1569,7 @@ InitEnsembleRewrite( Tcl_Obj **argObjs; unsigned len = rewriteLength + objc - toRewrite; - argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len); + argObjs = ckalloc(sizeof(Tcl_Obj *) * len); memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *)); memcpy(argObjs + rewriteLength, objv + toRewrite, sizeof(Tcl_Obj *) * (objc - toRewrite)); diff --git a/generic/tclObj.c b/generic/tclObj.c index f2ec565..79f7bb5 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -26,20 +26,8 @@ static Tcl_HashTable typeTable; static int typeTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(tableMutex) -/* - * Head of the list of free Tcl_Obj structs we maintain. - */ - -Tcl_Obj *tclFreeObjList = NULL; - -/* - * The object allocator is single threaded. This mutex is referenced by the - * TclNewObj macro, however, so must be visible. - */ - -#ifdef TCL_THREADS -MODULE_SCOPE Tcl_Mutex tclObjMutex; -Tcl_Mutex tclObjMutex; +#if (defined(TCL_THREADS) && TCL_MEM_DEBUG) +static Tcl_Mutex tclObjMutex; #endif /* @@ -498,15 +486,6 @@ TclFinalizeObjects(void) typeTableInitialized = 0; } Tcl_MutexUnlock(&tableMutex); - - /* - * All we do here is reset the head pointer of the linked list of free - * Tcl_Obj's to NULL; the memory finalization will take care of releasing - * memory for us. - */ - Tcl_MutexLock(&tclObjMutex); - tclFreeObjList = NULL; - Tcl_MutexUnlock(&tclObjMutex); } /* @@ -1241,59 +1220,6 @@ Tcl_DbNewObj( /* *---------------------------------------------------------------------- * - * TclAllocateFreeObjects -- - * - * Function to allocate a number of free Tcl_Objs. This is done using a - * single ckalloc to reduce the overhead for Tcl_Obj allocation. - * - * Assumes mutex is held. - * - * Results: - * None. - * - * Side effects: - * tclFreeObjList, the head of the list of free Tcl_Objs, is set to the - * first of a number of free Tcl_Obj's linked together by their - * internalRep.twoPtrValue.ptr1's. - * - *---------------------------------------------------------------------- - */ - -#define OBJS_TO_ALLOC_EACH_TIME 100 - -void -TclAllocateFreeObjects(void) -{ - size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj)); - char *basePtr; - register Tcl_Obj *prevPtr, *objPtr; - register int i; - - /* - * This has been noted by Purify to be a potential leak. The problem is - * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated - * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually - * freeing the memory. TclFinalizeObjects() does not ckfree() this memory, - * but leaves it to Tcl's memory subsystem finalization to release it. - * Purify apparently can't figure that out, and fires a false alarm. - */ - - basePtr = ckalloc(bytesToAlloc); - - prevPtr = NULL; - objPtr = (Tcl_Obj *) basePtr; - for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) { - objPtr->internalRep.twoPtrValue.ptr1 = prevPtr; - prevPtr = objPtr; - objPtr++; - } - tclFreeObjList = prevPtr; -} -#undef OBJS_TO_ALLOC_EACH_TIME - -/* - *---------------------------------------------------------------------- - * * TclFreeObj -- * * This function frees the memory associated with the argument object. @@ -1339,7 +1265,6 @@ TclFreeObj( */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; if (ObjDeletePending(context)) { PushObjToDelete(context, objPtr); @@ -1407,7 +1332,6 @@ TclFreeObj( */ TclInvalidateStringRep(objPtr); - objPtr->length = -1; if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) { /* @@ -1490,31 +1414,6 @@ TclFreeObj( /* *---------------------------------------------------------------------- * - * TclObjBeingDeleted -- - * - * This function returns 1 when the Tcl_Obj is being deleted. It is - * provided for the rare cases where the reason for the loss of an - * internal rep might be relevant. [FR 1512138] - * - * Results: - * 1 if being deleted, 0 otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclObjBeingDeleted( - Tcl_Obj *objPtr) -{ - return (objPtr->length == -1); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_DuplicateObj -- * * Create and return a new object that is a duplicate of the argument diff --git a/generic/tclParse.c b/generic/tclParse.c index 08615a7..c99621f 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1149,14 +1149,14 @@ ParseTokens( src++; numBytes--; - nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse)); + nestedPtr = ckalloc(sizeof(Tcl_Parse)); while (1) { if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1, nestedPtr) != TCL_OK) { parsePtr->errorType = nestedPtr->errorType; parsePtr->term = nestedPtr->term; parsePtr->incomplete = nestedPtr->incomplete; - TclStackFree(parsePtr->interp, nestedPtr); + ckfree(nestedPtr); return TCL_ERROR; } src = nestedPtr->commandStart + nestedPtr->commandSize; @@ -1182,11 +1182,11 @@ ParseTokens( parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; parsePtr->incomplete = 1; - TclStackFree(parsePtr->interp, nestedPtr); + ckfree(nestedPtr); return TCL_ERROR; } } - TclStackFree(parsePtr->interp, nestedPtr); + ckfree(nestedPtr); tokenPtr->type = TCL_TOKEN_COMMAND; tokenPtr->size = src - tokenPtr->start; parsePtr->numTokens++; @@ -1546,10 +1546,10 @@ Tcl_ParseVar( { register Tcl_Obj *objPtr; int code; - Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) { - TclStackFree(interp, parsePtr); + ckfree(parsePtr); return NULL; } @@ -1561,13 +1561,13 @@ Tcl_ParseVar( * There isn't a variable name after all: the $ is just a $. */ - TclStackFree(interp, parsePtr); + ckfree(parsePtr); return "$"; } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1, NULL, NULL); - TclStackFree(interp, parsePtr); + ckfree(parsePtr); if (code != TCL_OK) { return NULL; } @@ -2030,7 +2030,7 @@ TclSubstParse( Tcl_Token *tokenPtr; const char *lastTerm = parsePtr->term; Tcl_Parse *nestedPtr = - TclStackAlloc(interp, sizeof(Tcl_Parse)); + ckalloc(sizeof(Tcl_Parse)); while (TCL_OK == Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) { @@ -2048,7 +2048,7 @@ TclSubstParse( } lastTerm = nestedPtr->term; } - TclStackFree(interp, nestedPtr); + ckfree(nestedPtr); if (lastTerm == parsePtr->term) { /* diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c index 0bd8f93..61e5518 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -15,6 +15,11 @@ #include "tclInt.h" /* + * Only use this file if we are NOT using the new code in tclAlloc.c + */ + + +/* * The following data structure is used to keep track of all the Tcl_Preserve * calls that are still in effect. It grows as needed to accommodate any * number of calls in effect. @@ -45,27 +50,6 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ #define INITIAL_SIZE 2 /* Initial number of reference slots to make */ -/* - * The following data structure is used to keep track of whether an arbitrary - * block of memory has been deleted. This is used by the TclHandle code to - * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism - * is mainly used when we have lots of references to a few big, expensive - * objects that we don't want to live any longer than necessary. - */ - -typedef struct HandleStruct { - void *ptr; /* Pointer to the memory block being tracked. - * This field will become NULL when the memory - * block is deleted. This field must be the - * first in the structure. */ -#ifdef TCL_MEM_DEBUG - void *ptr2; /* Backup copy of the above pointer used to - * ensure that the contents of the handle are - * not changed by anyone else. */ -#endif - int refCount; /* Number of TclHandlePreserve() calls in - * effect on this handle. */ -} HandleStruct; /* *---------------------------------------------------------------------- @@ -298,6 +282,28 @@ Tcl_EventuallyFree( } /* + * The following data structure is used to keep track of whether an arbitrary + * block of memory has been deleted. This is used by the TclHandle code to + * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism + * is mainly used when we have lots of references to a few big, expensive + * objects that we don't want to live any longer than necessary. + */ + +typedef struct HandleStruct { + void *ptr; /* Pointer to the memory block being tracked. + * This field will become NULL when the memory + * block is deleted. This field must be the + * first in the structure. */ +#ifdef TCL_MEM_DEBUG + void *ptr2; /* Backup copy of the above pointer used to + * ensure that the contents of the handle are + * not changed by anyone else. */ +#endif + int refCount; /* Number of TclHandlePreserve() calls in + * effect on this handle. */ +} HandleStruct; + +/* *--------------------------------------------------------------------------- * * TclHandleCreate -- diff --git a/generic/tclProc.c b/generic/tclProc.c index e66b8ea..edb9b50 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -227,7 +227,7 @@ Tcl_ProcObjCmd( */ if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *contextPtr = ckalloc(sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { @@ -305,7 +305,7 @@ Tcl_ProcObjCmd( Tcl_DecrRefCount(contextPtr->data.eval.path); contextPtr->data.eval.path = NULL; } - TclStackFree(interp, contextPtr); + ckfree(contextPtr); } /* @@ -1117,8 +1117,7 @@ ProcWrongNumArgs( */ numArgs = framePtr->procPtr->numArgs; - desiredObjs = TclStackAlloc(interp, - (int) sizeof(Tcl_Obj *) * (numArgs+1)); + desiredObjs = ckalloc((int) sizeof(Tcl_Obj *) * (numArgs+1)); if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); @@ -1158,7 +1157,7 @@ ProcWrongNumArgs( for (i=0 ; i<=numArgs ; i++) { Tcl_DecrRefCount(desiredObjs[i]); } - TclStackFree(interp, desiredObjs); + ckfree(desiredObjs); return TCL_ERROR; } @@ -1472,7 +1471,7 @@ InitArgsAndLocals( * parameters. */ - varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var))); + varPtr = ckalloc((int)(localCt * sizeof(Var))); framePtr->compiledLocals = varPtr; framePtr->numCompiledLocals = localCt; @@ -1763,9 +1762,9 @@ TclNRInterpProcCore( if (result != TCL_OK) { freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ - TclStackFree(interp, freePtr->compiledLocals); + ckfree(freePtr->compiledLocals); /* Free compiledLocals. */ - TclStackFree(interp, freePtr); /* Free CallFrame. */ + ckfree(freePtr); /* Free CallFrame. */ return TCL_ERROR; } @@ -1935,9 +1934,9 @@ InterpProcNR2( freePtr = iPtr->framePtr; Tcl_PopCallFrame(interp); /* Pop but do not free. */ - TclStackFree(interp, freePtr->compiledLocals); + ckfree(freePtr->compiledLocals); /* Free compiledLocals. */ - TclStackFree(interp, freePtr); /* Free CallFrame. */ + ckfree(freePtr); /* Free CallFrame. */ return result; } @@ -2553,7 +2552,7 @@ SetLambdaFromAny( */ if (iPtr->cmdFramePtr) { - CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *contextPtr = ckalloc(sizeof(CmdFrame)); *contextPtr = *iPtr->cmdFramePtr; if (contextPtr->type == TCL_LOCATION_BC) { @@ -2614,7 +2613,7 @@ SetLambdaFromAny( Tcl_DecrRefCount(contextPtr->data.eval.path); } - TclStackFree(interp, contextPtr); + ckfree(contextPtr); } Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, &isNew), cfPtr); @@ -2752,7 +2751,7 @@ TclNRApplyObjCmd( return TCL_ERROR; } - extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData)); + extraPtr = ckalloc(sizeof(ApplyExtraData)); memset(&extraPtr->cmd, 0, sizeof(Command)); procPtr->cmdPtr = &extraPtr->cmd; extraPtr->cmd.nsPtr = (Namespace *) nsPtr; @@ -2803,7 +2802,7 @@ ApplyNR2( ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL; } - TclStackFree(interp, extraPtr); + ckfree(extraPtr); return result; } diff --git a/generic/tclScan.c b/generic/tclScan.c index ef7eedf..9b1f40a 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -259,7 +259,7 @@ ValidateFormat( char *end; Tcl_UniChar ch; int objIndex, xpgSize, nspace = numVars; - int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); + int *nassign = ckalloc(nspace * sizeof(int)); char buf[TCL_UTF_MAX+1]; Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do @@ -480,8 +480,7 @@ ValidateFormat( } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } - nassign = TclStackRealloc(interp, nassign, - nspace * sizeof(int)); + nassign = ckrealloc(nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; } @@ -526,7 +525,7 @@ ValidateFormat( } } - TclStackFree(interp, nassign); + ckfree(nassign); return TCL_OK; badIndex: @@ -542,7 +541,7 @@ ValidateFormat( } error: - TclStackFree(interp, nassign); + ckfree(nassign); return TCL_ERROR; } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1dbdc09..ce34c2f 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -218,7 +218,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 0 */ 0, /* 1 */ 0, /* 2 */ - TclAllocateFreeObjects, /* 3 */ + 0, /* 3 */ 0, /* 4 */ TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ @@ -284,19 +284,19 @@ static const TclIntStubs tclIntStubs = { 0, /* 66 */ 0, /* 67 */ 0, /* 68 */ - TclpAlloc, /* 69 */ + 0, /* 69 */ 0, /* 70 */ 0, /* 71 */ 0, /* 72 */ 0, /* 73 */ - TclpFree, /* 74 */ + 0, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ TclpGetTime, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ - TclpRealloc, /* 81 */ + 0, /* 81 */ 0, /* 82 */ 0, /* 83 */ 0, /* 84 */ @@ -430,8 +430,8 @@ static const TclIntStubs tclIntStubs = { TclpFindExecutable, /* 212 */ TclGetObjNameOfExecutable, /* 213 */ TclSetObjNameOfExecutable, /* 214 */ - TclStackAlloc, /* 215 */ - TclStackFree, /* 216 */ + 0, /* 215 */ + 0, /* 216 */ TclPushStackFrame, /* 217 */ TclPopStackFrame, /* 218 */ 0, /* 219 */ @@ -441,7 +441,7 @@ static const TclIntStubs tclIntStubs = { 0, /* 223 */ TclGetPlatform, /* 224 */ TclTraceDictPath, /* 225 */ - TclObjBeingDeleted, /* 226 */ + 0, /* 226 */ TclSetNsPath, /* 227 */ 0, /* 228 */ TclPtrMakeUpvar, /* 229 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..04d8ce5 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -6784,7 +6784,7 @@ TestNRELevels( Interp *iPtr = (Interp *) interp; static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; - Tcl_Obj *levels[6]; + Tcl_Obj *levels[5]; int i = 0; NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr; @@ -6798,16 +6798,14 @@ TestNRELevels( levels[1] = Tcl_NewIntObj(iPtr->numLevels); levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level); levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); - levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr - - iPtr->execEnvPtr->execStackPtr->stackWords); while (cbPtr) { i++; cbPtr = cbPtr->nextPtr; } - levels[5] = Tcl_NewIntObj(i); + levels[4] = Tcl_NewIntObj(i); - Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); + Tcl_SetObjResult(interp, Tcl_NewListObj(5, levels)); return TCL_OK; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 0f297a4..a8bb92d 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1679,7 +1679,7 @@ CallTraceFunction( * Copy the command characters into a new string. */ - commandCopy = TclStackAlloc(interp, (unsigned) numChars + 1); + commandCopy = ckalloc((unsigned) numChars + 1); memcpy(commandCopy, command, (size_t) numChars); commandCopy[numChars] = '\0'; @@ -1690,7 +1690,7 @@ CallTraceFunction( traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr, iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv); - TclStackFree(interp, commandCopy); + ckfree(commandCopy); return traceCode; } @@ -2267,7 +2267,7 @@ StringTraceProc( * which uses strings for everything. */ - argv = (const char **) TclStackAlloc(interp, + argv = (const char **) ckalloc( (unsigned) ((objc + 1) * sizeof(const char *))); for (i = 0; i < objc; i++) { argv[i] = Tcl_GetString(objv[i]); @@ -2282,7 +2282,7 @@ StringTraceProc( data->proc(data->clientData, interp, level, (char *) command, cmdPtr->proc, cmdPtr->clientData, objc, argv); - TclStackFree(interp, (void *) argv); + ckfree((void *) argv); return TCL_OK; } diff --git a/normBench b/normBench new file mode 100644 index 0000000..208c294 --- /dev/null +++ b/normBench @@ -0,0 +1,666 @@ +TCL_INTERP: 1:8.6b1.2 2:8.6b1.2 3:8.6b1.2 4:8.6b1.2 5:8.6b1.2 6:8.6b1.2 7:8.6b1.2 8:8.5.9 +STARTED 2011-03-28 10:53:26 (runbench.tcl v1.30) +Benchmark 1:8.6b1.2 /home/mig/tcl/branch.base/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:12 elapsed +Benchmark 2:8.6b1.2 /home/mig/tcl/branch.multi/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:08 elapsed +Benchmark 3:8.6b1.2 /home/mig/tcl/branch.native/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:13 elapsed +Benchmark 4:8.6b1.2 /home/mig/tcl/branch.tsd/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:08 elapsed +Benchmark 5:8.6b1.2 /home/mig/tcl/no280.tsd/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:07 elapsed +Benchmark 6:8.6b1.2 /home/mig/tcl/trunk.base/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:10 elapsed +Benchmark 7:8.6b1.2 /home/mig/tcl/trunk.tsd/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:07 elapsed +Benchmark 8:8.5.9 /home/mig/tcl/core8.5/unix/tclsh +aabbccdeeefffghkllmmmmnpprrssstuuvw 00:01:09 elapsed +R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 +000 VERSIONS: 1:8.6b1.2 2:8.6b1.2 3:8.6b1.2 4:8.6b1.2 5:8.6b1.2 6:8.6b1.2 7:8.6b1.2 8:8.5.9 +001 ARRAY format genKeys 50 0.94 0.79 0.96 0.87 0.77 0.91 0.82 1.00 +002 ARRAY format genKeys 500 0.92 0.80 0.95 0.87 0.77 0.91 0.82 1.00 +003 ARRAY makeHash 500 50 0.93 0.89 0.79 0.89 0.83 0.95 0.90 1.00 +004 ascii85 strlen 2690 1.00 0.95 1.00 0.93 0.94 0.94 0.92 1.00 +005 ascii85 strlen 269000 0.97 0.94 0.97 0.91 0.92 0.93 0.90 1.00 +006 BASE64 decode 10 1.04 0.95 1.04 0.96 0.88 1.03 0.95 1.00 +007 BASE64 decode 100 1.07 0.95 1.05 0.99 0.89 1.05 0.96 1.00 +008 BASE64 decode 1000 1.08 0.96 1.05 0.99 0.89 1.04 0.98 1.00 +009 BASE64 decode 10000 1.06 0.98 1.03 0.98 0.89 1.04 0.96 1.00 +010 BASE64 decode2 10 1.05 0.95 1.05 0.97 0.88 1.02 0.95 1.00 +011 BASE64 decode2 100 1.07 0.99 1.05 1.00 0.89 1.06 0.98 1.00 +012 BASE64 decode2 1000 1.06 0.99 1.04 1.00 0.90 1.05 0.98 1.00 +013 BASE64 decode2 10000 1.05 0.98 1.03 0.99 0.89 1.03 0.96 1.00 +014 BASE64 decode3 10 1.07 1.00 1.07 0.99 0.90 1.04 0.97 1.00 +015 BASE64 decode3 100 1.04 0.99 1.03 0.96 0.89 1.03 0.97 1.00 +016 BASE64 decode3 1000 1.02 1.00 1.02 0.96 0.90 1.03 0.97 1.00 +017 BASE64 decode3 10000 1.02 1.00 1.02 0.95 0.91 1.03 0.98 1.00 +018 BASE64 encode 10 1.07 1.00 1.09 1.06 0.97 1.05 1.02 1.00 +019 BASE64 encode 100 1.07 1.02 1.05 1.08 1.00 1.04 1.03 1.00 +020 BASE64 encode 1000 1.07 1.04 1.05 1.08 1.00 1.05 1.04 1.00 +021 BASE64 encode 10000 1.07 1.04 1.06 1.09 1.00 1.05 1.04 1.00 +022 BASE64 encode2 10 1.08 1.02 1.09 1.06 0.95 1.06 1.02 1.00 +023 BASE64 encode2 100 1.09 1.07 1.07 1.11 1.02 1.09 1.07 1.00 +024 BASE64 encode2 1000 1.10 1.07 1.07 1.11 1.02 1.09 1.07 1.00 +025 BASE64 encode2 10000 1.10 1.08 1.07 1.15 1.02 1.09 1.08 1.00 +026 BASE64 encode3 10 1.07 0.99 1.09 1.00 0.94 1.03 0.97 1.00 +027 BASE64 encode3 100 1.06 1.04 1.07 1.04 0.99 1.05 1.00 1.00 +028 BASE64 encode3 1000 1.06 1.03 1.04 1.04 0.99 1.04 1.01 1.00 +029 BASE64 encode3 10000 1.07 1.03 1.04 1.07 0.99 1.05 1.03 1.00 +030 BIN bitset-v1 1000 chars 1.60 1.46 1.44 1.41 1.31 1.43 1.31 1.00 +031 BIN bitset-v1 5000 chars 1.62 1.50 1.44 1.44 1.31 1.41 1.35 1.00 +032 BIN bitset-v1 10000 chars 1.62 1.50 1.44 1.44 1.32 1.43 1.33 1.00 +033 BIN bitset-v2 1000 chars 1.31 1.19 1.19 1.18 1.08 1.15 1.10 1.00 +034 BIN bitset-v2 5000 chars 1.29 1.18 1.15 1.18 1.07 1.14 1.09 1.00 +035 BIN bitset-v2 10000 chars 1.29 1.17 1.15 1.18 1.07 1.13 1.08 1.00 +036 BIN bitset-v3 1000 chars 0.88 0.81 0.86 0.83 0.65 0.88 0.82 1.00 +037 BIN bitset-v3 5000 chars 0.88 0.80 0.84 0.83 0.65 0.86 0.80 1.00 +038 BIN bitset-v3 10000 chars 0.88 0.80 0.83 0.83 0.65 0.87 0.83 1.00 +039 BIN c scan, 1000b 0.93 0.88 1.04 0.88 0.81 0.95 0.90 1.00 +040 BIN c scan, 5000b 0.95 0.93 0.97 0.93 0.93 0.96 0.96 1.00 +041 BIN c scan, 10000b 0.96 0.96 1.00 0.94 0.96 0.96 0.96 1.00 +042 BIN chars, 10000b 0.87 0.80 0.82 0.81 0.72 0.87 0.81 1.00 +043 BIN rand string 100b 1.34 1.21 1.27 1.17 1.39 1.19 1.14 1.00 +044 BIN rand string 5000b 1.36 1.24 1.29 1.18 1.42 1.21 1.16 1.00 +045 BIN rand2 string 100b 1.24 1.14 1.06 1.13 1.29 1.08 1.05 1.00 +046 BIN rand2 string 5000b 1.24 1.14 1.04 1.13 1.36 1.07 1.05 1.00 +047 BIN u char, 10000b 0.94 0.94 0.97 0.95 0.97 0.99 0.97 1.00 +048 CATCH error, complex 1.08 0.98 1.15 0.96 0.92 1.04 0.98 1.00 +049 CATCH no catch used 1.41 1.19 1.44 1.16 1.27 1.11 1.06 1.00 +050 CATCH return error 1.07 0.96 1.13 0.95 0.92 1.04 0.96 1.00 +051 CATCH return except 1.39 1.20 1.44 1.18 1.26 1.11 1.06 1.00 +052 CATCH return ok 1.40 1.24 1.50 1.20 1.25 1.12 1.08 1.00 +053 DATA access in a list 1.08 1.08 1.13 1.02 1.06 1.09 1.13 1.00 +054 DATA access in an array 1.06 1.06 1.18 1.04 1.07 1.10 1.08 1.00 +055 DATA create in a list 1.04 1.02 1.01 0.99 0.79 1.02 1.04 1.00 +056 DATA create in an array 1.02 0.96 1.17 0.97 0.87 1.05 1.01 1.00 +057 ENC iso2022-jp, gets 1.12 1.00 0.99 1.00 1.04 1.10 0.95 1.00 +058 ENC iso2022-jp, read 1.12 1.00 0.97 0.99 0.93 1.06 0.91 1.00 +059 ENC iso2022-jp, read & size 0.96 0.86 0.83 0.86 0.80 0.90 0.79 1.00 +060 ENC iso8859-2, gets 0.37 0.35 0.39 0.35 0.35 0.36 0.34 1.00 +061 ENC iso8859-2, read 0.25 0.25 0.27 0.25 0.25 0.25 0.25 1.00 +062 ENC iso8859-2, read & size 0.28 0.27 0.30 0.28 0.27 0.28 0.27 1.00 +063 EVAL cmd and mixed lists 0.81 0.75 1.09 0.75 0.64 0.83 0.77 1.00 +064 EVAL cmd eval as list 1.46 1.24 1.42 1.22 1.06 1.24 1.10 1.00 +065 EVAL cmd eval as string 1.03 0.92 1.11 0.93 0.75 0.93 0.85 1.00 +066 EVAL cmd eval in list obj var 1.43 1.19 1.32 1.19 1.06 1.19 1.08 1.00 +067 EVAL cmd eval in list obj {*} 1.52 1.31 1.61 1.31 1.25 1.36 1.26 1.00 +068 EVAL list cmd and mixed lists 0.84 0.79 1.12 0.78 0.65 0.83 0.78 1.00 +069 EVAL list cmd and pure lists 1.01 0.89 0.99 0.98 0.93 0.91 1.01 1.00 +070 EXPR $a != $b dbl 1.60 1.43 1.83 1.45 1.40 1.38 1.38 1.00 +071 EXPR $a != $b int 1.55 1.32 1.68 1.35 1.30 1.25 1.20 1.00 +072 EXPR $a != $b str (!= len) 1.14 1.00 1.16 1.05 0.94 0.98 0.95 1.00 +073 EXPR $a != $b str (== len) 1.23 1.08 1.27 1.13 1.03 1.09 1.03 1.00 +074 EXPR $a == $b dbl 1.57 1.45 1.83 1.48 1.40 1.38 1.33 1.00 +075 EXPR $a == $b int 1.56 1.36 1.69 1.44 1.36 1.26 1.23 1.00 +076 EXPR $a == $b str (!= len) 1.15 1.01 1.16 1.07 0.97 0.95 0.98 1.00 +077 EXPR $a == $b str (== len) 1.27 1.10 1.26 1.15 1.06 1.06 1.05 1.00 +078 EXPR abs as expr 1.69 1.50 1.94 1.53 1.58 1.44 1.36 1.00 +079 EXPR abs builtin 1.67 1.44 1.81 1.47 1.51 1.37 1.28 1.00 +080 EXPR braced 1.42 1.26 1.40 1.23 1.36 1.25 1.16 1.00 +081 EXPR builtin dyn 1.11 1.03 1.25 1.00 0.80 1.04 0.98 1.00 +082 EXPR builtin sin 1.67 1.42 1.63 1.35 1.46 1.27 1.21 1.00 +083 EXPR cast double 1.68 1.38 1.79 1.40 1.51 1.32 1.26 1.00 +084 EXPR cast int 1.79 1.52 1.67 1.54 1.42 1.31 1.23 1.00 +085 EXPR fifty operands 1.05 0.96 1.15 0.94 0.96 0.95 0.92 1.00 +086 EXPR incr with expr 1.65 1.39 1.87 1.35 1.32 1.23 1.19 1.00 +087 EXPR incr with incr 1.71 1.43 1.93 1.43 1.39 1.32 1.25 1.00 +088 EXPR inline 1.28 1.21 1.18 1.21 1.22 1.21 1.13 1.00 +089 EXPR one operand 1.75 1.46 2.04 1.54 1.39 1.32 1.29 1.00 +090 EXPR rand range 1.71 1.49 1.61 1.49 1.58 1.34 1.28 1.00 +091 EXPR rand range func 1.77 1.47 1.67 1.48 1.48 1.31 1.24 1.00 +092 EXPR ten operands 1.33 1.18 1.53 1.16 1.14 1.12 1.04 1.00 +093 EXPR unbraced 1.03 0.97 1.25 0.95 0.81 0.98 0.96 1.00 +094 EXPR unbraced long 0.89 0.86 1.04 0.86 0.81 0.91 0.93 1.00 +095 EXPR UpdStrOfDbl+1.23 prec0 1.18 1.01 1.28 1.05 1.03 1.03 1.00 1.00 +096 EXPR UpdStrOfDbl+1.23 prec12 1.28 1.09 1.29 1.11 1.13 1.07 1.02 1.00 +097 EXPR UpdStrOfDbl+1.23 prec17 1.15 1.04 1.19 1.06 1.08 1.05 1.01 1.00 +098 EXPR UpdStrOfDbl+1e-4 prec0 1.15 1.00 1.22 1.01 1.05 1.03 0.98 1.00 +099 EXPR UpdStrOfDbl+1e-4 prec12 1.27 1.08 1.28 1.12 1.14 1.08 1.02 1.00 +100 EXPR UpdStrOfDbl+1e-4 prec17 1.14 1.01 1.17 1.06 1.06 1.04 0.98 1.00 +101 EXPR UpdStrOfDbl+1e27 prec0 0.98 0.89 1.14 0.88 0.91 0.93 0.87 1.00 +102 EXPR UpdStrOfDbl+1e27 prec12 1.29 1.10 1.31 1.10 1.11 1.08 1.00 1.00 +103 EXPR UpdStrOfDbl+1e27 prec17 0.99 0.90 1.14 0.89 0.92 0.98 0.92 1.00 +104 FCOPY binary: 160K 1.01 1.02 1.02 1.02 1.02 1.01 1.03 1.00 +105 FCOPY encoding: 160K 0.90 0.90 0.86 0.90 0.95 0.94 0.86 1.00 +106 FCOPY std: 160K 1.02 1.02 1.01 1.02 1.02 1.03 1.03 1.00 +107 FILE exec interp 1.08 1.06 1.15 1.08 1.61 1.13 1.07 1.00 +108 FILE exec interp: pkg require 1.04 1.03 1.10 1.03 1.20 1.05 1.03 1.00 +109 FILE exists tmpfile (obj) 1.29 1.23 1.23 1.25 1.16 1.19 1.18 1.00 +110 FILE exists ~ 1.32 1.20 1.23 1.24 1.15 1.18 1.15 1.00 +111 FILE exists! tmpfile (obj) 1.30 1.27 1.22 1.28 1.18 1.22 1.20 1.00 +112 FILE exists! tmpfile (str) 1.12 1.08 1.06 1.05 1.01 1.07 1.05 1.00 +113 FILE glob tmpdir (60 entries) 0.93 0.94 1.02 0.91 0.88 0.94 0.90 1.00 +114 FILE glob / all subcommands 1.07 1.04 1.07 1.05 1.00 1.07 1.02 1.00 +115 FILE glob / atime 1.02 0.98 1.02 0.97 0.91 0.98 0.94 1.00 +116 FILE glob / attributes 0.98 0.96 1.00 0.98 0.95 0.98 0.97 1.00 +117 FILE glob / dirname 1.25 1.20 1.28 1.19 1.10 1.23 1.13 1.00 +118 FILE glob / executable 1.03 0.98 1.01 0.97 0.92 0.99 0.96 1.00 +119 FILE glob / exists 1.04 1.00 1.04 0.99 0.93 1.01 0.98 1.00 +120 FILE glob / extension 1.19 1.14 1.26 1.12 1.05 1.20 1.06 1.00 +121 FILE glob / isdirectory 1.06 1.01 1.06 1.01 0.93 1.02 0.98 1.00 +122 FILE glob / isfile 1.05 1.02 1.06 1.00 0.93 1.01 0.98 1.00 +123 FILE glob / mtime 1.05 1.01 1.08 1.00 0.93 1.05 0.99 1.00 +124 FILE glob / owned 1.05 1.00 1.07 1.00 0.92 1.03 0.98 1.00 +125 FILE glob / readable 1.03 1.00 1.05 0.99 0.93 1.00 0.97 1.00 +126 FILE glob / rootname 1.19 1.13 1.23 1.11 1.04 1.18 1.06 1.00 +127 FILE glob / size 1.02 1.01 1.05 0.99 0.93 1.00 0.96 1.00 +128 FILE glob / tail 1.25 1.20 1.29 1.19 1.11 1.25 1.12 1.00 +129 FILE glob / writable 1.02 1.02 1.05 0.99 0.93 1.01 0.97 1.00 +130 FILE recurse / -dir 1.03 1.01 1.10 0.99 0.95 1.04 0.98 1.00 +131 FILE recurse / cd 1.06 1.03 1.13 1.03 0.99 1.07 1.01 1.00 +132 FORMAT gen 1.16 0.98 1.26 0.99 0.98 1.02 0.97 1.00 +133 GCCont_cpb::cGCC 50 0.93 0.90 0.92 0.88 0.76 0.92 0.85 1.00 +134 GCCont_cpb::cGCC 500 0.89 0.89 0.83 0.88 0.73 0.90 0.84 1.00 +135 GCCont_cpb::cGCC 5000 0.87 0.86 0.80 0.86 0.71 0.88 0.81 1.00 +136 GCCont_cpbre1::cGCC 50 1.03 1.01 0.97 1.00 0.94 1.02 1.00 1.00 +137 GCCont_cpbre1::cGCC 500 1.02 1.02 0.97 1.00 0.98 1.01 1.00 1.00 +138 GCCont_cpbre1::cGCC 5000 1.02 1.01 0.97 0.99 0.99 0.99 0.99 1.00 +139 GCCont_cpbre2::cGCC 50 1.02 1.00 0.97 0.97 0.94 0.99 0.96 1.00 +140 GCCont_cpbre2::cGCC 500 1.03 1.03 0.98 0.99 1.00 1.00 0.99 1.00 +141 GCCont_cpbre2::cGCC 5000 1.02 1.03 0.98 0.99 1.00 1.00 1.00 1.00 +142 GCCont_cpbrs2::cGCC 50 0.97 0.91 0.98 0.89 0.83 0.91 0.84 1.00 +143 GCCont_cpbrs2::cGCC 500 0.83 0.83 0.86 0.83 0.81 0.81 0.82 1.00 +144 GCCont_cpbrs2::cGCC 5000 0.80 0.81 0.80 0.81 0.81 0.78 0.82 1.00 +145 GCCont_cpbrs::cGCC1 50 0.99 0.96 0.98 0.92 0.88 0.98 0.96 1.00 +146 GCCont_cpbrs::cGCC1 500 0.89 0.88 0.89 0.87 0.85 0.87 0.88 1.00 +147 GCCont_cpbrs::cGCC1 5000 0.86 0.86 0.85 0.86 0.85 0.84 0.87 1.00 +148 GCCont_cpbrs::cGCC2 50 0.98 0.94 0.95 0.91 0.85 0.95 0.93 1.00 +149 GCCont_cpbrs::cGCC2 500 0.85 0.84 0.85 0.82 0.80 0.83 0.84 1.00 +150 GCCont_cpbrs::cGCC2 5000 0.80 0.80 0.80 0.80 0.80 0.78 0.81 1.00 +151 GCCont_cpbrs_trap::cGCC 50 1.01 0.99 0.98 0.97 0.94 1.04 0.99 1.00 +152 GCCont_cpbrs_trap::cGCC 500 1.01 1.01 0.97 0.98 0.97 1.03 0.98 1.00 +153 GCCont_cpbrs_trap::cGCC 5000 1.00 1.00 0.96 0.98 0.97 1.02 0.99 1.00 +154 GCCont_expr::cGCC 50 0.95 0.91 1.12 0.91 0.82 0.94 0.94 1.00 +155 GCCont_expr::cGCC 500 0.87 0.85 1.00 0.86 0.78 0.90 0.91 1.00 +156 GCCont_expr::cGCC 5000 0.87 0.86 0.95 0.86 0.78 0.90 0.93 1.00 +157 GCCont_i::cGCC1 50 0.95 0.92 0.94 0.91 0.83 0.97 0.90 1.00 +158 GCCont_i::cGCC1 500 0.92 0.89 0.91 0.88 0.81 0.95 0.95 1.00 +159 GCCont_i::cGCC1 5000 0.91 0.88 0.90 0.89 0.80 0.95 0.95 1.00 +160 GCCont_i::cGCC2 50 0.95 0.91 0.93 0.90 0.82 0.93 0.88 1.00 +161 GCCont_i::cGCC2 500 0.92 0.90 0.89 0.90 0.82 0.93 0.88 1.00 +162 GCCont_i::cGCC2 5000 0.92 0.90 0.89 0.90 0.81 0.94 0.88 1.00 +163 GCCont_i::cGCC3 50 0.95 0.88 0.93 0.87 0.79 0.94 0.87 1.00 +164 GCCont_i::cGCC3 500 0.90 0.84 0.88 0.84 0.77 0.92 0.86 1.00 +165 GCCont_i::cGCC3 5000 0.90 0.84 0.87 0.84 0.75 0.92 0.86 1.00 +166 GCCont_r1::cGCC 50 1.10 1.06 1.13 1.07 1.10 1.08 1.06 1.00 +167 GCCont_r1::cGCC 500 1.11 1.07 1.14 1.10 1.11 1.12 1.07 1.00 +168 GCCont_r1::cGCC 5000 1.12 1.07 1.14 1.10 1.11 1.11 1.08 1.00 +169 GCCont_r2::cGCC 50 1.02 0.96 1.04 0.97 0.89 1.02 0.95 1.00 +170 GCCont_r2::cGCC 500 0.99 0.95 1.03 0.96 0.92 1.02 1.01 1.00 +171 GCCont_r2::cGCC 5000 0.98 0.93 1.01 0.96 0.90 0.98 0.99 1.00 +172 GCCont_r3::cGCC 50 1.02 0.98 1.05 0.98 0.90 1.02 0.95 1.00 +173 GCCont_r3::cGCC 500 1.00 0.95 1.03 0.97 0.94 1.00 1.00 1.00 +174 GCCont_r3::cGCC 5000 0.98 0.94 1.01 0.96 0.92 1.00 1.00 1.00 +175 GCCont_rsf1::cGCC 50 0.94 0.88 0.94 0.87 0.78 0.94 0.89 1.00 +176 GCCont_rsf1::cGCC 500 0.88 0.82 0.85 0.82 0.73 0.89 0.84 1.00 +177 GCCont_rsf1::cGCC 5000 0.85 0.81 0.82 0.80 0.71 0.87 0.81 1.00 +178 GCCont_rsf2::cGCC1 50 0.98 0.93 0.98 0.91 0.84 0.98 0.92 1.00 +179 GCCont_rsf2::cGCC1 500 0.89 0.86 0.87 0.85 0.76 0.89 0.86 1.00 +180 GCCont_rsf2::cGCC1 5000 0.87 0.84 0.83 0.84 0.74 0.88 0.84 1.00 +181 GCCont_rsf2::cGCC2 50 0.99 0.93 1.01 0.91 0.84 0.96 0.91 1.00 +182 GCCont_rsf2::cGCC2 500 0.88 0.84 0.87 0.84 0.75 0.89 0.85 1.00 +183 GCCont_rsf2::cGCC2 5000 0.87 0.82 0.83 0.83 0.73 0.87 0.83 1.00 +184 GCCont_rsf3::cGCC 50 0.98 0.93 0.99 0.90 0.84 0.97 0.90 1.00 +185 GCCont_rsf3::cGCC 500 0.89 0.85 0.87 0.84 0.75 0.89 0.85 1.00 +186 GCCont_rsf3::cGCC 5000 0.87 0.81 0.83 0.83 0.73 0.87 0.83 1.00 +187 GCCont_turing::cGCC 50 0.90 0.85 0.93 0.85 0.80 0.82 0.80 1.00 +188 GCCont_turing::cGCC 500 0.72 0.70 0.72 0.71 0.69 0.70 0.70 1.00 +189 GCCont_turing::cGCC 5000 0.67 0.69 0.68 0.67 0.65 0.66 0.67 1.00 +190 HEAPSORT size 10 1.03 1.03 1.08 1.04 1.01 1.02 1.01 1.00 +191 HEAPSORT size 50 1.02 1.01 1.06 1.03 0.98 1.02 0.99 1.00 +192 HEAPSORT size 100 1.01 1.00 1.04 1.01 0.97 1.01 0.98 1.00 +193 HEAPSORT2 size 10 1.10 1.09 1.10 1.10 1.06 1.06 1.06 1.00 +194 HEAPSORT2 size 50 1.09 1.08 1.05 1.09 1.06 1.06 1.05 1.00 +195 HEAPSORT2 size 100 1.10 1.09 1.05 1.09 1.06 1.07 1.06 1.00 +196 IF 1/0 check 1.51 1.29 1.80 1.31 1.26 1.23 1.14 1.00 +197 IF else true al 1.41 1.24 1.48 1.31 1.24 1.23 1.20 1.00 +198 IF else true numeric 1.55 1.33 1.65 1.41 1.29 1.25 1.22 1.00 +199 IF elseif true al 1.32 1.22 1.39 1.24 1.20 1.15 1.15 1.00 +200 IF elseif true numeric 1.50 1.31 1.65 1.35 1.27 1.25 1.17 1.00 +201 IF if false al/al 1.50 1.29 1.57 1.34 1.30 1.23 1.21 1.00 +202 IF if false al/num 1.54 1.28 1.65 1.40 1.30 1.21 1.21 1.00 +203 IF if false num/num 1.55 1.32 1.84 1.41 1.30 1.23 1.20 1.00 +204 IF if true al 1.46 1.30 1.61 1.31 1.28 1.19 1.17 1.00 +205 IF if true al/al 1.46 1.29 1.57 1.29 1.25 1.14 1.14 1.00 +206 IF if true num/num 1.58 1.37 1.74 1.40 1.33 1.23 1.21 1.00 +207 IF if true numeric 1.57 1.40 1.86 1.45 1.33 1.26 1.24 1.00 +208 IF multi 1st true 1.55 1.32 1.75 1.39 1.32 1.27 1.25 1.00 +209 IF multi 2nd true 1.52 1.33 1.73 1.40 1.33 1.27 1.25 1.00 +210 IF multi 9th true 1.36 1.23 1.44 1.27 1.21 1.19 1.15 1.00 +211 IF multi default true 1.41 1.24 1.52 1.32 1.24 1.20 1.18 1.00 +212 KLIST shuffle0 llength 1 0.95 0.93 1.00 0.88 0.82 0.95 0.90 1.00 +213 KLIST shuffle0 llength 10 0.95 0.91 0.93 0.88 0.76 0.96 0.86 1.00 +214 KLIST shuffle0 llength 100 0.93 0.86 0.91 0.86 0.76 0.95 0.86 1.00 +215 KLIST shuffle0 llength 1000 0.94 0.88 0.92 0.88 0.79 0.95 0.88 1.00 +216 KLIST shuffle0 llength 10000 0.95 0.90 0.92 0.90 0.90 0.98 0.93 1.00 +217 KLIST shuffle1-s llength 1 1.36 1.23 1.34 1.19 1.22 1.13 1.09 1.00 +218 KLIST shuffle1-s llength 10 1.29 1.21 1.27 1.15 1.21 1.12 1.06 1.00 +219 KLIST shuffle1-s llength 100 1.15 1.10 1.28 1.06 1.10 1.12 0.99 1.00 +220 KLIST shuffle1-s llength 1000 1.02 1.00 1.11 1.01 0.95 1.01 0.91 1.00 +221 KLIST shuffle1a llength 1 1.48 1.33 1.53 1.29 1.35 1.21 1.15 1.00 +222 KLIST shuffle1a llength 10 1.54 1.38 1.55 1.35 1.44 1.25 1.19 1.00 +223 KLIST shuffle1a llength 100 1.56 1.37 1.56 1.35 1.45 1.26 1.20 1.00 +224 KLIST shuffle1a llength 1000 1.53 1.36 1.53 1.36 1.45 1.25 1.21 1.00 +225 KLIST shuffle1a llength 10000 1.54 1.37 1.56 1.37 1.46 1.26 1.22 1.00 +226 KLIST shuffle2 llength 1 1.24 1.14 1.26 1.13 1.13 1.06 1.05 1.00 +227 KLIST shuffle2 llength 10 1.22 1.12 1.24 1.12 1.13 1.09 1.08 1.00 +228 KLIST shuffle2 llength 100 1.24 1.13 1.26 1.13 1.14 1.11 1.10 1.00 +229 KLIST shuffle2 llength 1000 1.19 1.11 1.21 1.12 1.10 1.11 1.09 1.00 +230 KLIST shuffle2 llength 10000 1.16 1.10 1.12 1.09 1.08 1.08 1.07 1.00 +231 KLIST shuffle3 llength 1 1.42 1.29 1.43 1.25 1.24 1.15 1.09 1.00 +232 KLIST shuffle3 llength 10 1.54 1.37 1.50 1.38 1.47 1.24 1.20 1.00 +233 KLIST shuffle3 llength 100 1.55 1.38 1.49 1.39 1.49 1.25 1.21 1.00 +234 KLIST shuffle3 llength 1000 1.54 1.36 1.48 1.39 1.45 1.22 1.20 1.00 +235 KLIST shuffle3 llength 10000 1.24 1.17 1.24 1.18 1.22 1.09 1.05 1.00 +236 KLIST shuffle4 llength 1 1.36 1.23 1.38 1.21 1.21 1.13 1.07 1.00 +237 KLIST shuffle4 llength 10 1.52 1.36 1.48 1.34 1.43 1.24 1.19 1.00 +238 KLIST shuffle4 llength 100 1.54 1.38 1.50 1.38 1.47 1.25 1.21 1.00 +239 KLIST shuffle4 llength 1000 1.56 1.40 1.50 1.41 1.48 1.26 1.22 1.00 +240 KLIST shuffle4 llength 10000 1.55 1.37 1.46 1.36 1.47 1.26 1.21 1.00 +241 KLIST shuffle5-s llength 1 1.34 1.16 1.29 1.16 1.12 1.09 1.02 1.00 +242 KLIST shuffle5-s llength 10 1.30 1.21 1.28 1.14 1.19 1.09 1.04 1.00 +243 KLIST shuffle5-s llength 100 1.27 1.18 1.22 1.11 1.15 1.08 1.02 1.00 +244 KLIST shuffle5-s llength 1000 1.07 1.02 1.04 1.01 0.97 0.98 0.93 1.00 +245 KLIST shuffle5a llength 1 1.40 1.25 1.43 1.22 1.20 1.14 1.07 1.00 +246 KLIST shuffle5a llength 10 1.44 1.33 1.46 1.28 1.31 1.18 1.13 1.00 +247 KLIST shuffle5a llength 100 1.46 1.35 1.42 1.30 1.35 1.19 1.14 1.00 +248 KLIST shuffle5a llength 1000 1.45 1.34 1.46 1.29 1.34 1.20 1.16 1.00 +249 KLIST shuffle5a llength 10000 1.21 1.20 1.22 1.17 1.17 1.10 1.09 1.00 +250 KLIST shuffle6 llength 1 1.35 1.14 1.44 1.19 0.95 1.02 0.98 1.00 +251 KLIST shuffle6 llength 10 1.26 1.21 1.19 1.17 1.25 1.16 1.11 1.00 +252 KLIST shuffle6 llength 100 1.27 1.23 1.20 1.17 1.28 1.17 1.14 1.00 +253 KLIST shuffle6 llength 1000 1.26 1.22 1.20 1.19 1.29 1.17 1.15 1.00 +254 KLIST shuffle6 llength 10000 1.30 1.25 1.19 1.23 1.31 1.20 1.17 1.00 +255 LIST append to list 1.38 1.20 1.60 1.18 1.13 1.07 1.00 1.00 +256 LIST concat APPEND 2x10 0.94 0.82 1.08 0.82 0.69 0.92 0.84 1.00 +257 LIST concat APPEND 2x100 0.85 0.76 1.15 0.76 0.60 0.88 0.77 1.00 +258 LIST concat APPEND 2x1000 0.85 0.77 1.09 0.77 0.64 0.89 0.79 1.00 +259 LIST concat APPEND 2x10000 0.85 0.78 1.06 0.78 0.65 0.89 0.79 1.00 +260 LIST concat CONCAT 2x10 1.20 1.13 1.32 1.08 1.07 1.09 1.02 1.00 +261 LIST concat CONCAT 2x100 1.15 1.08 1.27 1.06 1.06 1.06 1.02 1.00 +262 LIST concat CONCAT 2x1000 0.99 1.01 0.99 0.97 0.97 0.96 0.99 1.00 +263 LIST concat CONCAT 2x10000 0.90 0.92 1.03 0.92 1.01 0.96 1.02 1.00 +264 LIST concat EVAL/LAPPEND 2x10 1.19 1.06 1.19 1.05 0.92 1.06 0.98 1.00 +265 LIST concat EVAL/LAPPEND 2x100 1.13 1.06 1.21 1.05 0.94 1.06 1.01 1.00 +266 LIST concat EVAL/LAPPEND 2x1000 1.13 1.10 0.99 1.11 1.00 1.11 1.14 1.00 +267 LIST concat EVAL/LAPPEND 2x10000 0.89 0.89 0.98 0.87 0.96 0.95 0.99 1.00 +268 LIST concat FOREACH/LAPPEND 2x10 0.97 0.90 0.93 0.88 0.75 0.91 0.84 1.00 +269 LIST concat FOREACH/LAPPEND 2x100 0.89 0.81 0.81 0.80 0.67 0.88 0.81 1.00 +270 LIST concat FOREACH/LAPPEND 2x1000 0.91 0.81 0.81 0.81 0.66 0.89 0.81 1.00 +271 LIST concat FOREACH/LAPPEND 2x10000 0.88 0.77 0.80 0.79 0.64 0.88 0.80 1.00 +272 LIST concat SET 2x10 0.91 0.82 1.06 0.80 0.67 0.92 0.82 1.00 +273 LIST concat SET 2x100 0.81 0.72 1.14 0.72 0.57 0.87 0.76 1.00 +274 LIST concat SET 2x1000 0.83 0.74 1.07 0.73 0.62 0.87 0.76 1.00 +275 LIST concat SET 2x10000 0.85 0.76 1.08 0.76 0.63 0.87 0.78 1.00 +276 LIST exact search, first item 1.76 1.38 1.64 1.44 1.40 1.36 1.24 1.00 +277 LIST exact search, last item 1.22 1.12 1.21 1.15 1.19 1.16 1.13 1.00 +278 LIST exact search, middle item 1.38 1.18 1.31 1.20 1.24 1.24 1.16 1.00 +279 LIST exact search, non-item 1.13 1.10 1.13 1.10 1.13 1.15 1.14 1.00 +280 LIST exact search, typed item 0.90 0.87 0.92 0.89 0.92 0.99 0.90 1.00 +281 LIST exact search, untyped item 1.21 1.11 1.20 1.12 1.16 1.13 1.10 1.00 +282 LIST index first element 1.69 1.31 1.82 1.31 1.28 1.33 1.18 1.00 +283 LIST index last element 1.64 1.28 1.90 1.31 1.28 1.31 1.18 1.00 +284 LIST index middle element 1.67 1.31 1.74 1.31 1.28 1.31 1.18 1.00 +285 LIST insert an item at "end" 0.96 0.94 0.98 0.86 1.02 0.99 0.89 1.00 +286 LIST insert an item at middle 0.94 0.93 0.96 0.85 1.00 0.98 0.88 1.00 +287 LIST insert an item at start 0.95 0.92 0.97 0.85 1.03 1.03 0.88 1.00 +288 LIST iterate list 1.10 1.08 1.01 1.06 0.99 1.14 1.09 1.00 +289 LIST join list 1.22 1.21 1.22 1.21 1.23 1.22 1.21 1.00 +290 LIST large, early range 1.23 1.06 1.31 1.06 1.07 1.03 1.01 1.00 +291 LIST large, late range 1.25 1.06 1.31 1.05 1.07 1.05 1.01 1.00 +292 LIST length, pure list 1.50 1.29 1.81 1.29 1.14 1.21 1.10 1.00 +293 LIST list 0.96 0.84 0.91 0.85 0.73 0.96 0.83 1.00 +294 LIST lset foreach l 1.07 1.02 1.09 0.98 0.85 0.98 0.97 1.00 +295 LIST lset foreach list 1.04 0.98 1.11 0.97 0.84 0.98 0.98 1.00 +296 LIST lset foreach ""s l 0.97 0.90 0.88 0.92 0.78 0.97 0.90 1.00 +297 LIST lset foreach ""s list 0.99 0.94 0.91 0.94 0.80 0.98 0.91 1.00 +298 LIST regexp search, first item 1.65 1.35 1.64 1.38 1.35 1.31 1.18 1.00 +299 LIST regexp search, last item 1.03 0.99 1.01 1.00 0.98 1.00 0.99 1.00 +300 LIST regexp search, non-item 1.00 0.95 0.98 0.96 0.96 0.99 0.97 1.00 +301 LIST remove first element 0.98 1.04 1.01 0.96 1.02 0.97 0.90 1.00 +302 LIST remove in mixed list 1.20 1.28 1.11 1.27 0.84 1.06 1.08 1.00 +303 LIST remove last element 0.96 1.02 1.01 0.95 1.01 0.96 0.89 1.00 +304 LIST remove middle element 0.88 0.90 0.89 0.79 0.88 0.86 0.80 1.00 +305 LIST replace first el with multiple 0.95 0.99 1.00 0.94 1.02 0.96 0.89 1.00 +306 LIST replace first element 0.89 0.89 0.90 0.80 0.89 0.90 0.82 1.00 +307 LIST replace in mixed list 1.13 1.14 1.12 1.12 0.85 1.09 1.05 1.00 +308 LIST replace last el with multiple 0.90 0.92 0.94 0.90 0.96 0.90 0.81 1.00 +309 LIST replace last element 0.85 0.90 0.93 0.80 0.88 0.89 0.83 1.00 +310 LIST replace middle el with multiple 0.89 0.89 0.93 0.82 0.92 0.93 0.86 1.00 +311 LIST replace middle element 0.95 0.96 0.99 0.91 0.96 0.93 0.84 1.00 +312 LIST replace range 1.35 1.15 1.48 1.15 1.27 1.20 1.18 1.00 +313 LIST reverse core 1.01 1.00 1.10 0.99 1.15 0.99 0.96 1.00 +314 LIST reverse lappend 1.08 1.06 1.12 1.08 1.12 1.06 1.12 1.00 +315 LIST small, early range 1.37 1.12 1.29 1.12 1.11 1.09 1.05 1.00 +316 LIST small, late range 1.35 1.12 1.32 1.09 1.08 1.06 1.03 1.00 +317 LIST sort 1.01 1.01 1.02 1.01 1.02 1.01 1.01 1.00 +318 LIST sorted search, first item 1.58 1.30 1.53 1.33 1.37 1.30 1.18 1.00 +319 LIST sorted search, last item 1.57 1.28 1.52 1.33 1.33 1.28 1.20 1.00 +320 LIST sorted search, middle item 1.54 1.28 1.51 1.30 1.34 1.26 1.16 1.00 +321 LIST sorted search, non-item 1.59 1.31 1.54 1.36 1.36 1.31 1.17 1.00 +322 LIST sorted search, typed item 1.61 1.32 1.51 1.36 1.32 1.25 1.14 1.00 +323 LIST typed sort 1.10 1.08 1.11 1.12 1.09 1.09 1.06 1.00 +324 LOOP for (to 1000) 1.21 1.16 1.25 1.19 1.12 1.18 1.18 1.00 +325 LOOP for, iterate list 1.09 1.04 1.19 1.02 1.11 1.15 1.14 1.00 +326 LOOP for, iterate string 1.01 0.94 1.05 0.94 1.04 1.03 0.96 1.00 +327 LOOP foreach, iterate list 0.80 0.71 0.71 0.71 0.60 0.90 0.73 1.00 +328 LOOP foreach, iterate string 0.81 0.72 0.74 0.73 0.62 0.87 0.74 1.00 +329 LOOP while (to 1000) 1.22 1.17 1.28 1.19 1.12 1.19 1.19 1.00 +330 LOOP while 1 (to 1000) 1.17 1.15 1.18 1.18 1.13 1.23 1.13 1.00 +331 MAP ([chars])-case regsub 1.01 0.99 0.98 0.97 0.96 1.00 0.98 1.00 +332 MAP http mapReply 1.03 1.04 1.05 1.00 0.96 1.06 1.05 1.00 +333 MAP regsub -nocase, no match 0.99 1.11 1.01 0.99 1.02 0.98 0.97 1.00 +334 MAP regsub 1 val 0.49 0.58 0.46 0.50 0.50 0.49 0.50 1.00 +335 MAP regsub 1 val -nocase 0.73 0.82 0.71 0.74 0.74 0.71 0.72 1.00 +336 MAP regsub 2 val 0.48 0.52 0.45 0.49 0.46 0.45 0.47 1.00 +337 MAP regsub 2 val -nocase 0.67 0.73 0.63 0.65 0.64 0.64 0.65 1.00 +338 MAP regsub 3 val 0.45 0.49 0.43 0.45 0.43 0.43 0.44 1.00 +339 MAP regsub 3 val -nocase 0.66 0.72 0.62 0.65 0.63 0.62 0.64 1.00 +340 MAP regsub 4 val 0.44 0.49 0.43 0.45 0.42 0.42 0.43 1.00 +341 MAP regsub 4 val -nocase 0.64 0.71 0.62 0.63 0.62 0.61 0.62 1.00 +342 MAP regsub short 0.96 0.90 1.04 0.91 0.83 0.82 0.84 1.00 +343 MAP regsub, no match 1.00 1.50 1.00 0.99 0.99 1.00 1.00 1.00 +344 MAP string -nocase, no match 0.82 0.82 0.82 0.83 0.81 0.82 0.82 1.00 +345 MAP string 1 val 0.42 0.42 0.39 0.43 0.42 0.41 0.41 1.00 +346 MAP string 1 val -nocase 0.65 0.65 0.67 0.71 0.67 0.70 0.70 1.00 +347 MAP string 2 val 0.67 0.67 0.71 0.70 0.67 0.66 0.67 1.00 +348 MAP string 2 val -nocase 0.80 0.80 0.78 0.80 0.79 0.79 0.79 1.00 +349 MAP string 3 val 0.70 0.70 0.73 0.75 0.71 0.70 0.71 1.00 +350 MAP string 3 val -nocase 0.83 0.83 0.82 0.83 0.82 0.82 0.84 1.00 +351 MAP string 4 val 0.68 0.66 0.71 0.72 0.69 0.69 0.72 1.00 +352 MAP string 4 val -nocase 0.82 0.83 0.83 0.83 0.83 0.82 0.82 1.00 +353 MAP string short 1.02 0.92 1.04 0.91 0.82 0.87 0.84 1.00 +354 MAP string, no match 0.65 0.65 0.74 0.66 0.63 0.64 0.64 1.00 +355 MAP |-case regsub 1.01 1.01 0.96 0.96 0.97 1.01 0.99 1.00 +356 MAP |-case strmap 1.16 1.06 1.22 1.01 0.93 1.02 0.97 1.00 +357 MATRIX mult 5x5 0.84 0.77 0.83 0.75 0.65 0.85 0.77 1.00 +358 MATRIX mult 10x10 0.83 0.75 0.80 0.73 0.63 0.85 0.75 1.00 +359 MATRIX mult 15x15 0.82 0.73 0.79 0.73 0.62 0.84 0.74 1.00 +360 MATRIX transposition-0 1.02 1.11 1.12 0.99 0.98 1.04 1.06 1.00 +361 MATRIX transposition-1 1.03 1.00 1.06 1.00 1.01 1.04 1.01 1.00 +362 MD5 msg len 10 1.14 1.01 1.12 1.00 0.99 1.00 0.95 1.00 +363 MD5 msg len 100 1.17 1.04 1.15 1.02 1.01 1.01 0.95 1.00 +364 MD5 msg len 1000 1.10 0.98 1.13 0.97 0.99 0.99 0.91 1.00 +365 MD5 msg len 10000 0.99 0.88 1.15 0.86 0.93 0.96 0.88 1.00 +366 MTHD array stored proc call 1.46 1.21 1.56 1.23 1.10 1.17 1.13 1.00 +367 MTHD call absolute 1.80 1.46 1.88 1.45 1.47 1.31 1.27 1.00 +368 MTHD call relative 1.67 1.36 1.71 1.36 1.41 1.27 1.22 1.00 +369 MTHD direct ns proc call 1.61 1.32 1.84 1.32 1.29 1.23 1.16 1.00 +370 MTHD imported ns proc call 1.87 1.48 1.97 1.48 1.42 1.35 1.29 1.00 +371 MTHD indirect proc eval 1.29 1.07 1.32 1.05 0.98 1.05 0.97 1.00 +372 MTHD indirect proc eval #2 1.36 1.15 1.44 1.12 0.99 1.11 1.02 1.00 +373 MTHD inline call 1.40 1.27 1.40 1.20 1.13 1.27 1.20 1.00 +374 MTHD interp alias proc call 2.08 1.74 2.18 1.72 1.44 1.56 1.51 1.00 +375 MTHD ns lookup call 1.19 1.05 1.18 1.02 0.92 1.08 0.99 1.00 +376 MTHD switch method call 1.30 1.10 1.40 1.14 1.01 1.09 0.99 1.00 +377 NS alternating 1.12 0.96 1.20 0.95 0.98 1.02 0.93 1.00 +378 PARSE html form upload (7978) 1.27 1.16 1.17 1.18 1.13 1.17 1.10 1.00 +379 PARSE html form upload (993570) 1.27 1.15 1.16 1.18 1.12 1.18 1.08 1.00 +380 PROC do-nothing, no args 1.83 1.54 1.92 1.50 1.50 1.42 1.38 1.00 +381 PROC do-nothing, one arg 1.81 1.50 1.96 1.50 1.46 1.38 1.31 1.00 +382 PROC empty, no args 1.75 1.50 2.12 1.50 1.38 1.38 1.38 1.00 +383 PROC empty, use args 1.75 1.50 1.88 1.50 1.38 1.38 1.38 1.00 +384 PROC explicit return 1.70 1.44 1.93 1.48 1.41 1.30 1.26 1.00 +385 PROC explicit return (2) 1.74 1.44 2.15 1.48 1.41 1.30 1.26 1.00 +386 PROC explicit return (3) 1.74 1.44 1.93 1.48 1.41 1.30 1.26 1.00 +387 PROC heavily commented 1.81 1.50 2.08 1.54 1.46 1.35 1.31 1.00 +388 PROC implicit return 1.79 1.46 2.18 1.50 1.43 1.32 1.32 1.00 +389 PROC implicit return (2) 1.78 1.48 2.07 1.52 1.44 1.33 1.30 1.00 +390 PROC implicit return (3) 1.81 1.50 2.00 1.54 1.50 1.35 1.31 1.00 +391 PROC local links with global 1.07 1.06 1.13 1.05 1.05 1.06 1.04 1.00 +392 PROC local links with upvar 1.06 1.05 1.13 1.04 1.04 1.04 1.04 1.00 +393 PROC local links with variable 1.06 1.06 1.11 1.06 1.05 1.04 1.04 1.00 +394 RE 1-char long-end 1.05 1.03 1.03 1.03 1.02 1.04 1.02 1.00 +395 RE 1-char long-end catching 1.03 1.00 1.02 0.99 0.97 1.01 1.00 1.00 +396 RE 1-char long-middle 1.09 1.06 1.06 1.05 1.03 1.06 1.04 1.00 +397 RE 1-char long-middle catching 1.05 1.00 1.02 0.99 0.96 1.01 0.99 1.00 +398 RE 1-char long-start 1.35 1.21 1.26 1.23 1.12 1.23 1.15 1.00 +399 RE 1-char long-start catching 1.08 0.98 1.02 0.97 0.93 1.01 0.99 1.00 +400 RE 1-char short 1.36 1.20 1.23 1.22 1.13 1.21 1.15 1.00 +401 RE 1-char short catching 1.07 0.97 1.03 0.97 0.91 1.00 0.97 1.00 +402 RE basic 1.38 1.19 1.28 1.19 1.13 1.24 1.16 1.00 +403 RE basic catching 1.06 0.98 1.06 0.98 0.94 1.01 1.01 1.00 +404 RE c-comment long 1.04 1.01 1.07 1.01 1.00 1.02 1.01 1.00 +405 RE c-comment long catching 1.01 0.99 1.04 0.99 0.98 1.00 1.00 1.00 +406 RE c-comment long nomatch 1.02 1.01 1.04 1.01 1.00 1.01 1.00 1.00 +407 RE c-comment long nomatch catching 1.03 1.01 1.05 1.02 1.01 1.02 1.01 1.00 +408 RE c-comment long pmatch 1.02 1.01 1.04 1.01 1.00 1.01 1.00 1.00 +409 RE c-comment long pmatch catching 1.03 1.01 1.04 1.02 1.01 1.02 1.01 1.00 +410 RE c-comment many *s 1.02 1.01 1.04 1.01 1.01 1.02 1.01 1.00 +411 RE c-comment many *s catching 1.01 1.00 1.02 1.00 0.99 1.01 1.00 1.00 +412 RE c-comment nomatch 1.23 1.08 1.37 1.08 1.02 1.13 1.05 1.00 +413 RE c-comment nomatch catching 1.25 1.10 1.37 1.12 1.04 1.15 1.07 1.00 +414 RE c-comment simple 1.12 1.05 1.17 1.05 1.02 1.08 1.04 1.00 +415 RE c-comment simple catching 1.03 0.97 1.05 0.98 0.95 0.99 0.98 1.00 +416 RE count all matches 1.04 1.01 1.01 1.02 1.02 1.01 1.00 1.00 +417 RE extract all matches 0.97 0.92 0.95 0.92 0.91 0.96 0.94 1.00 +418 RE ini file 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 +419 RE ini file ng 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 +420 RE literal regexp 1.25 1.18 1.18 1.14 1.11 1.20 1.15 1.00 +421 RE n-char long-end 1.05 1.03 1.04 1.03 1.02 1.03 1.02 1.00 +422 RE n-char long-end catching 1.03 0.99 1.01 0.99 0.97 0.99 0.99 1.00 +423 RE n-char long-middle 1.09 1.05 1.07 1.05 1.03 1.05 1.04 1.00 +424 RE n-char long-middle catching 1.04 0.97 1.01 0.98 0.95 0.98 0.98 1.00 +425 RE n-char long-start 1.31 1.19 1.26 1.18 1.11 1.20 1.13 1.00 +426 RE n-char long-start catching 1.08 0.97 1.01 0.97 0.92 0.98 0.97 1.00 +427 RE n-char short 1.34 1.20 1.25 1.19 1.13 1.20 1.15 1.00 +428 RE n-char short catching 1.06 0.96 1.00 0.96 0.90 0.97 0.97 1.00 +429 RE static anchored match 1.63 1.37 1.83 1.37 1.33 1.27 1.20 1.00 +430 RE static anchored match dot 1.66 1.38 1.78 1.41 1.34 1.25 1.19 1.00 +431 RE static anchored nomatch 1.67 1.37 1.83 1.40 1.33 1.27 1.20 1.00 +432 RE static anchored nomatch dot 1.79 1.46 2.00 1.50 1.46 1.32 1.29 1.00 +433 RE static l-anchored match 1.70 1.40 1.87 1.43 1.37 1.30 1.23 1.00 +434 RE static l-anchored nomatch 1.79 1.46 2.00 1.50 1.46 1.36 1.32 1.00 +435 RE static long match 1.40 1.28 1.56 1.41 1.25 1.38 1.36 1.00 +436 RE static long nomatch 1.00 0.94 1.14 1.07 0.93 1.05 1.04 1.00 +437 RE static r-anchored match 1.68 1.42 1.84 1.42 1.39 1.29 1.26 1.00 +438 RE static r-anchored nomatch 1.66 1.38 1.81 1.44 1.38 1.31 1.25 1.00 +439 RE static short match 1.68 1.42 1.87 1.42 1.39 1.29 1.29 1.00 +440 RE static short nomatch 1.73 1.43 1.97 1.47 1.43 1.33 1.37 1.00 +441 RE var ***= directive match 1.13 1.00 1.25 1.10 0.99 1.13 1.07 1.00 +442 RE var ***= directive nomatch 1.11 1.00 1.26 1.10 0.99 1.11 1.06 1.00 +443 RE var . match 1.53 1.29 1.61 1.31 1.27 1.37 1.24 1.00 +444 RE var [0-9] match 1.21 1.13 1.14 1.12 1.07 1.14 1.10 1.00 +445 RE var \d match 1.25 1.15 1.15 1.15 1.07 1.15 1.10 1.00 +446 RE var ^$ nomatch 1.54 1.29 1.65 1.31 1.27 1.33 1.23 1.00 +447 RE var backtrack case 1.15 1.09 1.10 1.08 1.04 1.10 1.07 1.00 +448 RE var-based regexp 1.21 1.18 1.14 1.11 1.10 1.19 1.15 1.00 +449 READ 595K, cat 1.04 1.00 1.02 1.00 1.00 1.02 0.94 1.00 +450 READ 595K, gets 1.00 0.92 0.97 0.94 0.93 0.96 0.88 1.00 +451 READ 595K, glob-grep match 1.07 0.93 1.02 1.00 0.93 0.97 0.90 1.00 +452 READ 595K, glob-grep nomatch 1.05 0.93 0.99 1.00 0.92 0.99 0.91 1.00 +453 READ 595K, read 1.02 1.00 0.91 1.00 0.97 0.92 0.92 1.00 +454 READ 595K, read & size 0.88 0.86 0.78 0.85 0.89 0.78 0.79 1.00 +455 READ 595K, read dyn buf 1.00 0.98 0.89 0.98 0.93 0.90 0.90 1.00 +456 READ 595K, read small buf 1.03 1.09 1.05 1.04 1.04 1.08 1.04 1.00 +457 READ 3050b, cat 1.02 0.98 1.02 0.97 0.99 1.00 0.93 1.00 +458 READ 3050b, gets 1.00 0.93 0.97 0.94 0.92 0.96 0.88 1.00 +459 READ 3050b, glob-grep match 1.06 0.94 1.01 1.01 0.94 0.97 0.91 1.00 +460 READ 3050b, glob-grep nomatch 1.04 0.92 1.00 0.99 0.94 0.99 0.90 1.00 +461 READ 3050b, read 1.10 0.97 0.98 0.98 0.92 0.93 0.92 1.00 +462 READ 3050b, read & size 0.97 0.87 0.87 0.87 0.81 0.83 0.83 1.00 +463 READ 3050b, read dyn buf 1.06 0.98 0.99 0.97 0.94 0.93 0.93 1.00 +464 READ 3050b, read small buf 1.04 1.03 1.04 1.02 1.05 1.10 1.04 1.00 +465 READ bin 595K, cat 1.15 1.08 1.09 1.03 1.14 1.12 1.03 1.00 +466 READ bin 595K, gets 1.06 0.96 1.01 0.93 1.02 1.04 0.96 1.00 +467 READ bin 595K, glob-grep match 1.18 1.00 1.07 1.09 1.05 1.08 1.02 1.00 +468 READ bin 595K, glob-grep nomatch 1.23 1.03 1.04 1.07 1.09 1.17 1.03 1.00 +469 READ bin 595K, read 1.00 1.00 1.01 1.00 0.98 1.00 1.00 1.00 +470 READ bin 595K, read & size 0.99 1.00 0.99 1.00 0.98 1.00 0.99 1.00 +471 READ bin 595K, read dyn buf 1.01 1.01 1.01 1.01 0.99 1.01 1.00 1.00 +472 READ bin 595K, read small buf 1.00 1.04 1.04 1.03 1.02 1.03 1.04 1.00 +473 READ bin 3050b, cat 1.09 1.04 1.08 0.98 1.09 1.08 0.99 1.00 +474 READ bin 3050b, gets 1.06 0.97 1.02 0.94 1.02 1.04 0.97 1.00 +475 READ bin 3050b, glob-grep match 1.05 0.94 1.08 0.99 0.98 1.01 0.94 1.00 +476 READ bin 3050b, glob-grep nomatch 1.05 0.92 1.03 0.98 0.97 1.05 0.94 1.00 +477 READ bin 3050b, read 1.01 0.98 1.08 0.99 0.97 1.02 0.97 1.00 +478 READ bin 3050b, read & size 1.04 1.00 1.09 1.01 0.97 1.04 0.97 1.00 +479 READ bin 3050b, read dyn buf 1.01 1.00 1.08 1.01 1.01 1.03 0.99 1.00 +480 READ bin 3050b, read small buf 1.04 1.06 1.09 1.05 1.05 1.06 1.08 1.00 +481 SHA1 msg len 10 1.09 1.02 1.05 1.00 1.01 1.04 0.99 1.00 +482 SHA1 msg len 100 1.10 1.03 1.06 1.01 1.02 1.05 1.00 1.00 +483 SHA1 msg len 1000 1.11 1.05 1.08 1.03 1.05 1.08 1.02 1.00 +484 SHA1 msg len 10000 1.11 1.05 1.07 1.03 1.05 1.07 1.01 1.00 +485 SPLIT iter, 4000 uchars 0.83 0.77 0.79 0.77 0.67 0.85 0.79 1.00 +486 SPLIT iter, 4010 chars 0.82 0.76 0.78 0.76 0.65 0.84 0.79 1.00 +487 SPLIT iter, rand 100 c 0.85 0.75 1.02 0.75 0.63 0.86 0.76 1.00 +488 SPLIT iter, rand 1000 c 0.85 0.76 0.86 0.77 0.65 0.86 0.78 1.00 +489 SPLIT iter, rand 10000 c 0.86 0.79 0.81 0.79 0.68 0.87 0.80 1.00 +490 SPLIT on 'c', 4000 uchars 0.86 0.77 0.87 0.78 0.62 0.89 0.79 1.00 +491 SPLIT on 'c', 4010 chars 0.85 0.76 0.86 0.77 0.61 0.89 0.79 1.00 +492 SPLIT on 'cz', 4000 uchars 0.91 0.84 0.92 0.83 0.72 0.94 0.86 1.00 +493 SPLIT on 'cz', 4010 chars 0.89 0.82 0.90 0.83 0.71 0.92 0.85 1.00 +494 SPLIT on 'cū', 4000 uchars 0.92 0.88 0.92 0.85 0.83 1.02 0.96 1.00 +495 SPLIT on 'cū', 4010 chars 0.95 0.91 0.94 0.89 0.93 1.07 1.02 1.00 +496 SPLIT, 4000 uchars 0.95 0.94 1.00 0.94 0.98 0.98 0.98 1.00 +497 SPLIT, 4010 chars 0.96 0.93 0.99 0.93 0.95 0.96 0.96 1.00 +498 SPLIT, rand 100 c 0.89 0.77 1.32 0.78 0.68 0.91 0.82 1.00 +499 SPLIT, rand 1000 c 0.90 0.83 1.10 0.83 0.78 0.92 0.86 1.00 +500 SPLIT, rand 10000 c 0.96 0.93 1.02 0.93 0.93 0.95 0.94 1.00 +501 STR append 1.15 1.07 1.14 1.03 0.82 0.96 0.96 1.00 +502 STR append (1KB + 1KB) 1.23 1.04 1.38 1.08 0.93 1.03 0.96 1.00 +503 STR append (1MB + (1b+1K+1b)*100) 1.03 1.02 1.02 1.02 1.02 1.04 1.04 1.00 +504 STR append (1MB + 1KB) 1.00 1.00 1.00 1.00 0.99 1.02 1.03 1.00 +505 STR append (1MB + 1KB*20) 1.00 1.00 1.00 1.01 1.00 1.02 1.03 1.00 +506 STR append (1MB + 1KB*1000) 1.07 1.05 1.06 1.06 1.07 1.06 1.08 1.00 +507 STR append (1MB + 1MB*3) 1.00 1.00 1.00 1.00 1.00 1.01 1.01 1.00 +508 STR append (1MB + 1MB*5) 1.00 1.00 1.00 1.00 1.00 1.01 1.01 1.00 +509 STR append (1MB + 2b*1000) 1.06 1.05 1.07 1.06 1.07 1.04 1.05 1.00 +510 STR append (10KB + 1KB) 1.17 1.10 1.02 1.10 0.91 0.98 0.97 1.00 +511 STR first (failure) 1.05 1.03 1.08 1.03 0.83 1.04 1.03 1.00 +512 STR first (failure) utf 1.06 1.04 1.07 1.05 0.84 1.05 1.06 1.00 +513 STR first (success) 1.54 1.34 1.51 1.34 1.35 1.32 1.28 1.00 +514 STR first (success) utf 1.53 1.31 1.49 1.32 1.32 1.31 1.27 1.00 +515 STR first (total failure) 1.10 1.06 1.10 1.06 0.79 1.06 1.05 1.00 +516 STR first (total failure) utf 1.10 1.07 1.10 1.06 0.79 1.06 1.05 1.00 +517 STR index 0 1.36 1.17 1.41 1.14 1.16 1.16 1.07 1.00 +518 STR index 100 1.39 1.18 1.42 1.16 1.16 1.18 1.09 1.00 +519 STR index 500 1.39 1.18 1.42 1.16 1.18 1.16 1.07 1.00 +520 STR info locals match 1.05 1.05 1.08 1.03 1.01 1.04 1.03 1.00 +521 STR last (failure) 1.06 1.04 1.05 1.03 0.89 1.04 1.03 1.00 +522 STR last (success) 1.57 1.33 1.50 1.32 1.35 1.33 1.29 1.00 +523 STR last (total failure) 1.07 1.04 1.07 1.04 0.86 1.04 1.04 1.00 +524 STR length (==4010) 1.52 1.27 1.65 1.27 1.22 1.20 1.15 1.00 +525 STR length growing (1000) 1.16 1.06 1.10 1.14 1.10 1.13 1.14 1.00 +526 STR length growing uc (1000) 1.18 1.07 1.07 1.13 1.09 1.11 1.15 1.00 +527 STR length of a LIST 1.55 1.32 1.63 1.29 1.24 1.24 1.16 1.00 +528 STR length static str 1.72 1.41 1.93 1.45 1.41 1.31 1.28 1.00 +529 STR match, complex (failure) 0.89 0.89 1.04 1.02 0.87 1.01 1.01 1.00 +530 STR match, complex (success early) 1.50 1.26 1.59 1.30 1.22 1.24 1.17 1.00 +531 STR match, complex (success late) 0.93 0.96 1.05 1.02 0.87 1.02 1.01 1.00 +532 STR match, complex (total failure) 0.85 0.83 1.04 1.02 0.83 1.02 1.01 1.00 +533 STR match, exact (failure) 1.70 1.37 1.87 1.40 1.37 1.23 1.20 1.00 +534 STR match, exact (success) 1.70 1.33 1.73 1.40 1.33 1.23 1.20 1.00 +535 STR match, exact -nocase (failure) 1.76 1.41 1.83 1.48 1.41 1.31 1.28 1.00 +536 STR match, exact -nocase (success) 1.49 1.29 1.62 1.29 1.27 1.18 1.16 1.00 +537 STR match, recurse (fail backtrack) 1.01 1.01 1.02 1.01 1.01 1.01 1.01 1.00 +538 STR match, recurse (fail bt1) 1.01 1.01 1.02 1.01 1.01 1.01 1.01 1.00 +539 STR match, recurse (fail bt2) 1.02 1.01 1.03 1.02 1.01 1.01 1.01 1.00 +540 STR match, recurse (fail ranchor) 0.80 0.80 1.00 1.00 0.80 1.00 1.00 1.00 +541 STR match, recurse (success bt2) 1.11 1.07 1.15 1.09 1.06 1.07 1.04 1.00 +542 STR match, recurse2 (fail) 0.85 0.86 1.00 1.00 0.85 1.00 1.00 1.00 +543 STR match, recurse2 (success) 0.89 0.90 1.04 1.02 0.87 1.01 1.01 1.00 +544 STR match, simple (failure) 1.73 1.43 1.87 1.47 1.43 1.30 1.30 1.00 +545 STR match, simple (success) 1.68 1.42 1.90 1.45 1.39 1.29 1.29 1.00 +546 STR range, index 100..200 of 4010 1.40 1.22 1.40 1.20 1.20 1.20 1.15 1.00 +547 STR repeat, 4010 chars * 10 1.09 1.04 1.09 1.01 0.98 1.03 1.03 1.00 +548 STR repeat, 4010 chars * 100 1.02 1.01 1.02 1.01 1.01 1.01 1.01 1.00 +549 STR repeat, abcdefghij * 10 1.62 1.42 1.66 1.41 1.38 1.38 1.34 1.00 +550 STR repeat, abcdefghij * 100 1.38 1.25 1.44 1.30 1.21 1.22 1.21 1.00 +551 STR repeat, abcdefghij * 1000 1.07 1.05 1.08 1.19 1.04 1.04 1.04 1.00 +552 STR replace, equal replacement 1.26 1.17 1.26 1.15 1.09 1.14 1.13 1.00 +553 STR replace, longer replacement 1.16 1.08 1.09 1.09 0.97 1.09 1.07 1.00 +554 STR replace, no replacement 1.54 1.41 1.34 1.31 1.16 1.14 1.08 1.00 +555 STR reverse core, 10 c 1.45 1.26 1.52 1.27 1.25 1.26 1.21 1.00 +556 STR reverse core, 10 uc 1.40 1.22 1.48 1.24 1.22 1.22 1.17 1.00 +557 STR reverse core, 100 c 1.43 1.24 1.47 1.28 1.23 1.25 1.23 1.00 +558 STR reverse core, 100 uc 1.42 1.25 1.47 1.27 1.20 1.25 1.19 1.00 +559 STR reverse core, 400 c 1.29 1.13 1.42 1.22 1.11 1.16 1.20 1.00 +560 STR reverse core, 400 uc 1.41 1.22 1.50 1.32 1.18 1.22 1.27 1.00 +561 STR reverse iter/append, 10 c 1.10 0.99 1.27 0.99 1.06 1.05 0.98 1.00 +562 STR reverse iter/append, 10 uc 1.08 0.96 1.21 0.99 1.04 1.03 0.96 1.00 +563 STR reverse iter/append, 100 c 1.09 1.02 1.15 1.02 1.12 1.13 1.01 1.00 +564 STR reverse iter/append, 100 uc 1.05 1.01 1.10 0.97 1.05 1.09 0.98 1.00 +565 STR reverse iter/append, 400 c 1.09 1.05 1.12 1.02 1.14 1.14 1.02 1.00 +566 STR reverse iter/append, 400 uc 1.03 1.00 1.09 0.98 1.06 1.09 0.98 1.00 +567 STR reverse iter/set, 10 c 1.13 0.99 1.18 1.00 1.09 1.10 1.05 1.00 +568 STR reverse iter/set, 10 uc 1.10 0.98 1.19 0.99 1.09 1.08 1.03 1.00 +569 STR reverse iter/set, 100 c 1.07 1.00 1.16 0.99 1.11 1.10 1.02 1.00 +570 STR reverse iter/set, 100 uc 1.04 0.98 1.12 0.97 1.09 1.08 1.00 1.00 +571 STR reverse iter/set, 400 c 1.05 0.97 1.23 0.98 1.10 1.10 1.01 1.00 +572 STR reverse iter/set, 400 uc 1.03 0.95 1.22 0.95 1.07 1.07 0.99 1.00 +573 STR reverse recursive, 10 c 1.23 1.11 1.20 1.03 1.08 1.07 0.99 1.00 +574 STR reverse recursive, 10 uc 1.26 1.14 1.24 1.07 1.10 1.10 1.02 1.00 +575 STR reverse recursive, 100 c 1.22 1.11 1.22 1.05 1.07 1.05 0.98 1.00 +576 STR reverse recursive, 100 uc 1.25 1.13 1.25 1.07 1.09 1.08 1.00 1.00 +577 STR reverse recursive, 400 c 1.23 1.09 1.21 1.04 1.05 1.03 0.95 1.00 +578 STR reverse recursive, 400 uc 1.23 1.10 1.22 1.05 1.06 1.04 0.96 1.00 +579 STR str $a eq $b 1.40 1.19 1.46 1.26 1.16 1.16 1.11 1.00 +580 STR str $a eq $b (same obj) 1.39 1.19 1.49 1.22 1.17 1.11 1.07 1.00 +581 STR str $a equal "" 1.62 1.38 1.70 1.45 1.40 1.30 1.28 1.00 +582 STR str $a ne $b 1.42 1.22 1.46 1.26 1.18 1.15 1.11 1.00 +583 STR str $a ne $b (same obj) 1.36 1.19 1.44 1.24 1.16 1.13 1.09 1.00 +584 STR str num == "" 1.52 1.29 1.62 1.37 1.29 1.21 1.17 1.00 +585 STR strcmp bin long eq 1.20 1.16 1.19 1.15 1.11 1.14 1.11 1.00 +586 STR strcmp bin long neq 1.20 1.15 1.25 1.15 1.10 1.14 1.11 1.00 +587 STR strcmp bin long neqS 1.44 1.32 1.48 1.30 1.24 1.30 1.24 1.00 +588 STR strcmp bin short eq 1.67 1.50 1.64 1.45 1.37 1.44 1.38 1.00 +589 STR streq bin long eq 0.06 0.06 0.06 0.06 0.06 0.06 0.06 1.00 +590 STR streq bin long neq 0.06 0.06 0.06 0.06 0.06 0.06 0.06 1.00 +591 STR streq bin long neqS 0.04 0.04 0.04 0.04 0.03 0.03 0.03 1.00 +592 STR streq bin short eq 1.01 0.93 1.03 0.91 0.84 0.88 0.85 1.00 +593 STR string compare 1.44 1.15 1.47 1.18 1.11 1.17 1.06 1.00 +594 STR string compare "" 1.35 1.18 1.42 1.19 1.15 1.08 1.06 1.00 +595 STR string compare long 1.16 1.08 1.16 1.09 1.06 1.07 1.04 1.00 +596 STR string compare long (same obj) 1.36 1.15 1.44 1.22 1.17 1.19 1.08 1.00 +597 STR string compare mixed long 1.02 1.01 0.97 0.94 1.02 0.95 0.94 1.00 +598 STR string compare uni long 0.99 0.98 1.03 1.01 1.16 1.01 1.01 1.00 +599 STR string equal "" 1.75 1.46 1.83 1.52 1.46 1.42 1.37 1.00 +600 STR string equal long (!= len) 1.30 1.22 1.42 1.18 1.16 1.17 1.14 1.00 +601 STR string equal long (== len) 1.08 1.02 1.08 1.05 0.98 0.97 0.96 1.00 +602 STR string equal long (same obj) 1.39 1.20 1.39 1.23 1.16 1.14 1.09 1.00 +603 STR string equal mixed long 1.48 1.29 1.44 1.34 1.23 1.22 1.21 1.00 +604 STR string equal uni long 1.46 1.41 1.50 1.44 1.35 1.36 1.35 1.00 +605 STR/LIST length, obj shimmer 0.85 0.77 1.13 0.77 0.65 0.90 0.81 1.00 +606 SWITCH 1st true 1.62 1.38 1.77 1.42 1.38 1.30 1.27 1.00 +607 SWITCH 2nd true 1.67 1.41 1.85 1.46 1.38 1.31 1.28 1.00 +608 SWITCH 9th true 1.67 1.41 1.85 1.44 1.38 1.31 1.31 1.00 +609 SWITCH default true 1.64 1.33 1.82 1.41 1.33 1.23 1.21 1.00 +610 TRACE all set (rwu) 1.07 0.95 1.16 0.98 0.92 0.92 0.85 1.00 +611 TRACE no trace set 1.08 0.94 1.18 0.98 0.92 0.93 0.86 1.00 +612 TRACE read 1.07 0.95 1.17 0.96 0.93 0.93 0.87 1.00 +613 TRACE unset 1.07 0.95 1.16 0.98 0.92 0.92 0.86 1.00 +614 TRACE write 1.06 0.95 1.18 0.98 0.93 0.93 0.85 1.00 +615 UNSET catch var !exist 0.98 0.88 1.06 0.88 0.75 0.98 0.91 1.00 +616 UNSET catch var exists 1.36 1.14 1.57 1.19 1.10 1.05 1.00 1.00 +617 UNSET info check var !exist 1.84 1.50 2.12 1.62 1.44 1.38 1.28 1.00 +618 UNSET info check var exists 1.42 1.17 1.47 1.25 1.10 1.07 1.00 1.00 +619 UNSET nocomplain var !exist 1.34 1.07 1.49 1.10 1.00 0.98 0.93 1.00 +620 UNSET nocomplain var exists 1.38 1.16 1.54 1.22 1.11 1.05 1.00 1.00 +621 UNSET var exists 1.46 1.20 1.69 1.26 1.14 1.11 1.06 1.00 +622 UPLEVEL none 0.84 0.74 0.83 0.73 0.65 0.80 0.78 1.00 +623 UPLEVEL primed 1.06 0.93 1.14 0.94 0.84 0.94 0.86 1.00 +624 UPLEVEL to nseval 1.20 1.09 1.19 1.13 0.95 1.13 1.10 1.00 +625 UPLEVEL to proc 1.21 1.13 1.31 1.12 0.95 1.07 1.01 1.00 +626 VAR 'array set' of 100 elems 1.08 1.07 1.11 1.09 1.01 1.02 1.01 1.00 +627 VAR 100 'set's in array 1.10 1.05 1.09 1.08 1.03 1.05 1.03 1.00 +628 VAR access global 1.35 1.16 1.55 1.24 1.09 1.11 1.05 1.00 +629 VAR access local proc arg 1.70 1.38 1.84 1.43 1.38 1.27 1.24 1.00 +630 VAR access locally set 1.75 1.42 1.89 1.47 1.39 1.33 1.28 1.00 +631 VAR access upvar 1.45 1.12 1.62 1.21 1.12 1.09 1.09 1.00 +632 VAR incr global var 1000x 0.88 0.83 0.86 0.85 0.72 0.90 0.88 1.00 +633 VAR incr local var 1000x 0.86 0.84 0.86 0.83 0.71 0.88 0.85 1.00 +634 VAR incr upvar var 1000x 0.87 0.87 0.87 0.85 0.72 0.89 0.83 1.00 +635 VAR mset 1.36 1.18 1.47 1.24 1.05 1.13 1.11 1.00 +636 VAR mset (foreach) 1.23 1.09 1.32 1.09 0.86 0.98 0.95 1.00 +637 VAR ref absolute 0.98 0.93 1.05 0.99 0.79 0.95 0.94 1.00 +638 VAR ref local 1.24 1.15 1.38 1.17 1.19 1.14 1.12 1.00 +639 VAR ref variable 1.24 1.16 1.40 1.21 1.17 1.18 1.26 1.00 +640 VAR set array element 1.45 1.21 1.68 1.30 1.11 1.15 1.06 1.00 +641 VAR set scalar 1.82 1.46 2.11 1.50 1.43 1.32 1.29 1.00 +642 WORDCOUNT wc1 1.00 0.97 0.97 0.96 0.92 1.02 0.99 1.00 +643 WORDCOUNT wc2 0.98 0.91 1.10 0.91 0.84 0.99 0.95 1.00 +644 WORDCOUNT wc3 0.98 0.94 1.14 0.93 0.86 1.01 0.96 1.00 +644 BENCHMARKS 1:8.6b1.2 2:8.6b1.2 3:8.6b1.2 4:8.6b1.2 5:8.6b1.2 6:8.6b1.2 7:8.6b1.2 8:8.5.9 +FINISHED 2011-03-28 13:14:44 diff --git a/tests/nre.test b/tests/nre.test index b5eb032..07cb66f 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -28,8 +28,8 @@ if {[testConstraint testnrelevels]} { namespace eval testnre { namespace path ::tcl::mathop # - # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, - # cmdFrame level, callFrame level, tosPtr and callback depth + # [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels, + # cmdFrame level, callFrame level and callback depth # variable last [testnrelevels] proc depthDiff {} { diff --git a/tests/tailcall.test b/tests/tailcall.test index 2d04f82..5e32364 100644 --- a/tests/tailcall.test +++ b/tests/tailcall.test @@ -27,8 +27,8 @@ testConstraint testnrelevels [llength [info commands testnrelevels]] if {[testConstraint testnrelevels]} { namespace eval testnre { # - # [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels, - # cmdFrame level, callFrame level, tosPtr and callback depth + # [testnrelevels] returns a 5-list with: C-stack depth, iPtr->numlevels, + # cmdFrame level, callFrame level and callback depth # variable last [testnrelevels] proc depthDiff {} { @@ -69,7 +69,7 @@ test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup a 0 } -cleanup { rename a {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup { set a { i { @@ -86,7 +86,7 @@ test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup apply $a 0 } -cleanup { unset a -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup { proc a i { @@ -104,7 +104,7 @@ test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup { namespace eval ::ns { @@ -127,7 +127,7 @@ test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename b {} namespace delete ::ns -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup { proc b i { @@ -145,7 +145,7 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename b {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup { # @@ -170,7 +170,7 @@ test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels known rename a {} rename c {} rename d {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup { catch {rename foo {}} @@ -191,7 +191,7 @@ test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup } -cleanup { rename a {} rename foo {} -} -result {0 0 0 0 0 0} +} -result {0 0 0 0 0} test tailcall-1 {tailcall} -body { namespace eval a { diff --git a/unix/Makefile.in b/unix/Makefile.in index fe95797..d45b139 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -290,7 +290,42 @@ TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o -GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ +#-------------------------------------------------------------------------- +# Choose the default allocator to link in. Override with the env-var +# TCL_ALLOCATOR if present. Note that all allocators will be compiled, +# changing them just requires relinking. +#-------------------------------------------------------------------------- + +PURIFY = tclAllocPurify.o +PURIFY_FLAGS = -DPURIFY% -DTCL_ALLOCATOR=PURIFY + +NATIVE = tclAllocNative.o +NATIVE_FLAGS = -DTCL_ALLOCATOR=NATIVE + +ZIPPY = tclAllocZippy.o +ZIPPY_FLAGS = -DUSE_THREAD_ALLOC% -DTCL_ALLOCATOR=ZIPPY + +ALLOCATOR_DEFAULT = $(NATIVE) +ALLOCATORS = $(PURIFY) $(NATIVE) $(ZIPPY) + +WHERE = $(CC_SWITCHES) $(CFLAGS) + +ifdef TCL_ALLOCATOR + ALLOCATOR = $($(TCL_ALLOCATOR)) +else ifneq (,$(filter $(PURIFY_FLAGS), $(WHERE))) + ALLOCATOR = $(PURIFY) +else ifneq (,$(filter $(NATIVE_FLAGS), $(WHERE))) + ALLOCATOR = $(NATIVE) +else ifneq (,$(filter $(ZIPPY_FLAGS), $(WHERE))) + ALLOCATOR = $(ZIPPY) +endif + +ifeq (,$(filter $(ALLOCATORS), $(ALLOCATOR))) + ALLOCATOR = $(ALLOCATOR_DEFAULT) +endif + +GENERIC_OBJS = $(ALLOCATOR) \ + regcomp.o regexec.o regfree.o regerror.o \ tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o tclClock.o \ tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompCmds.o tclCompCmdsSZ.o \ tclCompExpr.o tclCompile.o tclConfig.o tclDate.o tclDictObj.o \ @@ -305,10 +340,10 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclPreserve.o tclProc.o tclRegexp.o \ tclResolve.o tclResult.o tclScan.o tclStringObj.o \ tclStrToD.o tclThread.o \ - tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ + tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ tclTomMathInterface.o \ - tclAssembly.o + tclAssembly.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o @@ -384,7 +419,9 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/regexec.c \ $(GENERIC_DIR)/regfree.c \ $(GENERIC_DIR)/regerror.c \ - $(GENERIC_DIR)/tclAlloc.c \ + $(GENERIC_DIR)/tclAllocNative.c \ + $(GENERIC_DIR)/tclAllocPurify.c \ + $(GENERIC_DIR)/tclAllocZippy.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ @@ -447,7 +484,6 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ - $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ $(GENERIC_DIR)/tclThreadStorage.c \ $(GENERIC_DIR)/tclTimer.c \ @@ -611,7 +647,7 @@ doc: # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. -${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE} +${LIB_FILE}: $(ALLOCATORS) ${OBJS} ${STUB_LIB_FILE} rm -f $@ @MAKE_LIB@ @if test "x$(DLL_INSTALL_DIR)" = "x$(BIN_INSTALL_DIR)"; then\ @@ -1049,8 +1085,14 @@ regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c -tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c +tclAllocNative.o: $(GENERIC_DIR)/tclAllocNative.c $(GENERIC_DIR)/tclAllocZippy.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAllocNative.c + +tclAllocPurify.o: $(GENERIC_DIR)/tclAllocPurify.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAllocPurify.c + +tclAllocZippy.o: $(GENERIC_DIR)/tclAllocZippy.c + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAllocZippy.c tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c @@ -1325,9 +1367,6 @@ tclTimer.o: $(GENERIC_DIR)/tclTimer.c tclThread.o: $(GENERIC_DIR)/tclThread.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c -tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c - $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c - tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 9c21b28..249a703 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -430,8 +430,8 @@ TclpCreateProcess( * deallocated later */ - dsArray = TclStackAlloc(interp, argc * sizeof(Tcl_DString)); - newArgv = TclStackAlloc(interp, (argc+1) * sizeof(char *)); + dsArray = ckalloc(argc * sizeof(Tcl_DString)); + newArgv = ckalloc((argc+1) * sizeof(char *)); newArgv[argc] = NULL; for (i = 0; i < argc; i++) { newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]); @@ -503,8 +503,8 @@ TclpCreateProcess( for (i = 0; i < argc; i++) { Tcl_DStringFree(&dsArray[i]); } - TclStackFree(interp, newArgv); - TclStackFree(interp, dsArray); + ckfree(newArgv); + ckfree(dsArray); if (pid == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index 789dbb6..e178041 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -674,12 +674,11 @@ TclpInetNtoa( #endif } -#ifdef TCL_THREADS +#if defined(TCL_THREADS) /* * Additions by AOL for specialized thread memory allocator. */ -#ifdef USE_THREAD_ALLOC static volatile int initialized = 0; static pthread_key_t key; @@ -716,6 +715,7 @@ TclpFreeAllocMutex( free(lockPtr); } + void TclpFreeAllocCache( void *ptr) @@ -758,8 +758,9 @@ TclpSetAllocCache( { pthread_setspecific(key, arg); } -#endif /* USE_THREAD_ALLOC */ +#endif +#ifdef TCL_THREADS void * TclpThreadCreateKey(void) { |