static Tcl_HashEntry *
AllocThreadStorageEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key to store in the hash table entry. */
{
Tcl_HashEntry *hPtr;
hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
hPtr->key.oneWordValue = keyPtr;
hPtr->clientData = NULL;
return hPtr;
}
void *TclpThreadCreateKey(void) {
pthread_key_t *key;
key = TclpSysAlloc(sizeof *key, 0);
if (NULL == key) {
Tcl_Panic("unable to allocate thread key!");
}
if (pthread_key_create(key, NULL)) {
Tcl_Panic("unable to create pthread key!");
}
return key;
}
void *
TclpThreadCreateKey(void)
{
pthread_key_t *ptkeyPtr;
ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0);
if (NULL == ptkeyPtr) {
Tcl_Panic("unable to allocate thread key!");
}
if (pthread_key_create(ptkeyPtr, NULL)) {
Tcl_Panic("unable to create pthread key!");
}
return ptkeyPtr;
}
void *TclpThreadCreateKey (void) {
DWORD *key;
key = TclpSysAlloc(sizeof *key, 0);
if (key == NULL) {
Tcl_Panic("unable to allocate thread key!");
}
*key = TlsAlloc();
if (*key == TLS_OUT_OF_INDEXES) {
Tcl_Panic("unable to allocate thread-local storage");
}
return key;
}
static void
MoreCore(
int bucket) /* What bucket to allocat to. */
{
register union overhead *overPtr;
register long size; /* size of desired block */
long amount; /* amount to allocate */
int numBlocks; /* how many blocks we get */
struct block *blockPtr;
/*
* sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
* VAX, I think) or for a negative arg.
*/
size = 1 << (bucket + 3);
ASSERT(size > 0);
amount = MAXMALLOC;
numBlocks = amount / size;
ASSERT(numBlocks*size == amount);
blockPtr = (struct block *) TclpSysAlloc((unsigned)
(sizeof(struct block) + amount), 1);
/* no more room! */
if (blockPtr == NULL) {
return;
}
blockPtr->nextPtr = blockList;
blockList = blockPtr;
overPtr = (union overhead *) (blockPtr + 1);
/*
* Add new memory allocated to that on free list for this hash bucket.
*/
nextf[bucket] = overPtr;
while (--numBlocks > 0) {
overPtr->next = (union overhead *)((caddr_t)overPtr + size);
overPtr = (union overhead *)((caddr_t)overPtr + size);
}
overPtr->next = NULL;
}
char *
TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
register union overhead *overPtr;
register long bucket;
register unsigned amount;
struct block *bigBlockPtr;
if (!allocInit) {
/*
* We have to make the "self initializing" because Tcl_Alloc may be
* used before any other part of Tcl. E.g., see main() for tclsh!
*/
TclInitAlloc();
}
Tcl_MutexLock(allocMutexPtr);
/*
* First the simple case: we simple allocate big blocks directly.
*/
if (numBytes + OVERHEAD >= MAXMALLOC) {
bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
(sizeof(struct block) + OVERHEAD + numBytes), 0);
if (bigBlockPtr == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
bigBlockPtr->nextPtr = bigBlocks.nextPtr;
bigBlocks.nextPtr = bigBlockPtr;
bigBlockPtr->prevPtr = &bigBlocks;
bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
overPtr = (union overhead *) (bigBlockPtr + 1);
overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
overPtr->bucketIndex = 0xff;
#ifdef MSTATS
numMallocs[NBUCKETS]++;
#endif
#ifdef RCHECK
/*
* Record allocated size of block and bound space with magic numbers.
*/
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
overPtr->rangeCheckMagic = RMAGIC;
BLOCK_END(overPtr) = RMAGIC;
#endif
Tcl_MutexUnlock(allocMutexPtr);
return (void *)(overPtr+1);
}
/*
* Convert amount of memory requested into closest block size stored in
* hash buckets which satisfies request. Account for space used per block
* for accounting.
*/
amount = MINBLOCK; /* size of first bucket */
bucket = MINBLOCK >> 4;
while (numBytes + OVERHEAD > amount) {
amount <<= 1;
if (amount == 0) {
Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
bucket++;
}
ASSERT(bucket < NBUCKETS);
/*
* If nothing in hash bucket right now, request more memory from the
* system.
*/
if ((overPtr = nextf[bucket]) == NULL) {
MoreCore(bucket);
if ((overPtr = nextf[bucket]) == NULL) {
Tcl_MutexUnlock(allocMutexPtr);
return NULL;
}
}
/*
* Remove from linked list
*/
nextf[bucket] = overPtr->next;
overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
overPtr->bucketIndex = (unsigned char) bucket;
#ifdef MSTATS
numMallocs[bucket]++;
#endif
#ifdef RCHECK
/*
* Record allocated size of block and bound space with magic numbers.
*/
overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
overPtr->rangeCheckMagic = RMAGIC;
BLOCK_END(overPtr) = RMAGIC;
#endif
Tcl_MutexUnlock(allocMutexPtr);
return ((char *)(overPtr + 1));
}
static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
int oldSize, count, index;
Tcl_HashEntry **oldBuckets;
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
register Tcl_HashEntry *hPtr;
const Tcl_HashKeyType *typePtr;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
typePtr = &tclOneWordHashKeyType;
} else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
|| tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
typePtr = tablePtr->typePtr;
} else {
typePtr = &tclArrayHashKeyType;
}
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
/*
* Allocate and initialize the new bucket array, and set up hashing
* constants for new array size.
*/
tablePtr->numBuckets *= 4;
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
} else {
tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
}
for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
count > 0; count--, newChainPtr++) {
*newChainPtr = NULL;
}
tablePtr->rebuildSize *= 4;
tablePtr->downShift -= 2;
tablePtr->mask = (tablePtr->mask << 2) + 3;
/*
* Rehash all of the existing entries into the new bucket array.
*/
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX (tablePtr, hPtr->hash);
} else {
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
#else
void *key = Tcl_GetHashKey(tablePtr, hPtr);
if (typePtr->hashKeyProc) {
unsigned int hash;
hash = typePtr->hashKeyProc(tablePtr, key);
if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX (tablePtr, hash);
} else {
index = hash & tablePtr->mask;
}
} else {
index = RANDOM_INDEX (tablePtr, key);
}
hPtr->bucketPtr = &(tablePtr->buckets[index]);
hPtr->nextPtr = *hPtr->bucketPtr;
*hPtr->bucketPtr = hPtr;
#endif
}
}
/*
* Free up the old bucket array, if it was dynamically allocated.
*/
if (oldBuckets != tablePtr->staticBuckets) {
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
TclpSysFree((char *) oldBuckets);
} else {
ckfree((char *) oldBuckets);
}
}
}
const char *
Tcl_HashStats(
Tcl_HashTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
int count[NUM_COUNTERS], overflow, i, j;
double average, tmp;
register Tcl_HashEntry *hPtr;
char *result, *p;
const Tcl_HashKeyType *typePtr;
if (tablePtr->keyType == TCL_STRING_KEYS) {
typePtr = &tclStringHashKeyType;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
typePtr = &tclOneWordHashKeyType;
} else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
|| tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
typePtr = tablePtr->typePtr;
} else {
typePtr = &tclArrayHashKeyType;
}
/*
* Compute a histogram of bucket usage.
*/
for (i = 0; i < NUM_COUNTERS; i++) {
count[i] = 0;
}
overflow = 0;
average = 0.0;
for (i = 0; i < tablePtr->numBuckets; i++) {
j = 0;
for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
j++;
}
if (j < NUM_COUNTERS) {
count[j]++;
} else {
overflow++;
}
tmp = j;
if (tablePtr->numEntries != 0) {
average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
}
}
/*
* Print out the histogram and a few other pieces of information.
*/
if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
result = (char *) TclpSysAlloc((unsigned) (NUM_COUNTERS*60) + 300, 0);
} else {
result = (char *) ckalloc((unsigned) (NUM_COUNTERS*60) + 300);
}
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
for (i = 0; i < NUM_COUNTERS; i++) {
sprintf(p, "number of buckets with %d entries: %d\n",
i, count[i]);
p += strlen(p);
}
sprintf(p, "number of buckets with %d or more entries: %d\n",
NUM_COUNTERS, overflow);
p += strlen(p);
sprintf(p, "average search distance for entry: %.1f", average);
return result;
}
static Tcl_HashTable *
ThreadStorageGetHashTable(
Tcl_ThreadId id) /* Id of thread to get hash table for */
{
int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
Tcl_HashEntry *hPtr;
int isNew;
Tcl_HashTable *hashTablePtr;
/*
* It's important that we pick up the hash table pointer BEFORE comparing
* thread Id in case another thread is in the critical region changing
* things out from under you.
*
* Thread safety: threadStorageCache is accessed w/o locks in order to
* avoid serialization of all threads at this hot-spot. It is safe to
* do this here because (threadStorageCache[index].id != id) test below
* should be atomic on all (currently) supported platforms and there
* are no devastatig side effects of the test.
*
* Note Valgrind users: this place will show up as a race-condition in
* helgrind-tool output. To silence this warnings, define VALGRIND
* symbol at compilation time.
*/
#if !defined(VALGRIND)
hashTablePtr = threadStorageCache[index].hashTablePtr;
if (threadStorageCache[index].id != id) {
Tcl_MutexLock(&threadStorageLock);
#else
Tcl_MutexLock(&threadStorageLock);
hashTablePtr = threadStorageCache[index].hashTablePtr;
if (threadStorageCache[index].id != id) {
#endif
/*
* It's not in the cache, so we look it up...
*/
hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *) id);
if (hPtr != NULL) {
/*
* We found it, extract the hash table pointer.
*/
hashTablePtr = Tcl_GetHashValue(hPtr);
} else {
/*
* The thread specific hash table is not found.
*/
hashTablePtr = NULL;
}
if (hashTablePtr == NULL) {
hashTablePtr = (Tcl_HashTable *)
TclpSysAlloc(sizeof(Tcl_HashTable), 0);
if (hashTablePtr == NULL) {
Tcl_Panic("could not allocate thread specific hash table, "
"TclpSysAlloc failed from ThreadStorageGetHashTable!");
}
Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
&tclThreadStorageHashKeyType);
/*
* Add new thread storage hash table to the master hash table.
*/
hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id,
&isNew);
if (hPtr == NULL) {
Tcl_Panic("Tcl_CreateHashEntry failed from "
"ThreadStorageGetHashTable!");
}
Tcl_SetHashValue(hPtr, hashTablePtr);
}
/*
* Now, we put it in the cache since it is highly likely it will be
* needed again shortly.
*/
threadStorageCache[index].id = id;
threadStorageCache[index].hashTablePtr = hashTablePtr;
#if !defined(VALGRIND)
Tcl_MutexUnlock(&threadStorageLock);
}
#else
}
Tcl_MutexUnlock(&threadStorageLock);
#endif
return hashTablePtr;
}
static Tcl_HashTable *
ThreadStorageGetHashTable(
Tcl_ThreadId id) /* Id of thread to get hash table for */
{
int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
Tcl_HashEntry *hPtr;
int isNew;
/*
* It's important that we pick up the hash table pointer BEFORE comparing
* thread Id in case another thread is in the critical region changing
* things out from under you.
*/
Tcl_HashTable *hashTablePtr = threadStorageCache[index].hashTablePtr;
if (threadStorageCache[index].id != id) {
Tcl_MutexLock(&threadStorageLock);
/*
* It's not in the cache, so we look it up...
*/
hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *) id);
if (hPtr != NULL) {
/*
* We found it, extract the hash table pointer.
*/
hashTablePtr = Tcl_GetHashValue(hPtr);
} else {
/*
* The thread specific hash table is not found.
*/
hashTablePtr = NULL;
}
if (hashTablePtr == NULL) {
hashTablePtr = (Tcl_HashTable *)
TclpSysAlloc(sizeof(Tcl_HashTable), 0);
if (hashTablePtr == NULL) {
Tcl_Panic("could not allocate thread specific hash table, "
"TclpSysAlloc failed from ThreadStorageGetHashTable!");
}
Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
&tclThreadStorageHashKeyType);
/*
* Add new thread storage hash table to the master hash table.
*/
hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id,
&isNew);
if (hPtr == NULL) {
Tcl_Panic("Tcl_CreateHashEntry failed from "
"ThreadStorageGetHashTable!");
}
Tcl_SetHashValue(hPtr, hashTablePtr);
}
/*
* Now, we put it in the cache since it is highly likely it will be
* needed again shortly.
*/
threadStorageCache[index].id = id;
threadStorageCache[index].hashTablePtr = hashTablePtr;
Tcl_MutexUnlock(&threadStorageLock);
}
return hashTablePtr;
}