diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompile.c | 77 | ||||
-rw-r--r-- | generic/tclCompile.h | 23 | ||||
-rw-r--r-- | generic/tclLiteral.c | 327 | ||||
-rw-r--r-- | generic/tclProc.c | 6 | ||||
-rwxr-xr-x[-rw-r--r--] | generic/tclStrToD.c | 0 | ||||
-rw-r--r-- | generic/tclStubLibTbl.c | 58 |
6 files changed, 139 insertions, 352 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 0024f1e..fd24cfd 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1062,7 +1062,7 @@ CleanupByteCode( /* * A single heap object holds the ByteCode structure and its code, object, * command location, and auxiliary data arrays. This means we only need to - * 1) decrement the ref counts of the LiteralEntry's in its literal array, + * 1) decrement the ref counts of the literal values in its literal array, * 2) call the free procs for the auxiliary data items, 3) free the * localCache if it is unused, and finally 4) free the ByteCode * structure's heap object. @@ -1098,6 +1098,9 @@ CleanupByteCode( TclReleaseLiteral(interp, *objArrayPtr++); } } + if (codePtr->flags & TCL_BYTECODE_FREE_LITERALS) { + ckfree(codePtr->objArrayPtr); + } auxDataPtr = codePtr->auxDataArrayPtr; for (i = 0; i < numAuxDataItems; i++) { @@ -1433,7 +1436,7 @@ TclInitCompileEnv( envPtr->maxExceptDepth = 0; envPtr->maxStackDepth = 0; envPtr->currStackDepth = 0; - TclInitLiteralTable(&envPtr->localLitTable); + Tcl_InitHashTable(&envPtr->litMap, TCL_ONE_WORD_KEYS); envPtr->codeStart = envPtr->staticCodeSpace; envPtr->codeNext = envPtr->codeStart; @@ -1620,10 +1623,7 @@ void TclFreeCompileEnv( register CompileEnv *envPtr)/* Points to the CompileEnv structure. */ { - if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){ - ckfree(envPtr->localLitTable.buckets); - envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets; - } + Tcl_DeleteHashTable(&envPtr->litMap); if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would @@ -1631,12 +1631,11 @@ TclFreeCompileEnv( */ int i; - LiteralEntry *entryPtr = envPtr->literalArrayPtr; + Tcl_Obj **litPtr = envPtr->literalArrayPtr; AuxData *auxDataPtr = envPtr->auxDataArrayPtr; for (i = 0; i < envPtr->literalArrayNext; i++) { - TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr); - entryPtr++; + TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, *litPtr++); } #ifdef TCL_COMPILE_DEBUG @@ -1653,7 +1652,7 @@ TclFreeCompileEnv( if (envPtr->mallocedCodeArray) { ckfree(envPtr->codeStart); } - if (envPtr->mallocedLiteralArray) { + if (envPtr->mallocedLiteralArray && envPtr->iPtr) { ckfree(envPtr->literalArrayPtr); } if (envPtr->mallocedExceptArray) { @@ -2713,30 +2712,26 @@ PreventCycle( Tcl_Obj *objPtr, CompileEnv *envPtr) { - int i; - - for (i = 0; i < envPtr->literalArrayNext; i++) { - if (objPtr == TclFetchLiteral(envPtr, i)) { - /* - * Prevent circular reference where the bytecode intrep of - * a value contains a literal which is that same value. - * If this is allowed to happen, refcount decrements may not - * reach zero, and memory may leak. Bugs 467523, 3357771 - * - * NOTE: [Bugs 3392070, 3389764] We make a copy based completely - * on the string value, and do not call Tcl_DuplicateObj() so we - * can be sure we do not have any lingering cycles hiding in - * the intrep. - */ - int numBytes; - const char *bytes = TclGetStringFromObj(objPtr, &numBytes); - Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(&envPtr->litMap, objPtr); + if (hePtr) { + /* + * Prevent circular reference where the bytecode intrep of + * a value contains a literal which is that same value. + * If this is allowed to happen, refcount decrements may not + * reach zero, and memory may leak. Bugs 467523, 3357771 + * + * NOTE: [Bugs 3392070, 3389764] We make a copy based completely + * on the string value, and do not call Tcl_DuplicateObj() so we + * can be sure we do not have any lingering cycles hiding in + * the intrep. + */ - Tcl_IncrRefCount(copyPtr); - TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); + int numBytes, i = PTR2INT(Tcl_GetHashValue(hePtr)); + const char *bytes = TclGetStringFromObj(objPtr, &numBytes); - envPtr->literalArrayPtr[i].objPtr = copyPtr; - } + envPtr->literalArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); + Tcl_IncrRefCount(envPtr->literalArrayPtr[i]); + TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); } } @@ -2754,7 +2749,7 @@ TclInitByteCode( #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; - int i, isNew; + int isNew; Interp *iPtr; if (envPtr->iPtr == NULL) { @@ -2764,7 +2759,8 @@ TclInitByteCode( iPtr = envPtr->iPtr; codeBytes = envPtr->codeNext - envPtr->codeStart; - objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *); + objArrayBytes = envPtr->mallocedLiteralArray ? 0 : + envPtr->literalArrayNext * sizeof(Tcl_Obj *); exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData); cmdLocBytes = GetCmdLocEncodingSize(envPtr); @@ -2815,14 +2811,17 @@ TclInitByteCode( p += sizeof(ByteCode); codePtr->codeStart = p; memcpy(p, envPtr->codeStart, (size_t) codeBytes); - p += TCL_ALIGN(codeBytes); /* align object array */ - codePtr->objArrayPtr = (Tcl_Obj **) p; - for (i = 0; i < numLitObjects; i++) { - codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i); + + if (envPtr->mallocedLiteralArray) { + codePtr->objArrayPtr = envPtr->literalArrayPtr; + codePtr->flags |= TCL_BYTECODE_FREE_LITERALS; + } else { + codePtr->objArrayPtr = (Tcl_Obj **) p; + memcpy(p, envPtr->literalArrayPtr, (size_t) objArrayBytes); + p += TCL_ALIGN(objArrayBytes); /* align exception range array */ } - p += TCL_ALIGN(objArrayBytes); /* align exception range array */ if (exceptArrayBytes > 0) { codePtr->exceptArrayPtr = (ExceptionRange *) p; memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f99c07c..e271d9e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -305,19 +305,17 @@ typedef struct CompileEnv { * execute the code. Set by compilation * procedures before returning. */ int currStackDepth; /* Current stack depth. */ - LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl - * objects referenced by this compiled code. - * Indexed by the string representations of - * the literals. Used to avoid creating - * duplicate objects. */ + Tcl_HashTable litMap; /* Map from literal value to int index where + * that value is stored in literalArrayPtr. + * Used to prevent dup value refs. */ unsigned char *codeStart; /* Points to the first byte of the code. */ unsigned char *codeNext; /* Points to next code array byte to use. */ unsigned char *codeEnd; /* Points just after the last allocated code * array byte. */ int mallocedCodeArray; /* Set 1 if code array was expanded and * codeStart points into the heap.*/ - LiteralEntry *literalArrayPtr; - /* Points to start of LiteralEntry array. */ + Tcl_Obj **literalArrayPtr; + /* Points of array of literal values. */ int literalArrayNext; /* Index of next free object array entry. */ int literalArrayEnd; /* Index just after last obj array entry. */ int mallocedLiteralArray; /* 1 if object array was expanded and objArray @@ -355,8 +353,8 @@ typedef struct CompileEnv { * auxDataArrayPtr points in heap else 0. */ unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES]; /* Initial storage for code. */ - LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; - /* Initial storage of LiteralEntry array. */ + Tcl_Obj *staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS]; + /* Initial storage of literal value array. */ ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; /* Initial ExceptionRange array storage. */ ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES]; @@ -411,6 +409,8 @@ typedef struct CompileEnv { #define TCL_BYTECODE_RECOMPILE 0x0004 +#define TCL_BYTECODE_FREE_LITERALS 0x0008 + typedef struct ByteCode { TclHandle interpHandle; /* Handle for interpreter containing the * compiled code. Commands and their compile @@ -1095,10 +1095,7 @@ MODULE_SCOPE int TclCreateAuxData(ClientData clientData, MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size); -MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, - int length, unsigned int hash, int *newPtr, - Namespace *nsPtr, int flags, - LiteralEntry **globalPtrPtr); +MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes, int length); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 9f01144..5dd413a 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -28,8 +28,9 @@ * Function prototypes for static functions in this file: */ -static int AddLocalLiteralEntry(CompileEnv *envPtr, - Tcl_Obj *objPtr, int localHash); +static Tcl_Obj * CreateLiteral(Interp *iPtr, char *bytes, int length, + int *newPtr, Namespace *nsPtr, int flags, + LiteralEntry **globalPtrPtr); static void ExpandLocalLiteralArray(CompileEnv *envPtr); static unsigned HashString(const char *string, int length); #ifdef TCL_COMPILE_DEBUG @@ -156,8 +157,7 @@ TclDeleteLiteralTable( * considered. * * 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. + * The literal object. * * Side effects: * Increments the ref count of the global LiteralEntry since the caller @@ -176,9 +176,18 @@ TclCreateLiteral( Interp *iPtr, char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ + int length) /* Number of bytes in the string. */ +{ + int new; + return CreateLiteral(iPtr, bytes, length, &new, NULL, 0, NULL); +} + +static Tcl_Obj * +CreateLiteral( + Interp *iPtr, + 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. */ int *newPtr, Namespace *nsPtr, int flags, @@ -193,10 +202,10 @@ TclCreateLiteral( * Is it in the interpreter's global literal table? */ - if (hash == (unsigned) -1) { - hash = HashString(bytes, length); + if (length < 0) { + length = strlen(bytes); } - globalHash = (hash & globalTablePtr->mask); + globalHash = (HashString(bytes, length) & globalTablePtr->mask); for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL; globalPtr = globalPtr->nextPtr) { objPtr = globalPtr->objPtr; @@ -211,17 +220,25 @@ TclCreateLiteral( if (newPtr) { *newPtr = 0; } - if (globalPtrPtr) { - *globalPtrPtr = globalPtr; - } if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } - globalPtr->refCount++; + if (globalPtrPtr) { + *globalPtrPtr = globalPtr; + } else { + globalPtr->refCount++; +#ifdef TCL_COMPILE_DEBUG + if (globalPtr->refCount < 1) { + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + "TclRegisterLiteral", (length>60? 60 : length), bytes, + globalPtr->refCount); + } +#endif + } return objPtr; } } - if (!newPtr) { + if (newPtr == NULL) { if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } @@ -297,7 +314,7 @@ TclCreateLiteral( if (globalPtrPtr) { *globalPtrPtr = globalPtr; - } + } *newPtr = 1; return objPtr; } @@ -326,7 +343,7 @@ TclFetchLiteral( if (index >= (unsigned int) envPtr->literalArrayNext) { return NULL; } - return envPtr->literalArrayPtr[index].objPtr; + return envPtr->literalArrayPtr[index]; } /* @@ -374,47 +391,17 @@ TclRegisterLiteral( { CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; - LiteralTable *localTablePtr = &envPtr->localLitTable; - LiteralEntry *globalPtr, *localPtr; + Namespace *nsPtr = NULL; Tcl_Obj *objPtr; - unsigned hash; - int localHash, objIndex, new; - Namespace *nsPtr; - - if (length < 0) { - length = (bytes ? strlen(bytes) : 0); - } - hash = HashString(bytes, length); - - /* - * Is the literal already in the CompileEnv's local literal array? If so, - * just return its index. - */ - - localHash = (hash & localTablePtr->mask); - for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL; - localPtr = localPtr->nextPtr) { - objPtr = localPtr->objPtr; - if ((objPtr->length == length) && ((length == 0) - || ((objPtr->bytes[0] == bytes[0]) - && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) { - if (flags & LITERAL_ON_HEAP) { - ckfree(bytes); - } - objIndex = (localPtr - envPtr->literalArrayPtr); -#ifdef TCL_COMPILE_DEBUG - TclVerifyLocalLiteralTable(envPtr); -#endif /*TCL_COMPILE_DEBUG*/ - - return objIndex; - } - } + LiteralEntry *globalPtr; + Tcl_HashEntry *hePtr; + int objIndex, globalNew, new = 0; /* - * The literal is new to this CompileEnv. If it is a command name, avoid - * sharing it accross 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. + * If the literal 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. */ if (flags & LITERAL_CMD_NAME) { @@ -423,27 +410,21 @@ TclRegisterLiteral( } else { nsPtr = iPtr->varFramePtr->nsPtr; } - } else { - nsPtr = NULL; } - /* - * Is it in the interpreter's global literal table? If not, create it. - */ - - globalPtr = NULL; - 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) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", - "TclRegisterLiteral", (length>60? 60 : length), bytes, - globalPtr->refCount); + objPtr = CreateLiteral(iPtr, bytes, length, &globalNew, nsPtr, + flags, &globalPtr); + + hePtr = Tcl_CreateHashEntry(&envPtr->litMap, objPtr, &new); + if (new) { + objIndex = TclAddLiteralObj(envPtr, objPtr, NULL); + Tcl_SetHashValue(hePtr, INT2PTR(objIndex)); + if (!globalNew) { + globalPtr->refCount++; + } + } else { + objIndex = PTR2INT(Tcl_GetHashValue(hePtr)); } - TclVerifyLocalLiteralTable(envPtr); -#endif /*TCL_COMPILE_DEBUG*/ return objIndex; } @@ -520,11 +501,9 @@ TclHideLiteral( int index) /* The index of the entry in the literal * array. */ { - LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; - LiteralTable *localTablePtr = &envPtr->localLitTable; - int localHash, length; - const char *bytes; + Tcl_Obj **lPtr; Tcl_Obj *newObjPtr; + Tcl_HashEntry *hePtr; lPtr = &envPtr->literalArrayPtr[index]; @@ -535,24 +514,15 @@ TclHideLiteral( * matched by literal searches. */ - newObjPtr = Tcl_DuplicateObj(lPtr->objPtr); - Tcl_IncrRefCount(newObjPtr); - TclReleaseLiteral(interp, lPtr->objPtr); - lPtr->objPtr = newObjPtr; - - bytes = TclGetStringFromObj(newObjPtr, &length); - localHash = (HashString(bytes, length) & localTablePtr->mask); - nextPtrPtr = &localTablePtr->buckets[localHash]; - - for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) { - if (entryPtr == lPtr) { - *nextPtrPtr = lPtr->nextPtr; - lPtr->nextPtr = NULL; - localTablePtr->numEntries--; - break; - } - nextPtrPtr = &entryPtr->nextPtr; + hePtr = Tcl_FindHashEntry(&envPtr->litMap, *lPtr); + if (hePtr) { + Tcl_DeleteHashEntry(hePtr); } + + newObjPtr = Tcl_DuplicateObj(*lPtr); + Tcl_IncrRefCount(newObjPtr); + TclReleaseLiteral(interp, *lPtr); + *lPtr = newObjPtr; } /* @@ -566,8 +536,7 @@ TclHideLiteral( * * Results: * The index in the CompileEnv's literal array that references the - * literal. Stores the pointer to the new literal entry in the location - * referenced by the localPtrPtr argument. + * literal. * * Side effects: * Expands the literal array if necessary. Increments the refcount on the @@ -581,11 +550,10 @@ TclAddLiteralObj( 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 **litPtrPtr) /* UNUSED. Still in place due to publication + * in the internal stubs table, and use by + * tclcompiler. */ { - register LiteralEntry *lPtr; int objIndex; if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) { @@ -594,90 +562,8 @@ TclAddLiteralObj( objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; - lPtr = &envPtr->literalArrayPtr[objIndex]; - lPtr->objPtr = objPtr; + envPtr->literalArrayPtr[objIndex] = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = -1; /* i.e., unused */ - lPtr->nextPtr = NULL; - - if (litPtrPtr) { - *litPtrPtr = lPtr; - } - - return objIndex; -} - -/* - *---------------------------------------------------------------------- - * - * AddLocalLiteralEntry -- - * - * Insert a new literal into a CompileEnv's local literal array. - * - * Results: - * The index in the CompileEnv's literal array that references the - * literal. - * - * 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. - * - *---------------------------------------------------------------------- - */ - -static int -AddLocalLiteralEntry( - 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. */ - int localHash) /* Hash value for the literal's string. */ -{ - register LiteralTable *localTablePtr = &envPtr->localLitTable; - LiteralEntry *localPtr; - int objIndex; - - objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr); - - /* - * Add the literal to the local table. - */ - - localPtr->nextPtr = localTablePtr->buckets[localHash]; - localTablePtr->buckets[localHash] = localPtr; - localTablePtr->numEntries++; - - /* - * If the CompileEnv's local literal table has exceeded a decent size, - * rebuild it with more buckets. - */ - - if (localTablePtr->numEntries >= localTablePtr->rebuildSize) { - RebuildLiteralTable(localTablePtr); - } - -#ifdef TCL_COMPILE_DEBUG - TclVerifyLocalLiteralTable(envPtr); - { - char *bytes; - int length, found, i; - - found = 0; - for (i=0 ; i<localTablePtr->numBuckets ; i++) { - for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; - localPtr=localPtr->nextPtr) { - if (localPtr->objPtr == objPtr) { - found = 1; - } - } - } - - if (!found) { - bytes = TclGetStringFromObj(objPtr, &length); - Tcl_Panic("%s: literal \"%.*s\" wasn't found locally", - "AddLocalLiteralEntry", (length>60? 60 : length), bytes); - } - } -#endif /*TCL_COMPILE_DEBUG*/ return objIndex; } @@ -712,12 +598,10 @@ ExpandLocalLiteralArray( * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ - LiteralTable *localTablePtr = &envPtr->localLitTable; int currElems = envPtr->literalArrayNext; - size_t currBytes = (currElems * sizeof(LiteralEntry)); - LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; - LiteralEntry *newArrayPtr; - int i; + size_t currBytes = (currElems * sizeof(Tcl_Obj *)); + Tcl_Obj **currArrayPtr = envPtr->literalArrayPtr; + Tcl_Obj **newArrayPtr; unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { @@ -738,25 +622,6 @@ ExpandLocalLiteralArray( envPtr->mallocedLiteralArray = 1; } - /* - * Update the local literal table's bucket array. - */ - - if (currArrayPtr != newArrayPtr) { - for (i=0 ; i<currElems ; i++) { - if (newArrayPtr[i].nextPtr != NULL) { - newArrayPtr[i].nextPtr = newArrayPtr - + (newArrayPtr[i].nextPtr - currArrayPtr); - } - } - for (i=0 ; i<localTablePtr->numBuckets ; i++) { - if (localTablePtr->buckets[i] != NULL) { - localTablePtr->buckets[i] = newArrayPtr - + (localTablePtr->buckets[i] - currArrayPtr); - } - } - } - envPtr->literalArrayPtr = newArrayPtr; envPtr->literalArrayEnd = newSize / sizeof(LiteralEntry); } @@ -1026,8 +891,9 @@ TclInvalidateCmdLiteral( * invalidate a cmd literal. */ { Interp *iPtr = (Interp *) interp; - Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name, - strlen(name), -1, NULL, nsPtr, 0, NULL); + LiteralEntry *globalPtr; + Tcl_Obj *literalObjPtr = CreateLiteral(iPtr, (char *) name, -1, + NULL, nsPtr, 0, &globalPtr); if (literalObjPtr != NULL) { if (literalObjPtr->typePtr == &tclCmdNameType) { @@ -1136,40 +1002,25 @@ 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; + Tcl_HashTable *mapPtr = &envPtr->litMap; + Tcl_HashSearch search; + Tcl_HashEntry *hePtr = Tcl_FirstHashEntry(mapPtr, &search); - 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 = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", - "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes, localPtr->refCount); - } - if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, - localPtr->objPtr) == NULL) { - bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" is not global", + while (hePtr) { + Tcl_Obj *objPtr = Tcl_GetHashKey(mapPtr, hePtr); + + if (objPtr->bytes == NULL) { + Tcl_Panic("%s: literal has NULL string rep", + "TclVerifyLocalLiteralTable"); + } + if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, objPtr) == NULL) { + int length; + const char *bytes = TclGetStringFromObj(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); + hePtr = Tcl_NextHashEntry(&search); } } diff --git a/generic/tclProc.c b/generic/tclProc.c index bed520a..7640eb7 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1330,7 +1330,6 @@ InitLocalCache( Var *varPtr; LocalCache *localCachePtr; CompiledLocal *localPtr; - int new; /* * Cache the names and initial values of local variables; store the @@ -1349,9 +1348,8 @@ InitLocalCache( if (TclIsVarTemporary(localPtr)) { *namePtr = NULL; } else { - *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, - &new, /* nsPtr */ NULL, 0, NULL); + *namePtr = TclCreateLiteral(iPtr, + localPtr->name, localPtr->nameLength); Tcl_IncrRefCount(*namePtr); } diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index f69f6b9..f69f6b9 100644..100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c deleted file mode 100644 index 0391502..0000000 --- a/generic/tclStubLibTbl.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * tclStubLibTbl.c -- - * - * Stub object that will be statically linked into extensions that want - * to access Tcl. - * - * Copyright (c) 1998-1999 by Scriptics Corporation. - * Copyright (c) 1998 Paul Duffin. - * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - -#include "tclInt.h" - -/* - *---------------------------------------------------------------------- - * - * TclInitStubTable -- - * - * Initialize the stub table, using the structure pointed at - * by the "version" argument. - * - * Results: - * Outputs the value of the "version" argument. - * - * Side effects: - * Sets the stub table pointers. - * - *---------------------------------------------------------------------- - */ -MODULE_SCOPE const char * -TclInitStubTable( - const char *version) /* points to the version field of a - TclStubInfoType structure variable. */ -{ - tclStubsPtr = ((const TclStubInfoType *) version)->stubs; - - if (tclStubsPtr->hooks) { - tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; - tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; - tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; - } else { - tclPlatStubsPtr = NULL; - tclIntStubsPtr = NULL; - tclIntPlatStubsPtr = NULL; - } - - return version; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |