Tcl Source Code

typedef struct Block {
    union {
	struct Block *next;		/* Next in free list. */
	struct {
	    unsigned char magic1;	/* First magic number. */
	    unsigned char bucket;	/* Bucket block allocated from. */
	    unsigned char inUse;	/* Block memory currently in use, see
					 * details in TclpAlloc/Realloc. */

	    unsigned char magic2;	/* Second magic number. */
	} s;
    } u;
    long refCount;
} Block;

#define OFFSET      ALIGN(sizeof(Block))

/*
 * The following array specifies various per-bucket limits and locks. The
 * values are statically initialized to avoid calculating them repeatedly.
 */

static struct {
    size_t blockSize;		/* Bucket blocksize. */
    int shift;
#if defined(TCL_THREADS)
    int maxBlocks;		/* Max blocks before move to share. */
    int numMove;		/* Num blocks to move to share. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
#endif
} bucketInfo[NBUCKETS];

 */

#if USE_ZIPPY
static void
InitBucketInfo ()
{
    int i;
    int shift = 0;
    
    for (i = 0; i < NBUCKETS; ++i) {
	bucketInfo[i].blockSize = MINALLOC << i;
	while (((bucketInfo[i].blockSize -OFFSET) >> shift) > 255) {
	    ++shift;
	}
	bucketInfo[i].shift = shift;
#if defined(TCL_THREADS)
	/* TODO: clearer logic? Change move to keep? */
	bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
	bucketInfo[i].numMove = i < NBUCKETS - 1 ?
	    1 << (NBUCKETS - 2 - i) : 1;
	bucketInfo[i].lockPtr = TclpNewAllocMutex();
#endif

{
    register void *ptr;
    
    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
    if (bucket == NBUCKETS) {
	blockPtr->used = 255;
    } else {




	blockPtr->used = (reqSize >> bucketInfo[bucket].shift);



    }
    blockPtr->sourceBucket = bucket;
    ptr = (void *) (((char *)blockPtr) + OFFSET);
    blockPtr->refCount = 0;
    return (char *) ptr;
}

	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    /*
     * If the block is not a system block and belongs in the same block,
     * simply return the existing pointer. Otherwise, if the block is a system
     * block and the new size would also require a system block, call
     * realloc() directly. 
     */

    blockPtr = Ptr2Block(ptr);
    if (blockPtr->refCount != 0) {
	Tcl_Panic("trying to realloc a preserved pointer");
    }
    

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

    newPtr = TclpAlloc(reqSize);
    if (newPtr != NULL) {
	size_t maxSize = bucketInfo[bucket].blockSize - OFFSET;
	size_t toCopy = ((blockPtr->used + 1) << bucketInfo[bucket].shift);

	if (toCopy > maxSize) {
	    toCopy = maxSize;
	}
	if (toCopy > reqSize) {
	    toCopy = reqSize;
	}
	
	memcpy(newPtr, ptr, toCopy);
	TclpFree(ptr);
    }

	 * TclEventuallyFree has already been called on this with
	 * (freeProc != TCL_DYNAMIC)
	 */
	
	--blockPtr->refCount;
    } else {
	/*
	 * First preserve call: add one refcount to signal that EventuallyFree
	 * has not yet been called (role of the old '!mustFree')
	 */
  
	blockPtr->refCount = 2;
    }
}

/*