summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xgeneric/tclArithSeries.c2
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCmdAH.c3
-rw-r--r--generic/tclCmdIL.c14
-rw-r--r--generic/tclDictObj.c5
-rw-r--r--generic/tclEnsemble.c15
-rw-r--r--generic/tclEvent.c3
-rw-r--r--generic/tclExecute.c8
-rw-r--r--generic/tclIOGT.c3
-rw-r--r--generic/tclIORChan.c4
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclListObj.c14
-rw-r--r--generic/tclObj.c119
-rw-r--r--generic/tclUtil.c3
-rw-r--r--generic/tclVar.c5
15 files changed, 33 insertions, 169 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index ef1101a..a074a43 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -1157,7 +1157,7 @@ ArithSeriesInOperation(
Tcl_Obj *elemObj;
elen = 0;
TclArithSeriesObjIndex(interp, arithSeriesObjPtr, (index+incr), &elemObj);
- char const *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
+ const char *estr = elemObj ? Tcl_GetStringFromObj(elemObj, &elen) : "";
/* "in" operation defined as a string compare */
test = (elen == vlen) ? (memcmp(estr, vstr, elen) == 0) : 0;
Tcl_BumpObj(elemObj);
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 241dc78..c4ba858 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -6153,7 +6153,7 @@ TclNREvalObjEx(
*/
Tcl_IncrRefCount(objPtr);
- listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType);
+ listPtr = Tcl_DuplicateObj(objPtr);
if (!listPtr) {
Tcl_DecrRefCount(objPtr);
return TCL_ERROR;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 3b9e5ba..9a9e433 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2822,8 +2822,7 @@ EachloopCmd(
/* Don't compute values here, wait until the last moment */
statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
} else {
- statePtr->aCopyList[i] = TclDuplicatePureObj(
- interp, objv[2+i*2], &tclListType);
+ statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
if (!statePtr->aCopyList[i]) {
result = TCL_ERROR;
goto done;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 663d962..4ae7ee2 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2315,7 +2315,7 @@ Tcl_LassignObjCmd(
return TCL_ERROR;
}
- listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType);
+ listCopyPtr = Tcl_DuplicateObj(objv[1]);
if (!listCopyPtr) {
return TCL_ERROR;
}
@@ -2485,7 +2485,7 @@ Tcl_LinsertObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
+ listPtr = Tcl_DuplicateObj(listPtr);
if (!listPtr) {
return TCL_ERROR;
}
@@ -2690,7 +2690,7 @@ Tcl_LpopObjCmd(
if (objc == 2) {
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
+ listPtr = Tcl_DuplicateObj(listPtr);
if (!listPtr) {
return TCL_ERROR;
}
@@ -2883,7 +2883,7 @@ Tcl_LremoveObjCmd(
*/
if (Tcl_IsShared(listObj)) {
- listObj = TclDuplicatePureObj(interp, listObj, &tclListType);
+ listObj = Tcl_DuplicateObj(listObj);
if (!listObj) {
status = TCL_ERROR;
goto done;
@@ -3139,7 +3139,7 @@ Tcl_LreplaceObjCmd(
listPtr = objv[1];
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
+ listPtr = Tcl_DuplicateObj(listPtr);
if (!listPtr) {
return TCL_ERROR;
}
@@ -4775,7 +4775,7 @@ Tcl_LsortObjCmd(
* 1675116]
*/
- listObj = TclDuplicatePureObj(interp ,listObj, &tclListType);
+ listObj = Tcl_DuplicateObj(listObj);
if (listObj == NULL) {
sortInfo.resultCode = TCL_ERROR;
goto done;
@@ -5131,7 +5131,7 @@ Tcl_LeditObjCmd(
}
if (Tcl_IsShared(listPtr)) {
- listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType);
+ listPtr = Tcl_DuplicateObj(listPtr);
if (!listPtr) {
return TCL_ERROR;
}
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 94a30da..d4a3ce1 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -62,7 +62,7 @@ static Tcl_ObjCmdProc DictMapNRCmd;
static Tcl_NRPostProc DictForLoopCallback;
static Tcl_NRPostProc DictMapLoopCallback;
static Tcl_ObjTypeLengthProc DictAsListLength;
-static Tcl_ObjTypeIndexProc DictAsListIndex;
+/* static Tcl_ObjTypeIndexProc DictAsListIndex; needs rewrite */
/*
* Table of dict subcommand names and implementations.
@@ -3884,7 +3884,7 @@ DictAsListLength(
* The intent is to have no side effects.
*
*/
-
+#if 0 // Needs rewrite!
static int
DictAsListIndex(
Tcl_Interp *interp,
@@ -3952,6 +3952,7 @@ DictAsListIndex(
*elemObjPtr = elemPtr;
return TCL_OK;
}
+#endif
/*
* Local Variables:
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index deabfe2..b6c0931 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -312,8 +312,7 @@ TclNamespaceEnsembleCmd(
Tcl_AppendObjToObj(newCmd, listv[0]);
Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
if (patchedDict == NULL) {
- patchedDict = TclDuplicatePureObj(
- interp, objv[1], &tclDictType);
+ patchedDict = Tcl_DuplicateObj(objv[1]);
if (!patchedDict) {
if (allocatedMapFlag) {
Tcl_DecrRefCount(mapObj);
@@ -606,8 +605,7 @@ TclNamespaceEnsembleCmd(
}
cmd = TclGetString(listv[0]);
if (!(cmd[0] == ':' && cmd[1] == ':')) {
- Tcl_Obj *newList = TclDuplicatePureObj(
- interp, listObj, &tclListType);
+ Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
if (!newList) {
if (patchedDict) {
Tcl_DecrRefCount(patchedDict);
@@ -623,8 +621,7 @@ TclNamespaceEnsembleCmd(
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
&newCmd);
if (patchedDict == NULL) {
- patchedDict = TclDuplicatePureObj(
- interp, objv[1], &tclListType);
+ patchedDict = Tcl_DuplicateObj(objv[1]);
if (!patchedDict) {
goto freeMapAndError;
}
@@ -1925,8 +1922,7 @@ NsEnsembleImplementationCmdNR(
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
- copyPtr = TclDuplicatePureObj(
- interp, prefixObj, &tclListType);
+ copyPtr = Tcl_DuplicateObj(prefixObj);
if (!copyPtr) {
return TCL_ERROR;
}
@@ -2329,8 +2325,7 @@ EnsembleUnknownCallback(
* Create the "unknown" command callback to determine what to do.
*/
- unknownCmd = TclDuplicatePureObj(
- interp, ensemblePtr->unknownHandler, &tclListType);
+ unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
if (!unknownCmd) {
return TCL_ERROR;
}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 88a568a..ca63fab 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -232,8 +232,7 @@ HandleBgErrors(
* support one handler setting another handler.
*/
- Tcl_Obj *copyObj = TclDuplicatePureObj(
- interp, assocPtr->cmdPrefix, &tclListType);
+ Tcl_Obj *copyObj = Tcl_DuplicateObj(assocPtr->cmdPrefix);
if (!copyObj) {
return;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 5ece319..6387763 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -3380,7 +3380,7 @@ TEBCresume(
Tcl_Obj *newValue;
DECACHE_STACK_INFO();
- newValue = TclDuplicatePureObj(interp, objResultPtr, &tclListType);
+ newValue = Tcl_DuplicateObj(objResultPtr);
CACHE_STACK_INFO();
if (!newValue) {
@@ -3446,8 +3446,7 @@ TEBCresume(
} else {
if (Tcl_IsShared(objResultPtr)) {
DECACHE_STACK_INFO();
- valueToAssign = TclDuplicatePureObj(
- interp, objResultPtr, &tclListType);
+ valueToAssign = Tcl_DuplicateObj(objResultPtr);
CACHE_STACK_INFO();
if (!valueToAssign) {
goto errorInLappendListPtr;
@@ -6484,8 +6483,7 @@ TEBCresume(
}
if (Tcl_IsShared(listPtr)) {
DECACHE_STACK_INFO();
- objPtr = TclDuplicatePureObj(
- interp, listPtr, &tclListType);
+ objPtr = Tcl_DuplicateObj(listPtr);
CACHE_STACK_INFO();
if (!objPtr) {
goto gotError;
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 215c6c7..fb80041 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -379,8 +379,7 @@ ExecuteCallback(
unsigned char *resBuf;
Tcl_InterpState state = NULL;
int res = TCL_OK;
- Tcl_Obj *command = TclDuplicatePureObj(
- interp, dataPtr->command, &tclListType);
+ Tcl_Obj *command = Tcl_DuplicateObj(dataPtr->command);
if (!command) {
return TCL_ERROR;
}
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index a657021..bf6be56 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -2261,7 +2261,7 @@ NewReflectedChannel(
rcPtr->mode = mode;
rcPtr->interest = 0; /* Initially no interest registered */
- rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType);
+ rcPtr->cmd = Tcl_DuplicateObj(cmdpfxObj);
if (!rcPtr->cmd) {
return NULL;
}
@@ -2401,7 +2401,7 @@ InvokeTclMethod(
* before the channel id.
*/
- cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType);
+ cmd = Tcl_DuplicateObj(rcPtr->cmd);
if (!cmd) {
return TCL_ERROR;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 00dafc6..1641ede 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3260,8 +3260,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr);
MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr);
-MODULE_SCOPE Tcl_Obj *TclDuplicatePureObj(Tcl_Interp *interp,
- Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, Tcl_Size dictLength,
const char **elementPtr, const char **nextPtr,
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index fa94b3f..482f270 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -2557,7 +2557,7 @@ TclLindexList(
* does not.
*/
- indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType);
+ indexListCopy = Tcl_DuplicateObj(argObj);
if (!indexListCopy) {
/*
* The argument is neither an index nor a well-formed list.
@@ -2768,8 +2768,7 @@ TclLsetList(
} else {
- indexListCopy = TclDuplicatePureObj(
- interp, indexArgObj, &tclListType);
+ indexListCopy = Tcl_DuplicateObj(indexArgObj);
if (!indexListCopy) {
/*
* indexArgPtr designates something that is neither an index nor a
@@ -2872,8 +2871,7 @@ TclLsetFlat(
* representation and internal representation of listObj remains unchanged.
*/
- subListObj = Tcl_IsShared(listObj)
- ? TclDuplicatePureObj(interp, listObj, &tclListType) : listObj;
+ subListObj = Tcl_IsShared(listObj) ? Tcl_DuplicateObj(listObj) : listObj;
if (!subListObj) {
return NULL;
}
@@ -2962,8 +2960,7 @@ TclLsetFlat(
subListObj = elemPtrs[index];
}
if (Tcl_IsShared(subListObj)) {
- subListObj = TclDuplicatePureObj(
- interp, subListObj, &tclListType);
+ subListObj = Tcl_DuplicateObj(subListObj);
if (!subListObj) {
return NULL;
}
@@ -2986,8 +2983,7 @@ TclLsetFlat(
}
if (Tcl_IsShared(subListObj)) {
Tcl_Obj * newSubListObj;
- newSubListObj = TclDuplicatePureObj(
- interp, subListObj, &tclListType);
+ newSubListObj = Tcl_DuplicateObj(subListObj);
if (copied) {
Tcl_DecrRefCount(subListObj);
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 7873fd8..9ddb397 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -202,9 +202,6 @@ static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int copy, mp_int *bignumValue);
-static int SetDuplicatePureObj(Tcl_Interp *interp,
- Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
- const Tcl_ObjType *typePtr);
/*
* Prototypes for the array hash key methods.
@@ -1529,14 +1526,6 @@ TclObjBeingDeleted(
* Create and return a new object that is a duplicate of the argument
* object.
*
- * TclDuplicatePureObj --
- * Like Tcl_DuplicateObj, except that it converts the duplicate to the
- * specifid typ, does not duplicate the 'bytes'
- * field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
- * updateStringProc. This can avoid an expensive memory allocation since
- * the data in the 'bytes' field of each Tcl_Obj must reside in allocated
- * memory.
- *
* Results:
* The return value is a pointer to a newly created Tcl_Obj. This object
* has reference count 0 and the same type, if any, as the source object
@@ -1588,114 +1577,6 @@ Tcl_DuplicateObj(
return dupPtr;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDuplicatePureObj --
- *
- * Duplicates a Tcl_Obj and converts the internal representation of the
- * duplicate to the given type, changing neither the 'bytes' field
- * nor the internal representation of the original object, and without
- * duplicating the bytes field unless necessary, i.e. unless the
- * duplicate provides no updateStringProc after conversion. This can
- * avoid an expensive memory allocation since the data in the 'bytes'
- * field of each Tcl_Obj must reside in allocated memory.
- *
- * Results:
- * A pointer to a newly-created Tcl_Obj or NULL if there was an error.
- * This object has reference count 0. Also:
- *
- *----------------------------------------------------------------------
- */
-int SetDuplicatePureObj(
- Tcl_Interp *interp,
- Tcl_Obj *dupPtr,
- Tcl_Obj *objPtr,
- const Tcl_ObjType *typePtr)
-{
- char *bytes = objPtr->bytes;
- int status = TCL_OK;
- const Tcl_ObjType *useTypePtr =
- (bytes == &tclEmptyString || objPtr->typePtr == NULL)
- ? typePtr : objPtr->typePtr;
-
- TclInvalidateStringRep(dupPtr);
- assert(dupPtr->typePtr == NULL);
-
- if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
- objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
- } else {
- dupPtr->internalRep = objPtr->internalRep;
- dupPtr->typePtr = objPtr->typePtr;
- }
-
- if (typePtr != NULL && dupPtr->typePtr != useTypePtr) {
- if (bytes) {
- dupPtr->bytes = bytes;
- dupPtr->length = objPtr->length;
- }
- /* borrow bytes from original object */
- status = Tcl_ConvertToType(interp, dupPtr, useTypePtr);
- if (bytes) {
- dupPtr->bytes = NULL;
- dupPtr->length = 0;
- }
- if (status != TCL_OK) {
- return status;
- }
- }
-
- /* tclStringType is treated as a special case because a Tcl_Obj having this
- * type can not always update the string representation. This happens, for
- * example, when Tcl_GetCharLength() converts the internal representation
- * to tclStringType in order to store the number of characters, but does
- * not store enough information to generate the string representation.
- *
- * Perhaps in the future this can be remedied and this special treatment
- * removed.
- */
-
-
- if (bytes && (dupPtr->typePtr == NULL
- || dupPtr->typePtr->updateStringProc == NULL
- || useTypePtr == &tclStringType
- )
- ) {
- if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
- if (interp) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "insufficient memory to initialize string", -1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- }
- status = TCL_ERROR;
- }
- }
- return status;
-}
-
-Tcl_Obj *
-TclDuplicatePureObj(
- Tcl_Interp *interp,
- Tcl_Obj *objPtr,
- const Tcl_ObjType *typePtr
-) /* The object to duplicate. */
-{
- int status;
- Tcl_Obj *dupPtr;
-
- TclNewObj(dupPtr);
- status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
- if (status == TCL_OK) {
- return dupPtr;
- } else {
- Tcl_DecrRefCount(dupPtr);
- return NULL;
- }
-}
-
-
-
void
TclSetDuplicateObj(
Tcl_Obj *dupPtr,
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 1fdcda3..64df0e5 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2010,8 +2010,7 @@ Tcl_ConcatObj(
}
Tcl_BumpObj(elemPtr); // could be an an abstract list element
} else {
- resPtr = TclDuplicatePureObj(
- NULL, objPtr, &tclListType);
+ resPtr = Tcl_DuplicateObj(objPtr);
if (!resPtr) {
return NULL;
}
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 326009b..b0fbb82 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -3099,7 +3099,7 @@ ArrayForNRCmd(
* loop) don't vanish.
*/
- varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType);
+ varListObj = Tcl_DuplicateObj(objv[1]);
if (!varListObj) {
return TCL_ERROR;
}
@@ -4075,8 +4075,7 @@ ArraySetCmd(
* the loop and return an error.
*/
- copyListObj =
- TclDuplicatePureObj(interp, arrayElemObj, &tclListType);
+ copyListObj = Tcl_DuplicateObj(arrayElemObj);
if (!copyListObj) {
return TCL_ERROR;
}
generated by cgit v0.12 at 2024-10-21 09:41:18 (GMT)