void
TclVerifyLocalLiteralTable(
CompileEnv *envPtr) /* Points to CompileEnv whose literal table is
* to be validated. */
{
register LiteralTable *localTablePtr = &envPtr->localLitTable;
register LiteralEntry *localPtr;
char *bytes;
register int i;
int length, count;
count = 0;
for (i=0 ; i<localTablePtr->numBuckets ; i++) {
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
count++;
if (localPtr->refCount != -1) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
"TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes, localPtr->refCount);
}
if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" is not global",
"TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes);
}
if (localPtr->objPtr->bytes == NULL) {
Tcl_Panic("%s: literal has NULL string rep",
"TclVerifyLocalLiteralTable");
}
}
}
if (count != localTablePtr->numEntries) {
Tcl_Panic("%s: local literal table had %d entries, should be %d",
"TclVerifyLocalLiteralTable", count,
localTablePtr->numEntries);
}
}
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
char *bytes,
int length,
unsigned int hash, /* The string's hash. If -1, it will be computed here */
int *newPtr,
Namespace *nsPtr,
int flags,
LiteralEntry **globalPtrPtr)
{
LiteralTable *globalTablePtr = &(iPtr->literalTable);
LiteralEntry *globalPtr;
int globalHash;
Tcl_Obj *objPtr;
/*
* Is it in the interpreter's global literal table?
*/
if (hash == (unsigned int) -1) {
hash = HashString(bytes, length);
}
globalHash = (hash & globalTablePtr->mask);
for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
if ((globalPtr->nsPtr == nsPtr)
&& (objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
/*
* A literal was found: return it
*/
if (newPtr) {
*newPtr = 0;
}
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
globalPtr->refCount++;
return objPtr;
}
}
if (!newPtr) {
if (flags & LITERAL_ON_HEAP) {
ckfree(bytes);
}
return NULL;
}
/*
* The literal is new to the interpreter. Add it to the global literal
* table.
*/
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
if (flags & LITERAL_ON_HEAP) {
objPtr->bytes = bytes;
objPtr->length = length;
} else {
TclInitStringRep(objPtr, bytes, length);
}
#ifdef TCL_COMPILE_DEBUG
if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
(length>60? 60 : length), bytes);
}
#endif
globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
globalPtr->refCount = 1;
globalPtr->nsPtr = nsPtr;
globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
globalTablePtr->buckets[globalHash] = globalPtr;
globalTablePtr->numEntries++;
/*
* If the global literal table has exceeded a decent size, rebuild it with
* more buckets.
*/
if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
RebuildLiteralTable(globalTablePtr);
}
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
{
LiteralEntry *entryPtr;
int found, i;
found = 0;
for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
entryPtr=entryPtr->nextPtr) {
if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
found = 1;
}
}
}
if (!found) {
Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
(length>60? 60 : length), bytes);
}
}
#endif /*TCL_COMPILE_DEBUG*/
#ifdef TCL_COMPILE_STATS
iPtr->stats.numLiteralsCreated++;
iPtr->stats.totalLitStringBytes += (double) (length + 1);
iPtr->stats.currentLitStringBytes += (double) (length + 1);
iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
*newPtr = 1;
return objPtr;
}
