diff options
Diffstat (limited to 'generic/tclLiteral.c')
| -rw-r--r-- | generic/tclLiteral.c | 467 |
1 files changed, 165 insertions, 302 deletions
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 3966901..fb7c28a 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -7,8 +7,8 @@ * general hashtable implementation of Tcl hash tables that appears in * tclHash.c. * - * Copyright © 1997-1998 Sun Microsystems, Inc. - * Copyright © 2004 Kevin B. Kenny. All rights reserved. + * Copyright (c) 1997-1998 Sun Microsystems, Inc. + * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -31,7 +31,7 @@ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); -static unsigned HashString(const char *string, int length); +static unsigned int HashString(const char *bytes, int length); #ifdef TCL_COMPILE_DEBUG static LiteralEntry * LookupLiteralEntry(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -58,12 +58,12 @@ static void RebuildLiteralTable(LiteralTable *tablePtr); void TclInitLiteralTable( - LiteralTable *tablePtr) + register LiteralTable *tablePtr) /* Pointer to table structure, which is * supplied by the caller. */ { #if (TCL_SMALL_HASH_TABLE != 4) - Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable", + Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4", TCL_SMALL_HASH_TABLE); #endif @@ -104,7 +104,7 @@ TclDeleteLiteralTable( { LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; - size_t i; + int i; /* * Release remaining literals in the table. Note that releasing a literal @@ -114,8 +114,6 @@ TclDeleteLiteralTable( #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable((Interp *) interp); -#else - (void)interp; #endif /*TCL_COMPILE_DEBUG*/ /* @@ -133,7 +131,7 @@ TclDeleteLiteralTable( objPtr = entryPtr->objPtr; TclDecrRefCount(objPtr); nextPtr = entryPtr->nextPtr; - ckfree(entryPtr); + ckfree((char *) entryPtr); entryPtr = nextPtr; } } @@ -143,7 +141,7 @@ TclDeleteLiteralTable( */ if (tablePtr->buckets != tablePtr->staticBuckets) { - ckfree(tablePtr->buckets); + ckfree((char *) tablePtr->buckets); } } @@ -159,16 +157,16 @@ TclDeleteLiteralTable( * * Results: * The literal object. If it was created in this call *newPtr is set to - * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. + * 1, else 0. NULL is returned if newPtr==NULL and no literal is found. * * Side effects: - * Increments the ref count of the global LiteralEntry since the caller - * now holds a reference. If LITERAL_ON_HEAP is set in flags, this - * function is given ownership of the string: if an object is created - * then its string representation is set directly from string, otherwise - * the string is freed. Typically, a caller sets LITERAL_ON_HEAP if - * "string" is an already heap-allocated buffer holding the result of - * backslash substitutions. + * Increments the ref count of the global LiteralEntry since the caller + * now holds a reference. + * If LITERAL_ON_HEAP is set in flags, this function is given ownership + * of the string: if an object is created then its string representation + * is set directly from string, otherwise the string is freed. Typically, + * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated + * buffer holding the result of backslash substitutions. * *---------------------------------------------------------------------- */ @@ -176,111 +174,81 @@ TclDeleteLiteralTable( Tcl_Obj * TclCreateLiteral( Interp *iPtr, - const char *bytes, /* The start of the string. Note that this is - * not a NUL-terminated string. */ - int length, /* Number of bytes in the string. */ - unsigned hash, /* The string's hash. If -1, it will be - * computed here. */ + 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; + LiteralTable *globalTablePtr = &(iPtr->literalTable); LiteralEntry *globalPtr; - unsigned int globalHash; + int globalHash; Tcl_Obj *objPtr; /* * Is it in the interpreter's global literal table? */ - if (hash == (unsigned) -1) { + 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) { + if ((globalPtr->nsPtr == nsPtr) + && (objPtr->length == length) && ((length == 0) + || ((objPtr->bytes[0] == bytes[0]) + && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { /* - * Literals should always have UTF-8 representations... but this - * is not guaranteed so we need to be careful anyway. - * - * https://stackoverflow.com/q/54337750/301832 + * A literal was found: return it */ - int objLength; - const char *objBytes = TclGetStringFromObj(objPtr, &objLength); - - if ((objLength == length) && ((length == 0) - || ((objBytes[0] == bytes[0]) - && (memcmp(objBytes, bytes, length) == 0)))) { - /* - * A literal was found: return it - */ - - if (newPtr) { - *newPtr = 0; - } - if (globalPtrPtr) { - *globalPtrPtr = globalPtr; - } - if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); - } - if (globalPtr->refCount != TCL_INDEX_NONE) { - globalPtr->refCount++; - } - return objPtr; + 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)) { + if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } return NULL; } /* - * The literal is new to the interpreter. + * The literal is new to the interpreter. Add it to the global literal + * table. */ TclNewObj(objPtr); - if ((flags & LITERAL_ON_HEAP)) { - objPtr->bytes = (char *) bytes; + Tcl_IncrRefCount(objPtr); + if (flags & LITERAL_ON_HEAP) { + objPtr->bytes = bytes; objPtr->length = length; } else { TclInitStringRep(objPtr, bytes, length); } - /* Should the new literal be shared globally? */ - - if ((flags & LITERAL_UNSHARED)) { - /* - * No, do *not* add it the global literal table - * Make clear, that no global value is returned - */ - if (globalPtrPtr != NULL) { - *globalPtrPtr = NULL; - } - return objPtr; - } - - /* - * Yes, add it to the global literal table. - */ #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { - Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be", + (length>60? 60 : length), bytes); } #endif - globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry)); + globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry)); globalPtr->objPtr = objPtr; - Tcl_IncrRefCount(objPtr); globalPtr->refCount = 1; globalPtr->nsPtr = nsPtr; globalPtr->nextPtr = globalTablePtr->buckets[globalHash]; @@ -300,8 +268,7 @@ TclCreateLiteral( TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; - int found; - size_t i; + int found, i; found = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { @@ -313,8 +280,8 @@ TclCreateLiteral( } } if (!found) { - Tcl_Panic("%s: literal \"%.*s\" wasn't global", - "TclRegisterLiteral", (length>60? 60 : length), bytes); + Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global", + (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -336,33 +303,6 @@ TclCreateLiteral( /* *---------------------------------------------------------------------- * - * TclFetchLiteral -- - * - * Fetch from a CompileEnv the literal value identified by an index - * value, as returned by a prior call to TclRegisterLiteral(). - * - * Results: - * The literal value, or NULL if the index is out of range. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclFetchLiteral( - CompileEnv *envPtr, /* Points to the CompileEnv from which to - * fetch the registered literal value. */ - unsigned int index) /* Index of the desired literal, as returned - * by prior call to TclRegisterLiteral() */ -{ - if (index >= (unsigned int) envPtr->literalArrayNext) { - return NULL; - } - return envPtr->literalArrayPtr[index].objPtr; -} - -/* - *---------------------------------------------------------------------- - * * TclRegisterLiteral -- * * Find, or if necessary create, an object in a CompileEnv literal array @@ -389,9 +329,9 @@ TclFetchLiteral( int TclRegisterLiteral( - void *ePtr, /* Points to the CompileEnv in whose object + CompileEnv *envPtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ - const char *bytes, /* Points to string for which to find or + register char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ int length, /* Number of bytes in the string. If < 0, the @@ -399,18 +339,16 @@ TclRegisterLiteral( * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to - * this function. If LITERAL_CMD_NAME then - * the literal should not be shared across + * this function. If LITERAL_NS_SCOPE then + * the literal shouldnot be shared accross * namespaces. */ { - CompileEnv *envPtr = (CompileEnv *)ePtr; Interp *iPtr = envPtr->iPtr; - LiteralTable *localTablePtr = &envPtr->localLitTable; + LiteralTable *localTablePtr = &(envPtr->localLitTable); LiteralEntry *globalPtr, *localPtr; Tcl_Obj *objPtr; - unsigned hash; - unsigned int localHash; - int objIndex, isNew; + unsigned int hash; + int localHash, objIndex, new; Namespace *nsPtr; if (length < 0) { @@ -429,8 +367,8 @@ TclRegisterLiteral( objPtr = localPtr->objPtr; if ((objPtr->length == length) && ((length == 0) || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, length) == 0)))) { - if ((flags & LITERAL_ON_HEAP)) { + && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { + if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } objIndex = (localPtr - envPtr->literalArrayPtr); @@ -443,18 +381,14 @@ TclRegisterLiteral( } /* - * The literal is new to this CompileEnv. If it is a command name, avoid - * sharing it across namespaces, and try not to share it with non-cmd - * literals. Note that FQ command names can be shared, so that we register - * the namespace as the interp's global NS. + * The literal is new to this CompileEnv. Should it be shared accross + * namespaces? If it is a fully qualified name, the namespace + * specification is not needed to avoid sharing. */ - if ((flags & LITERAL_CMD_NAME)) { - if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) { - nsPtr = iPtr->globalNsPtr; - } else { - nsPtr = iPtr->varFramePtr->nsPtr; - } + if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr + && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) { + nsPtr = iPtr->varFramePtr->nsPtr; } else { nsPtr = NULL; } @@ -463,16 +397,14 @@ TclRegisterLiteral( * Is it in the interpreter's global literal table? If not, create it. */ - globalPtr = NULL; - objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, nsPtr, flags, - &globalPtr); + objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, + flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclRegisterLiteral", (length>60? 60 : length), bytes, - globalPtr->refCount); + if (globalPtr->refCount < 1) { + Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d", + (length>60? 60 : length), bytes, globalPtr->refCount); } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ @@ -501,14 +433,14 @@ static LiteralEntry * LookupLiteralEntry( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal + register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; - LiteralTable *globalTablePtr = &iPtr->literalTable; - LiteralEntry *entryPtr; - const char *bytes; + LiteralTable *globalTablePtr = &(iPtr->literalTable); + register LiteralEntry *entryPtr; + char *bytes; int length, globalHash; bytes = TclGetStringFromObj(objPtr, &length); @@ -547,19 +479,18 @@ void TclHideLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - CompileEnv *envPtr,/* Points to CompileEnv whose literal array + register CompileEnv *envPtr,/* Points to CompileEnv whose literal array * contains the entry being hidden. */ int index) /* The index of the entry in the literal * array. */ { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; - LiteralTable *localTablePtr = &envPtr->localLitTable; - unsigned int localHash; - int length; - const char *bytes; + LiteralTable *localTablePtr = &(envPtr->localLitTable); + int localHash, length; + char *bytes; Tcl_Obj *newObjPtr; - lPtr = &envPtr->literalArrayPtr[index]; + lPtr = &(envPtr->literalArrayPtr[index]); /* * To avoid unwanted sharing we need to copy the object and remove it from @@ -574,7 +505,7 @@ TclHideLiteral( lPtr->objPtr = newObjPtr; bytes = TclGetStringFromObj(newObjPtr, &length); - localHash = HashString(bytes, length) & localTablePtr->mask; + localHash = (HashString(bytes, length) & localTablePtr->mask); nextPtrPtr = &localTablePtr->buckets[localHash]; for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { @@ -611,14 +542,14 @@ TclHideLiteral( int TclAddLiteralObj( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ Tcl_Obj *objPtr, /* The object to insert into the array. */ LiteralEntry **litPtrPtr) /* The location where the pointer to the new * literal entry should be stored. May be * NULL. */ { - LiteralEntry *lPtr; + register LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { @@ -627,10 +558,10 @@ TclAddLiteralObj( objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; - lPtr = &envPtr->literalArrayPtr[objIndex]; + lPtr = &(envPtr->literalArrayPtr[objIndex]); lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = TCL_INDEX_NONE; /* i.e., unused */ + lPtr->refCount = -1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -653,19 +584,19 @@ TclAddLiteralObj( * * Side effects: * Expands the literal array if necessary. May rebuild the hash bucket - * array of the CompileEnv's literal array if it becomes too large. + * array of the CompileEnv's literal array if it becomes too large. * *---------------------------------------------------------------------- */ static int AddLocalLiteralEntry( - CompileEnv *envPtr,/* Points to CompileEnv in whose literal array + register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ - Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ + Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */ int localHash) /* Hash value for the literal's string. */ { - LiteralTable *localTablePtr = &envPtr->localLitTable; + register LiteralTable *localTablePtr = &(envPtr->localLitTable); LiteralEntry *localPtr; int objIndex; @@ -692,8 +623,7 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found; - size_t i; + int length, found, i; found = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { @@ -706,9 +636,9 @@ AddLocalLiteralEntry( } if (!found) { - bytes = TclGetStringFromObj(objPtr, &length); - Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : length), bytes); + bytes = Tcl_GetStringFromObj(objPtr, &length); + Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally", + (length>60? 60 : length), bytes); } } #endif /*TCL_COMPILE_DEBUG*/ @@ -738,7 +668,7 @@ AddLocalLiteralEntry( static void ExpandLocalLiteralArray( - CompileEnv *envPtr)/* Points to the CompileEnv whose object array + register CompileEnv *envPtr)/* Points to the CompileEnv whose object array * must be enlarged. */ { /* @@ -746,28 +676,28 @@ ExpandLocalLiteralArray( * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ - LiteralTable *localTablePtr = &envPtr->localLitTable; - size_t currElems = envPtr->literalArrayNext; + LiteralTable *localTablePtr = &(envPtr->localLitTable); + int currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; - size_t i; - size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; + int i; + unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { - Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded", + Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", currElems); } if (envPtr->mallocedLiteralArray) { - newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize); + newArrayPtr = (LiteralEntry *) ckrealloc( + (char *)currArrayPtr, newSize); } else { /* * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must - * code a ckrealloc equivalent for ourselves. + * code a ckrealloc equivalent for ourselves */ - - newArrayPtr = (LiteralEntry *)ckalloc(newSize); + newArrayPtr = (LiteralEntry *) ckalloc(newSize); memcpy(newArrayPtr, currArrayPtr, currBytes); envPtr->mallocedLiteralArray = 1; } @@ -820,22 +750,16 @@ void TclReleaseLiteral( Tcl_Interp *interp, /* Interpreter for which objPtr was created to * hold a literal. */ - Tcl_Obj *objPtr) /* Points to a literal object that was + register Tcl_Obj *objPtr) /* Points to a literal object that was * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; - LiteralTable *globalTablePtr; - LiteralEntry *entryPtr, *prevPtr; - const char *bytes; - int length; - unsigned int index; - - if (iPtr == NULL) { - goto done; - } + LiteralTable *globalTablePtr = &(iPtr->literalTable); + register LiteralEntry *entryPtr, *prevPtr; + char *bytes; + int length, index; - globalTablePtr = &iPtr->literalTable; bytes = TclGetStringFromObj(objPtr, &length); index = (HashString(bytes, length) & globalTablePtr->mask); @@ -848,19 +772,21 @@ TclReleaseLiteral( for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index]; entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) { if (entryPtr->objPtr == objPtr) { + entryPtr->refCount--; + /* * If the literal is no longer being used by any ByteCode, delete * the entry then remove the reference corresponding to the global * literal table entry (decrement the ref count of the object). */ - if ((entryPtr->refCount != TCL_INDEX_NONE) && (entryPtr->refCount-- <= 1)) { + if (entryPtr->refCount == 0) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { prevPtr->nextPtr = entryPtr->nextPtr; } - ckfree(entryPtr); + ckfree((char *) entryPtr); globalTablePtr->numEntries--; TclDecrRefCount(objPtr); @@ -877,7 +803,6 @@ TclReleaseLiteral( * Remove the reference corresponding to the local literal table entry. */ - done: Tcl_DecrRefCount(objPtr); } @@ -898,12 +823,13 @@ TclReleaseLiteral( *---------------------------------------------------------------------- */ -static unsigned +static unsigned int HashString( - const char *string, /* String for which to compute hash value. */ + register const char *bytes, /* String for which to compute hash value. */ int length) /* Number of bytes in the string. */ { - unsigned int result = 0; + register unsigned int result; + register int i; /* * I tried a zillion different hash functions and asked many other people @@ -913,33 +839,17 @@ HashString( * following reasons: * * 1. Multiplying by 10 is perfect for keys that are decimal strings, and - * multiplying by 9 is just about as good. + * multiplying by 9 is just about as good. * 2. Times-9 is (shift-left-3) plus (old). This means that each - * character's bits hang around in the low-order bits of the hash value - * for ever, plus they spread fairly rapidly up to the high-order bits - * to fill out the hash value. This seems works well both for decimal - * and non-decimal strings. - * - * Note that this function is very weak against malicious strings; it's - * very easy to generate multiple keys that have the same hashcode. On the - * other hand, that hardly ever actually occurs and this function *is* - * very cheap, even by comparison with industry-standard hashes like FNV. - * If real strength of hash is required though, use a custom hash based on - * Bob Jenkins's lookup3(), but be aware that it's significantly slower. - * Tcl scripts tend to not have a big issue in this area, and literals - * mostly aren't looked up by name anyway. - * - * See also HashStringKey in tclHash.c. - * See also TclObjHashKey in tclObj.c. - * - * See [tcl-Feature Request #2958832] + * character's bits hang around in the low-order bits of the hash value + * for ever, plus they spread fairly rapidly up to the high-order bits + * to fill out the hash value. This seems works well both for decimal + * and non-decimal strings. */ - if (length > 0) { - result = UCHAR(*string); - while (--length) { - result += (result << 3) + UCHAR(*++string); - } + result = 0; + for (i=0 ; i<length ; i++) { + result += (result<<3) + bytes[i]; } return result; } @@ -964,16 +874,16 @@ HashString( static void RebuildLiteralTable( - LiteralTable *tablePtr) + register LiteralTable *tablePtr) /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; - LiteralEntry **oldChainPtr, **newChainPtr; - LiteralEntry *entryPtr; + register LiteralEntry **oldChainPtr, **newChainPtr; + register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; - const char *bytes; - unsigned int oldSize, index; - int count, length; + char *bytes; + unsigned int oldSize; + int count, index, length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -994,8 +904,8 @@ RebuildLiteralTable( } tablePtr->numBuckets *= 4; - tablePtr->buckets = (LiteralEntry **)ckalloc( - tablePtr->numBuckets * sizeof(LiteralEntry*)); + tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned) + (tablePtr->numBuckets * sizeof(LiteralEntry *))); for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets; count>0 ; count--, newChainPtr++) { *newChainPtr = NULL; @@ -1013,7 +923,7 @@ RebuildLiteralTable( index = (HashString(bytes, length) & tablePtr->mask); *oldChainPtr = entryPtr->nextPtr; - bucketPtr = &tablePtr->buckets[index]; + bucketPtr = &(tablePtr->buckets[index]); entryPtr->nextPtr = *bucketPtr; *bucketPtr = entryPtr; } @@ -1024,52 +934,7 @@ RebuildLiteralTable( */ if (oldBuckets != tablePtr->staticBuckets) { - ckfree(oldBuckets); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclInvalidateCmdLiteral -- - * - * Invalidate a command literal entry, if present in the literal hash - * tables, by resetting its internal representation. This invalidation - * leaves it in the literal tables and in existing literal arrays. As a - * result, existing references continue to work but we force a fresh - * command look-up upon the next use (see, in particular, - * TclSetCmdNameObj()). - * - * Results: - * None. - * - * Side effects: - * Resets the internal representation of the CmdName Tcl_Obj - * using TclFreeInternalRep(). - * - *---------------------------------------------------------------------- - */ - -void -TclInvalidateCmdLiteral( - Tcl_Interp *interp, /* Interpreter for which to invalidate a - * command literal. */ - const char *name, /* Points to the start of the cmd literal - * name. */ - Namespace *nsPtr) /* The namespace for which to lookup and - * invalidate a cmd literal. */ -{ - Interp *iPtr = (Interp *) interp; - Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name, - strlen(name), -1, NULL, nsPtr, 0, NULL); - - if (literalObjPtr != NULL) { - if (TclHasInternalRep(literalObjPtr, &tclCmdNameType)) { - TclFreeInternalRep(literalObjPtr); - } - /* Balance the refcount effects of TclCreateLiteral() above */ - Tcl_IncrRefCount(literalObjPtr); - TclReleaseLiteral(interp, literalObjPtr); + ckfree((char *) oldBuckets); } } @@ -1097,11 +962,9 @@ TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - size_t count[NUM_COUNTERS]; - int overflow; - size_t i, j; + int count[NUM_COUNTERS], overflow, i, j; double average, tmp; - LiteralEntry *entryPtr; + register LiteralEntry *entryPtr; char *result, *p; /* @@ -1133,19 +996,19 @@ TclLiteralStats( * Print out the histogram and a few other pieces of information. */ - result = (char *)ckalloc(NUM_COUNTERS*60 + 300); - snprintf(result, 60, "%d entries in table, %d buckets\n", + 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++) { - snprintf(p, 60, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", + sprintf(p, "number of buckets with %d entries: %d\n", i, count[i]); p += strlen(p); } - snprintf(p, 60, "number of buckets with %d or more entries: %d\n", + sprintf(p, "number of buckets with %d or more entries: %d\n", NUM_COUNTERS, overflow); p += strlen(p); - snprintf(p, 60, "average search distance for entry: %.1f", average); + sprintf(p, "average search distance for entry: %.1f", average); return result; } #endif /*TCL_COMPILE_STATS*/ @@ -1172,33 +1035,36 @@ TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { - LiteralTable *localTablePtr = &envPtr->localLitTable; - LiteralEntry *localPtr; + register LiteralTable *localTablePtr = &(envPtr->localLitTable); + register LiteralEntry *localPtr; char *bytes; - size_t i, count; - int length; + 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 != TCL_INDEX_NONE) { - bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", - "TclVerifyLocalLiteralTable", + if (localPtr->refCount != -1) { + bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); + Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d", (length>60? 60 : length), bytes, localPtr->refCount); } + if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, + localPtr->objPtr) == NULL) { + bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); + Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global", + (length>60? 60 : length), bytes); + } if (localPtr->objPtr->bytes == NULL) { - Tcl_Panic("%s: literal has NULL string rep", - "TclVerifyLocalLiteralTable"); + Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep"); } } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %u", - "TclVerifyLocalLiteralTable", count, - localTablePtr->numEntries); + Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d", + count, localTablePtr->numEntries); } } @@ -1223,33 +1089,30 @@ TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { - LiteralTable *globalTablePtr = &iPtr->literalTable; - LiteralEntry *globalPtr; + register LiteralTable *globalTablePtr = &(iPtr->literalTable); + register LiteralEntry *globalPtr; char *bytes; - size_t i, count; - int length; + register int i; + int length, count; count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; - if (globalPtr->refCount + 1 < 2) { - bytes = TclGetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclVerifyGlobalLiteralTable", + if (globalPtr->refCount < 1) { + bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); + Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d", (length>60? 60 : length), bytes, globalPtr->refCount); } if (globalPtr->objPtr->bytes == NULL) { - Tcl_Panic("%s: literal has NULL string rep", - "TclVerifyGlobalLiteralTable"); + Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep"); } } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %u", - "TclVerifyGlobalLiteralTable", count, - globalTablePtr->numEntries); + Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d", + count, globalTablePtr->numEntries); } } #endif /*TCL_COMPILE_DEBUG*/ |