Tcl Source Code

#define OFFSET      ALIGN(sizeof(Block))

#define nextBlock	u.next
#define sourceBucket	u.s.bucket
#define magicNum1	u.s.magic1
#define magicNum2	u.s.magic2
#define MAGIC		0xEF


/*
 * The following defines the minimum and maximum block sizes and the number
 * of buckets in the bucket cache.
 *                        32b    64b    Apple-32b
 *     TCL_ALLOCALIGN       8     16       16
 *     sizeof(Block)        8     16       16

    int bucket,
    unsigned int reqSize)
{
    register void *ptr;

    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
    blockPtr->sourceBucket = bucket;
    blockPtr->reqSize = reqSize;
    ptr = (void *) (((char *)blockPtr) + OFFSET);
#if RCHECK
    ((unsigned char *)(ptr))[reqSize] = MAGIC;
#endif
    return (char *) ptr;
}

static inline Block *
Ptr2Block(
    char *ptr)
{
    register Block *blockPtr;

    blockPtr = (Block *) (((char *) ptr) - OFFSET);
    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
	Tcl_Panic("alloc: invalid block: %p: %x %x",
		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
    }
#if RCHECK
    if (((unsigned char *) ptr)[blockPtr->reqSize] != MAGIC) {
	Tcl_Panic("alloc: invalid block: %p: %x %x %x",
		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2,
		((unsigned char *) ptr)[blockPtr->reqSize]);
    }
#endif
    return blockPtr;
}

/*
 *----------------------------------------------------------------------

     * blocks to the shared cache if there are now too many free.
     */

    blockPtr = Ptr2Block(ptr);
    bucket = blockPtr->sourceBucket;
    if (bucket == nBuckets) {
#ifdef ZIPPY_STATS
	cachePtr->totalAssigned -= blockPtr->reqSize;
#endif
	free(blockPtr);
	return;
    }

#ifdef ZIPPY_STATS
    cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
#endif
    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
    cachePtr->buckets[bucket].firstPtr = blockPtr;
    cachePtr->buckets[bucket].numFree++;
#ifdef ZIPPY_STATS
    cachePtr->buckets[bucket].numInserts++;
#endif

	if (bucket > 0) {
	    min = bucketInfo[bucket-1].blockSize;
	} else {
	    min = 0;
	}
	if (size > min && size <= bucketInfo[bucket].blockSize) {
#ifdef ZIPPY_STATS
	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->reqSize;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
#endif
	    return Block2Ptr(blockPtr, bucket, reqSize);
	}
    } else if (size > MAXALLOC) {
#ifdef ZIPPY_STATS
	cachePtr->totalAssigned -= blockPtr->reqSize;
	cachePtr->totalAssigned += reqSize;
#endif
	blockPtr = realloc(blockPtr, size);
	if (blockPtr == NULL) {
	    return NULL;
	}
	return Block2Ptr(blockPtr, nBuckets, reqSize);
    }

    /*
     * Finally, perform an expensive malloc/copy/free.
     */

    newPtr = TclpAlloc(reqSize);
    if (newPtr != NULL) {
	if (reqSize > blockPtr->reqSize) {
	    reqSize = blockPtr->reqSize;
	}
	memcpy(newPtr, ptr, reqSize);
	TclpFree(ptr);
    }
    return newPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAllocMaximize --
 *
 * Given a TclpAlloc'ed pointer, it returns the maximal size that can be used
 * by the allocated memory. This is almost always larger than the requested
 * size, as it corresponds to the bucket's size.
 *
 * Results:
 *	New size.
 *
 *----------------------------------------------------------------------
 */
 unsigned int
 TclAllocMaximize(
     void *ptr)
{
    Block *blockPtr;
    int bucket;
    size_t oldSize, newSize;

    if (allocator < aNONE) {
	/*
	 * No info, return UINT_MAX as a signal.
	 */
	
	return UINT_MAX;
    }
    
    blockPtr = Ptr2Block(ptr);
    bucket = blockPtr->sourceBucket;
    
    if (bucket == nBuckets) {
	/*
	 * System malloc'ed: no info
	 */
	
	return UINT_MAX;
    }

    oldSize = blockPtr->reqSize;
    newSize = bucketInfo[bucket].blockSize - OFFSET - RCHECK;
    blockPtr->reqSize = newSize;
#if RCHECK
    ((unsigned char *)(ptr))[newSize] = MAGIC;
#endif    
    return newSize;
}

#ifdef ZIPPY_STATS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMemoryInfo --
 *

#  endif
#endif

#if TCL_ALLOCATOR < aNONE /* native or purify */
#    define TclpAlloc(size) ckalloc(size)
#    define TclpRealloc(ptr, size) ckrealloc((ptr),(size))
#    define TclpFree(size) ckfree(size)
#    define TclAllocMaximize(ptr) UINT_MAX
#else
   MODULE_SCOPE char * TclpAlloc(unsigned int size);
   MODULE_SCOPE char * TclpRealloc(char * ptr, unsigned int size);
   MODULE_SCOPE void   TclpFree(char * ptr);
   MODULE_SCOPE unsigned int TclAllocMaximize(void *ptr);
#endif

#if TCL_ALLOCATOR == aPURIFY
#  define TclSmallAlloc() ckalloc(sizeof(Tcl_Obj))
#  define TclSmallFree(ptr) ckfree(ptr)
#  define TclInitAlloc()
#  define TclFinalizeAlloc()

 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#define Elems2Size(n)					\
    ((n > 1)						\
	    ? (sizeof(List) + (n-1)*sizeof(Tcl_Obj *))	\
	    : (sizeof(List)))
#define Size2Elems(s)							\
    ((s > sizeof(List) + sizeof(Tcl_Obj *) -1)				\
	    ? (s - sizeof(List) + sizeof(Tcl_Obj *))/sizeof(Tcl_Obj *)	\
	    : 1)

static List *
NewListIntRep(
    int objc,
    Tcl_Obj *const objv[])
{
    List *listRepPtr;
    unsigned int allocSize;
    
    if (objc <= 0) {
	return NULL;
    }

    /*
     * First check to see if we'd overflow and try to allocate an object
     * larger than our memory allocator allows. Note that this is actually a
     * fairly small value when you're on a serious 64-bit machine, but that
     * requires API changes to fix. See [Bug 219196] for a discussion.
     */

    if ((size_t)objc > INT_MAX/sizeof(Tcl_Obj *)) {
	return NULL;
    }

    listRepPtr = attemptckalloc(Elems2Size(objc));
    if (listRepPtr == NULL) {
	return NULL;
    }
    allocSize = TclAllocMaximize(listRepPtr);
    
    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
    listRepPtr->maxElemCount = (allocSize == UINT_MAX)
	? objc
	: Size2Elems(allocSize);

    if (objv) {
	Tcl_Obj **elemPtrs;
	int i;

	listRepPtr->elemCount = objc;
	elemPtrs = &listRepPtr->elements;

     * If there is no room in the current array of element pointers, allocate
     * a new, larger array and copy the pointers to it. If the List struct is
     * shared, allocate a new one.
     */

    if (numRequired > listRepPtr->maxElemCount){
	newMax = 2 * numRequired;
	newSize = Elems2Size(newMax);
    } else {
	newMax = listRepPtr->maxElemCount;
	newSize = 0;
    }

    if (listRepPtr->refCount > 1) {
	List *oldListRepPtr = listRepPtr;

	    Tcl_IncrRefCount(elemPtrs[i]);
	}
	listRepPtr->elemCount = numElems;
	listRepPtr->refCount++;
	oldListRepPtr->refCount--;
    } else if (newSize) {
	listRepPtr = ckrealloc(listRepPtr, newSize);
	newSize = TclAllocMaximize(listRepPtr);
	listRepPtr->maxElemCount = (newSize == UINT_MAX)
	    ? newMax
	    : Size2Elems(newSize);
    }
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;

    /*
     * Add objPtr to the end of listPtr's array of element pointers. Increment
     * the ref count for the (now shared) objPtr.
     */