summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompile.c77
-rw-r--r--generic/tclCompile.h23
-rw-r--r--generic/tclLiteral.c327
-rw-r--r--generic/tclProc.c6
-rwxr-xr-x[-rw-r--r--]generic/tclStrToD.c0
-rw-r--r--generic/tclStubLibTbl.c58
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:
- */
generated by cgit v0.12 at 2024-10-28 08:22:18 (GMT)