* Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK

 *
 * IMPORTANT NOTE: the buckets have to be kept at the start, as the macros for
 * TclSmallAlloc in tclInt.h assume that the smallest block
 */

typedef struct Cache {
    Bucket buckets[NBUCKETS];	/* The buckets for this thread */


    struct Cache *nextPtr;	/* Linked list of cache entries */
    Tcl_ThreadId owner;		/* Which thread's cache is this? */
    int totalAssigned;		/* Total space assigned to thread */

} Cache;




/*
 * 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 maxBlocks;		/* Max blocks before move to share. */
    int numMove;		/* Num blocks to move to share. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */

} bucketInfo[NBUCKETS];

/*
 * Static functions defined in this file.
 */

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);
static inline Block *	Ptr2Block(char *ptr);
static inline char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);

/*
 * 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;


static Cache *firstCachePtr = &sharedCache;

/*
 *----------------------------------------------------------------------
 *
 * Block2Ptr, Ptr2Block --
 *
 *	Convert between internal blocks and user pointers.

 *----------------------------------------------------------------------
 */

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.
     */

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = calloc(1, sizeof(Cache));
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}

	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
	Tcl_MutexUnlock(listLockPtr);
	cachePtr->owner = Tcl_GetCurrentThread();
	TclpSetAllocCache(cachePtr);

    }

    return cachePtr;
}


/*
 *----------------------------------------------------------------------
 *
 * TclFreeAllocCache --
 *
 *	Flush and delete a cache, removing from list of caches.
 *

	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
    }
    *nextPtrPtr = cachePtr->nextPtr;
    cachePtr->nextPtr = NULL;
    Tcl_MutexUnlock(listLockPtr);
    free(cachePtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptAlloc --
 *
 *	Allocate memory.

char *
Tcl_AttemptAlloc(
    unsigned int reqSize)
{
    Cache *cachePtr;

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }
    return TclAttemptAlloc(cachePtr, reqSize);
}

char *
TclAttemptAlloc(
    void *vcachePtr,
    unsigned int reqSize)

void
Tcl_Free(
    char *ptr)
{
    Cache *cachePtr;

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }
    return TclFree(cachePtr, ptr);
}

void
TclFree(
    void *vcachePtr,
    char *ptr)

    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
    cachePtr->buckets[bucket].firstPtr = blockPtr;
    cachePtr->buckets[bucket].numFree++;
    cachePtr->buckets[bucket].numInserts++;


    if (cachePtr != sharedPtr &&
	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
    }

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptRealloc --
 *

char *
Tcl_AttemptRealloc(  
    char *ptr,
    unsigned int reqSize)
{
    Cache *cachePtr;

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }
    return TclAttemptRealloc(cachePtr, ptr, reqSize);
}

char *
TclAttemptRealloc(  
    void *vcachePtr,
    char *ptr,

    Tcl_MutexLock(listLockPtr);
    cachePtr = firstCachePtr;
    while (cachePtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");

	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);

	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
		    (unsigned long) bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	Tcl_DStringEndSublist(dsPtr);

	cachePtr = cachePtr->nextPtr;



    }
    Tcl_MutexUnlock(listLockPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * LockBucket, UnlockBucket --
 *
 *	Set/unset the lock to access a bucket in the shared cache.
 *

    LockBucket(cachePtr, bucket);
    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
    sharedPtr->buckets[bucket].firstPtr = firstPtr;
    sharedPtr->buckets[bucket].numFree += numMove;
    UnlockBucket(cachePtr, bucket);
}


/*
 *----------------------------------------------------------------------
 *
 * GetBlocks --
 *
 *	Get more blocks for a bucket.

GetBlocks(
    Cache *cachePtr,
    int bucket)
{
    register Block *blockPtr;
    register int n;


    /*
     * First, atttempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */

		}
		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
		blockPtr->nextBlock = NULL;
	    }
	}
	UnlockBucket(cachePtr, bucket);
    }


    if (cachePtr->buckets[bucket].numFree == 0) {
	register size_t size;

	/*
	 * If no blocks could be moved from shared, first look for a larger
	 * block in this cache to split up.
	 */

	    blockPtr = blockPtr->nextBlock;
	}
	blockPtr->nextBlock = NULL;
    }
    return 1;
}


/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAlloc --
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.

    objLockPtr = NULL;

    TclpFreeAllocMutex(listLockPtr);
    listLockPtr = NULL;

    TclpFreeAllocCache(NULL);
}

#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
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */