summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclBinary.c28
-rw-r--r--generic/tclCompile.c17
-rw-r--r--generic/tclDictObj.c21
-rw-r--r--generic/tclEncoding.c18
-rw-r--r--generic/tclExecute.c11
-rw-r--r--generic/tclIndexObj.c33
-rw-r--r--generic/tclInt.h8
-rw-r--r--generic/tclListObj.c24
-rw-r--r--generic/tclNamesp.c38
-rw-r--r--generic/tclObj.c26
-rw-r--r--generic/tclPathObj.c11
-rw-r--r--generic/tclProc.c3
-rw-r--r--generic/tclRegexp.c2
-rw-r--r--generic/tclStringObj.c35
14 files changed, 208 insertions, 67 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 19b95c1..ccdab6e 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -125,8 +125,10 @@ typedef struct ByteArray {
((unsigned) (sizeof(ByteArray) - 4 + (len)))
#define GET_BYTEARRAY(objPtr) \
((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr)
+#define SET_BYTEARRAY(objPtr, baPtr) do { \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr); \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
+ } while(0)
/*
@@ -266,11 +268,17 @@ Tcl_SetByteArrayObj(
* >= 0. */
{
ByteArray *byteArrayPtr;
+ void *stringIntRep = NULL;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
Tcl_InvalidateStringRep(objPtr);
if (length < 0) {
@@ -285,6 +293,7 @@ Tcl_SetByteArrayObj(
}
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
}
/*
@@ -400,6 +409,8 @@ SetByteArrayFromAny(
Tcl_UniChar ch;
if (objPtr->typePtr != &tclByteArrayType) {
+ void *stringIntRep = NULL;
+
src = TclGetStringFromObj(objPtr, &length);
srcEnd = src + length;
@@ -412,9 +423,15 @@ SetByteArrayFromAny(
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if(objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
objPtr->typePtr = &tclByteArrayType;
SET_BYTEARRAY(objPtr, byteArrayPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
}
return TCL_OK;
}
@@ -440,6 +457,9 @@ static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
ckfree((char *) GET_BYTEARRAY(objPtr));
objPtr->typePtr = NULL;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 3bedf39..b4ff590 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -682,6 +682,9 @@ FreeByteCodeInternalRep(
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
@@ -2108,6 +2111,7 @@ TclInitByteCodeObj(
size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
size_t auxDataArrayBytes, structureSize;
register unsigned char *p;
+ void *stringIntRep = NULL;
#ifdef TCL_COMPILE_DEBUG
unsigned char *nextPtr;
#endif
@@ -2215,13 +2219,14 @@ TclInitByteCodeObj(
RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */
- /*
- * Free the old internal rep then convert the object to a bytecode object
- * by making its internal rep point to the just compiled ByteCode.
- */
-
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
objPtr->internalRep.twoPtrValue.ptr1 = (void *) codePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
objPtr->typePtr = &tclByteCodeType;
/*
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 15e9ace..6e7488c 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -369,6 +369,7 @@ DupDictInternalRep(
*/
copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclDictType;
}
@@ -400,6 +401,9 @@ FreeDictInternalRep(
if (dict->refcount <= 0) {
DeleteDict(dict);
}
+ if (dictPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(dictPtr->internalRep.twoPtrValue.ptr2);
+ }
dictPtr->typePtr = NULL;
}
@@ -573,6 +577,7 @@ SetDictFromAny(
Tcl_HashEntry *hPtr;
int isNew, result;
Dict *dict = (Dict *) ckalloc(sizeof(Dict));
+ void *stringIntRep = NULL;
InitChainTable(dict);
@@ -674,17 +679,17 @@ SetDictFromAny(
}
}
- /*
- * Free the old internalRep before setting the new one. We do this as late
- * as possible to allow the conversion code, in particular
- * Tcl_GetStringFromObj, to use that old internalRep.
- */
-
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
objPtr->internalRep.twoPtrValue.ptr1 = dict;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
objPtr->typePtr = &tclDictType;
return TCL_OK;
@@ -1369,6 +1374,7 @@ Tcl_NewDictObj(void)
dict->chain = NULL;
dict->refcount = 1;
dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1418,6 +1424,7 @@ Tcl_DbNewDictObj(
dict->chain = NULL;
dict->refcount = 1;
dictPtr->internalRep.twoPtrValue.ptr1 = dict;
+ dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 4a2c5f0..42d9d31 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -276,7 +276,7 @@ static int Iso88591ToUtfProc(ClientData clientData,
* See concerns raised in [Bug 1077262].
*/
-static Tcl_ObjType encodingType = {
+Tcl_ObjType tclEncodingType = {
"encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
};
@@ -306,15 +306,22 @@ Tcl_GetEncodingFromObj(
Tcl_Encoding *encodingPtr)
{
const char *name = Tcl_GetString(objPtr);
- if (objPtr->typePtr != &encodingType) {
+ if (objPtr->typePtr != &tclEncodingType) {
+ void *stringIntRep = NULL;
Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
return TCL_ERROR;
}
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) encoding;
- objPtr->typePtr = &encodingType;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
+ objPtr->typePtr = &tclEncodingType;
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
return TCL_OK;
@@ -335,6 +342,9 @@ FreeEncodingIntRep(
Tcl_Obj *objPtr)
{
Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.twoPtrValue.ptr1);
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 2db98da..20442da 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -635,7 +635,7 @@ static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
* compiled bytecode for Tcl expressions.
*/
-static Tcl_ObjType exprCodeType = {
+Tcl_ObjType tclExprCodeType = {
"exprcode",
FreeExprCodeInternalRep, /* freeIntRepProc */
DupExprCodeInternalRep, /* dupIntRepProc */
@@ -1197,7 +1197,7 @@ Tcl_ExprObj(
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &exprCodeType) {
+ if (objPtr->typePtr == &tclExprCodeType) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
@@ -1209,7 +1209,7 @@ Tcl_ExprObj(
objPtr->typePtr = (Tcl_ObjType *) NULL;
}
}
- if (objPtr->typePtr != &exprCodeType) {
+ if (objPtr->typePtr != &tclExprCodeType) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
*/
@@ -1238,7 +1238,7 @@ Tcl_ExprObj(
TclEmitOpcode(INST_DONE, &compEnv);
TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &exprCodeType;
+ objPtr->typePtr = &tclExprCodeType;
TclFreeCompileEnv(&compEnv);
codePtr = (ByteCode *) objPtr->internalRep.twoPtrValue.ptr1;
#ifdef TCL_COMPILE_DEBUG
@@ -1344,6 +1344,9 @@ FreeExprCodeInternalRep(
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 6a818f2..76ae9bf 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -27,7 +27,7 @@ static void FreeIndex(Tcl_Obj *objPtr);
* that can be invoked by generic object code.
*/
-static Tcl_ObjType indexType = {
+Tcl_ObjType tclIndexType = {
"index", /* name */
FreeIndex, /* freeIntRepProc */
DupIndex, /* dupIntRepProc */
@@ -104,7 +104,7 @@ Tcl_GetIndexFromObj(
* the common case where the result is cached).
*/
- if (objPtr->typePtr == &indexType) {
+ if (objPtr->typePtr == &tclIndexType) {
IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
/*
@@ -178,7 +178,7 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (objPtr->typePtr == &indexType) {
+ if (objPtr->typePtr == &tclIndexType) {
indexRep = objPtr->internalRep.twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
*indexPtr = indexRep->index;
@@ -239,13 +239,20 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (objPtr->typePtr == &indexType) {
+ if (objPtr->typePtr == &tclIndexType) {
indexRep = objPtr->internalRep.twoPtrValue.ptr1;
} else {
- TclFreeIntRep(objPtr);
- indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
- objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- objPtr->typePtr = &indexType;
+ void *stringIntRep = NULL;
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
+ indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
+ objPtr->typePtr = &tclIndexType;
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
@@ -381,7 +388,8 @@ DupIndex(
memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
- dupPtr->typePtr = &indexType;
+ dupPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ dupPtr->typePtr = &tclIndexType;
}
/*
@@ -406,6 +414,9 @@ FreeIndex(
Tcl_Obj *objPtr)
{
ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
@@ -531,7 +542,7 @@ Tcl_WrongNumArgs(
* Add the element, quoting it if necessary.
*/
- if (origObjv[i]->typePtr == &indexType) {
+ if (origObjv[i]->typePtr == &tclIndexType) {
register IndexRep *indexRep =
origObjv[i]->internalRep.twoPtrValue.ptr1;
@@ -587,7 +598,7 @@ Tcl_WrongNumArgs(
* Otherwise, just use the string rep.
*/
- if (objv[i]->typePtr == &indexType) {
+ if (objv[i]->typePtr == &tclIndexType) {
register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d5a479b..d25c590 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2463,11 +2463,17 @@ MODULE_SCOPE Tcl_ObjType tclBignumType;
MODULE_SCOPE Tcl_ObjType tclBooleanType;
MODULE_SCOPE Tcl_ObjType tclByteArrayType;
MODULE_SCOPE Tcl_ObjType tclByteCodeType;
+MODULE_SCOPE Tcl_ObjType tclCmdNameType;
+MODULE_SCOPE Tcl_ObjType tclDictType;
MODULE_SCOPE Tcl_ObjType tclDoubleType;
MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
+MODULE_SCOPE Tcl_ObjType tclEncodingType;
+MODULE_SCOPE Tcl_ObjType tclExprCodeType;
+MODULE_SCOPE Tcl_ObjType tclFsPathType;
+MODULE_SCOPE Tcl_ObjType tclIndexType;
MODULE_SCOPE Tcl_ObjType tclIntType;
MODULE_SCOPE Tcl_ObjType tclListType;
-MODULE_SCOPE Tcl_ObjType tclDictType;
+MODULE_SCOPE Tcl_ObjType tclNsNameType;
MODULE_SCOPE Tcl_ObjType tclProcBodyType;
MODULE_SCOPE Tcl_ObjType tclStringType;
MODULE_SCOPE Tcl_ObjType tclArraySearchType;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index c092bcf..ca9286d 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -624,10 +624,12 @@ Tcl_ListObjAppendElement(
listRepPtr->refCount++;
oldListRepPtr->refCount--;
listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
} else if (newSize) {
listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize);
listRepPtr->maxElemCount = newMax;
listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
/*
@@ -918,6 +920,7 @@ Tcl_ListObjReplace(
}
listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -1568,6 +1571,7 @@ TclListObjSetElement(
listRepPtr->refCount++;
listRepPtr->elemCount = elemCount;
listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
oldListRepPtr->refCount--;
}
@@ -1627,6 +1631,11 @@ FreeListInternalRep(
ckfree((char *) listRepPtr);
}
+ if (listPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(listPtr->internalRep.twoPtrValue.ptr2);
+ listPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ }
+
listPtr->typePtr = NULL;
}
@@ -1683,6 +1692,7 @@ SetListFromAny(
{
List *listRepPtr;
Tcl_Obj **elemPtrs;
+ void *stringIntRep = NULL;
/*
* Dictionaries are a special case; they have a string representation such
@@ -1776,14 +1786,14 @@ SetListFromAny(
listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
}
- /*
- * Free the old internalRep before setting the new one. We do this as late
- * as possible to allow the conversion code, in particular
- * Tcl_GetStringFromObj, to use that old internalRep.
- */
-
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
ListSetIntRep(objPtr, listRepPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
return TCL_OK;
}
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 44634d4..ba21500 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -229,7 +229,7 @@ static void UnlinkNsPath(Namespace *nsPtr);
* the object.
*/
-static Tcl_ObjType nsNameType = {
+Tcl_ObjType tclNsNameType = {
"nsName", /* the type's name */
FreeNsNameInternalRep, /* freeIntRepProc */
DupNsNameInternalRep, /* dupIntRepProc */
@@ -2700,7 +2700,7 @@ GetNamespaceFromObj(
ResolvedNsName *resNamePtr;
Namespace *nsPtr, *refNsPtr;
- if (objPtr->typePtr == &nsNameType) {
+ if (objPtr->typePtr == &tclNsNameType) {
/*
* Check that the ResolvedNsName is still valid; avoid letting the ref
* cross interps.
@@ -4615,6 +4615,9 @@ FreeNsNameInternalRep(
}
ckfree((char *) resNamePtr);
}
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
@@ -4646,8 +4649,9 @@ DupNsNameInternalRep(
srcPtr->internalRep.twoPtrValue.ptr1;
copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
resNamePtr->refCount++;
- copyPtr->typePtr = &nsNameType;
+ copyPtr->typePtr = &tclNsNameType;
}
/*
@@ -4683,6 +4687,7 @@ SetNsNameFromAny(
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
register ResolvedNsName *resNamePtr;
const char *name;
+ void *stringIntRep = NULL;
if (interp == NULL) {
return TCL_ERROR;
@@ -4704,7 +4709,7 @@ SetNsNameFromAny(
* it, nor time determining its invalidity again and again.
*/
- if (objPtr->typePtr == &nsNameType) {
+ if (objPtr->typePtr == &tclNsNameType) {
TclFreeIntRep(objPtr);
objPtr->typePtr = NULL;
}
@@ -4720,9 +4725,15 @@ SetNsNameFromAny(
resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
}
resNamePtr->refCount = 1;
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- objPtr->typePtr = &nsNameType;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
+ objPtr->typePtr = &tclNsNameType;
return TCL_OK;
}
@@ -6421,14 +6432,16 @@ MakeCachedEnsembleCommand(
}
ckfree(ensembleCmd->fullSubcmdName);
} else {
- /*
- * Kill the old internal rep, and replace it with a brand new one of
- * our own.
- */
-
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ void *stringIntRep = NULL;
+ if (objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
objPtr->typePtr = &tclEnsembleCmdType;
}
@@ -6862,6 +6875,7 @@ DupEnsembleCmdRep(
copyPtr->typePtr = &tclEnsembleCmdType;
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
ensembleCopy->nsPtr = ensembleCmd->nsPtr;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index e14c740..7246a2a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -319,7 +319,7 @@ Tcl_HashKeyType tclObjHashKeyType = {
* own purposes.
*/
-static Tcl_ObjType tclCmdNameType = {
+Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
@@ -1273,6 +1273,7 @@ TclAllocateFreeObjects(void)
objPtr = (Tcl_Obj *) basePtr;
for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
objPtr->internalRep.twoPtrValue.ptr1 = (void *) prevPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
prevPtr = objPtr;
objPtr++;
}
@@ -4109,6 +4110,7 @@ TclSetCmdNameObj(
register ResolvedCmdName *resPtr;
register Namespace *currNsPtr;
char *name;
+ void *stringIntRep = NULL;
if (objPtr->typePtr == &tclCmdNameType) {
return;
@@ -4140,9 +4142,14 @@ TclSetCmdNameObj(
resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
}
- TclFreeIntRep(objPtr);
+ /* If previous objType was string, keep the internal representation */
+ if(objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
objPtr->typePtr = &tclCmdNameType;
}
@@ -4194,6 +4201,9 @@ FreeCmdNameInternalRep(
ckfree((char *) resPtr);
}
}
+ if (objPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(objPtr->internalRep.twoPtrValue.ptr2);
+ }
objPtr->typePtr = NULL;
}
@@ -4300,11 +4310,17 @@ SetCmdNameFromAny(
TclCleanupCommandMacro(oldCmdPtr);
}
} else {
- TclFreeIntRep(objPtr);
+ void *stringIntRep = NULL;
+ /* If previous objType was string, keep the internal representation */
+ if(objPtr->typePtr == &tclStringType) {
+ stringIntRep = objPtr->internalRep.twoPtrValue.ptr1;
+ } else {
+ TclFreeIntRep(objPtr);
+ }
resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
resPtr->refCount = 1;
objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = stringIntRep;
objPtr->typePtr = &tclCmdNameType;
}
resPtr->cmdPtr = cmdPtr;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 95c57bf..3c43cf5 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -35,7 +35,7 @@ static int MakePathFromNormalized(Tcl_Interp *interp,
* internally.
*/
-static Tcl_ObjType tclFsPathType = {
+Tcl_ObjType tclFsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
@@ -110,8 +110,10 @@ typedef struct FsPath {
*/
#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
-#define SETPATHOBJ(pathPtr,fsPathPtr) \
- ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+#define SETPATHOBJ(pathPtr,fsPathPtr) do { \
+ (pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
+ (pathPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
+ } while(0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
@@ -2584,6 +2586,9 @@ FreeFsPathInternalRep(
}
ckfree((char *) fsPathPtr);
+ if (pathPtr->internalRep.twoPtrValue.ptr2) {
+ ckfree(pathPtr->internalRep.twoPtrValue.ptr2);
+ }
pathPtr->typePtr = NULL;
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index d58e8da..b66f5e8 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2328,6 +2328,7 @@ TclNewProcBodyObj(
if (objPtr) {
objPtr->typePtr = &tclProcBodyType;
objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
procPtr->refCount++;
}
@@ -2361,6 +2362,7 @@ ProcBodyDup(
dupPtr->typePtr = &tclProcBodyType;
dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
+ dupPtr->internalRep.twoPtrValue.ptr2 = NULL;
procPtr->refCount++;
}
@@ -2669,7 +2671,6 @@ Tcl_ApplyObjCmd(
else {
/*
* Joe English's suggestion to allow cmdNames to function as lambdas.
- * Also requires making tclCmdNameType non-static in tclObj.c
*/
Tcl_Obj *elemPtr;
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index dac6aba..bcf9562 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -602,6 +602,7 @@ Tcl_GetRegExpFromObj(
TclFreeIntRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (void *) regexpPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclRegexpType;
}
return (Tcl_RegExp) regexpPtr;
@@ -785,6 +786,7 @@ DupRegexpInternalRep(
regexpPtr->refCount++;
copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
+ copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclRegexpType;
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index ee434c3..099bb27 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -129,8 +129,10 @@ typedef struct String {
(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_STRING(objPtr, stringPtr) \
- ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
+#define SET_STRING(objPtr, stringPtr) do { \
+ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr); \
+ (objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \
+ } while(0)
/*
* TCL STRING GROWTH ALGORITHM
@@ -398,6 +400,35 @@ Tcl_GetCharLength(
{
String *stringPtr;
+ if ((objPtr->typePtr == &tclByteArrayType) ||
+ (objPtr->typePtr == &tclByteCodeType) ||
+ (objPtr->typePtr == &tclCmdNameType) ||
+ (objPtr->typePtr == &tclDictType) ||
+ (objPtr->typePtr == &tclEncodingType) ||
+ (objPtr->typePtr == &tclEndOffsetType) ||
+ (objPtr->typePtr == &tclExprCodeType) ||
+ (objPtr->typePtr == &tclFsPathType) ||
+ (objPtr->typePtr == &tclIndexType) ||
+ /*(objPtr->typePtr == &tclListType) || This one causes cmdIL-1.29 failure */
+ (objPtr->typePtr == &tclNsNameType) ||
+ (objPtr->typePtr == &tclProcBodyType)) {
+ /* Try to convert object to String type, but remember old intRep. */
+ int length;
+ Tcl_ObjType *prevtype = objPtr->typePtr;
+ void *prevdata = objPtr->internalRep.twoPtrValue.ptr1;
+
+ objPtr->internalRep.twoPtrValue.ptr1 = objPtr->internalRep.twoPtrValue.ptr2;
+ objPtr->typePtr = objPtr->internalRep.twoPtrValue.ptr1 ? &tclStringType: NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ /* Now calculate the length. */
+ length = Tcl_GetCharLength(objPtr);
+ /* Convert obj back to old type, but keep stringRep in ptr2 */
+ objPtr->typePtr = prevtype;
+ objPtr->internalRep.twoPtrValue.ptr2 = objPtr->internalRep.twoPtrValue.ptr1;
+ objPtr->internalRep.twoPtrValue.ptr1 = prevdata;
+ return length;
+ }
+
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
generated by cgit v0.12 at 2025-09-04 02:04:55 (GMT)