summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rwxr-xr-xgeneric/tclArithSeries.c22
-rw-r--r--generic/tclBasic.c14
-rw-r--r--generic/tclBinary.c4
-rw-r--r--generic/tclClock.c2
-rw-r--r--generic/tclCmdAH.c4
-rw-r--r--generic/tclCmdIL.c8
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclCompExpr.c2
-rw-r--r--generic/tclDictObj.c30
-rw-r--r--generic/tclExecute.c20
-rw-r--r--generic/tclInt.h62
-rw-r--r--generic/tclLink.c2
-rw-r--r--generic/tclListObj.c45
-rw-r--r--generic/tclObj.c106
-rw-r--r--generic/tclScan.c2
-rw-r--r--generic/tclStrToD.c12
-rw-r--r--generic/tclUtil.c16
17 files changed, 202 insertions, 161 deletions
diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c
index cca0c58..632d812 100755
--- a/generic/tclArithSeries.c
+++ b/generic/tclArithSeries.c
@@ -29,7 +29,7 @@
#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \
do { \
const Tcl_ObjInternalRep *irPtr; \
- irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType); \
+ irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); \
(arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \
} while (0)
@@ -70,13 +70,15 @@ static void UpdateStringOfArithSeries (Tcl_Obj *listPtr);
* are valid and will be equivalent to the empty list.
*/
-const Tcl_ObjType tclArithSeriesType = {
- "arithseries", /* name */
+const TclObjTypeWithAbstractList tclArithSeriesType = {
+ {"arithseries", /* name */
FreeArithSeriesInternalRep, /* freeIntRepProc */
DupArithSeriesInternalRep, /* dupIntRepProc */
UpdateStringOfArithSeries, /* updateStringProc */
SetArithSeriesFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ TclArithSeriesObjLength
+ )}
};
/*
@@ -154,7 +156,7 @@ TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_W
arithSeriesRepPtr->elements = NULL;
arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
- arithSeriesPtr->typePtr = &tclArithSeriesType;
+ arithSeriesPtr->typePtr = &tclArithSeriesType.objType;
if (length > 0)
Tcl_InvalidateStringRep(arithSeriesPtr);
@@ -201,7 +203,7 @@ TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
arithSeriesRepPtr->elements = NULL;
arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL;
- arithSeriesPtr->typePtr = &tclArithSeriesType;
+ arithSeriesPtr->typePtr = &tclArithSeriesType.objType;
if (length > 0)
Tcl_InvalidateStringRep(arithSeriesPtr);
@@ -387,7 +389,7 @@ TclArithSeriesObjStep(
{
ArithSeries *arithSeriesRepPtr;
- if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType.objType) {
Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
}
arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
@@ -427,7 +429,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele
{
ArithSeries *arithSeriesRepPtr;
- if (arithSeriesPtr->typePtr != &tclArithSeriesType) {
+ if (arithSeriesPtr->typePtr != &tclArithSeriesType.objType) {
Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
}
arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr);
@@ -538,7 +540,7 @@ DupArithSeriesInternalRep(
copyArithSeriesRepPtr->elements = NULL;
copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- copyPtr->typePtr = &tclArithSeriesType;
+ copyPtr->typePtr = &tclArithSeriesType.objType;
}
/*
@@ -845,7 +847,7 @@ TclArithSeriesGetElements(
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
{
- if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
ArithSeries *arithSeriesRepPtr;
Tcl_Obj **objv;
int i, objc;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 52c35fc..561e4cd 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -7031,7 +7031,7 @@ ExprCeilFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7071,7 +7071,7 @@ ExprFloorFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7217,7 +7217,7 @@ ExprSqrtFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
Tcl_SetObjResult(interp, objv[1]);
@@ -7271,7 +7271,7 @@ ExprUnaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
d = irPtr->doubleValue;
@@ -7335,7 +7335,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
d1 = irPtr->doubleValue;
@@ -7350,7 +7350,7 @@ ExprBinaryFunc(
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
if (code != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
if (irPtr) {
d2 = irPtr->doubleValue;
@@ -7511,7 +7511,7 @@ ExprDoubleFunc(
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (TclHasInternalRep(objv[1], &tclDoubleType)) {
+ if (TclHasInternalRep(objv[1], &tclDoubleType.objType)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index d53fc64..e0d99c7 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2021,7 +2021,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
if (irPtr == NULL) {
return TCL_ERROR;
}
@@ -2041,7 +2041,7 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
if (irPtr == NULL) {
return TCL_ERROR;
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 2647da5..1d33886 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
* that it isn't.
*/
- if (TclHasInternalRep(objv[1], &tclBignumType)) {
+ if (TclHasInternalRep(objv[1], &tclBignumType.objType)) {
Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 81a32d4..6a1de71 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -2728,7 +2728,7 @@ EachloopCmd(
&statePtr->varcList[i], &statePtr->varvList[i]);
/* Values */
- if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) {
+ if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) {
/* Special case for Arith Series */
statePtr->aCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]);
if (statePtr->aCopyList[i] == NULL) {
@@ -2870,7 +2870,7 @@ ForeachAssignments(
Tcl_Obj *valuePtr, *varValuePtr;
for (i=0 ; i<statePtr->numLists ; i++) {
- int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType);
+ int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType);
for (v=0 ; v<statePtr->varcList[i] ; v++) {
k = statePtr->index[i]++;
if (k < statePtr->argcList[i]) {
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index ea82388..552548b 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -2215,7 +2215,7 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
isArithSeries = 1;
listLen = TclArithSeriesObjLength(objv[1]);
} else {
@@ -2748,7 +2748,7 @@ Tcl_LrangeObjCmd(
return result;
}
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
Tcl_Obj *rangeObj;
rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
if (rangeObj) {
@@ -3147,7 +3147,7 @@ Tcl_LreverseObjCmd(
* Handle ArithSeries special case - don't shimmer a series into a list
* just to reverse it.
*/
- if (TclHasInternalRep(objv[1],&tclArithSeriesType)) {
+ if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
if (resObj) {
Tcl_SetObjResult(interp, resObj);
@@ -4733,7 +4733,7 @@ Tcl_LsortObjCmd(
sortInfo.compareCmdPtr = newCommandPtr;
}
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
sortInfo.resultCode = TclArithSeriesGetElements(interp,
listObj, &length, &listObjPtrs);
} else {
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 84a7e91..b559394 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1612,7 +1612,7 @@ StringIsCmd(
case STR_IS_BOOL:
case STR_IS_TRUE:
case STR_IS_FALSE:
- if (!TclHasInternalRep(objPtr, &tclBooleanType)
+ if (!TclHasInternalRep(objPtr, &tclBooleanType.objType)
&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
if (strict) {
result = 0;
@@ -1682,9 +1682,9 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
- if (TclHasInternalRep(objPtr, &tclDoubleType) ||
- TclHasInternalRep(objPtr, &tclIntType) ||
- TclHasInternalRep(objPtr, &tclBignumType)) {
+ if (TclHasInternalRep(objPtr, &tclDoubleType.objType) ||
+ TclHasInternalRep(objPtr, &tclIntType.objType) ||
+ TclHasInternalRep(objPtr, &tclBignumType.objType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1713,8 +1713,8 @@ StringIsCmd(
break;
case STR_IS_INT:
case STR_IS_ENTIER:
- if (TclHasInternalRep(objPtr, &tclIntType) ||
- TclHasInternalRep(objPtr, &tclBignumType)) {
+ if (TclHasInternalRep(objPtr, &tclIntType.objType) ||
+ TclHasInternalRep(objPtr, &tclBignumType.objType)) {
break;
}
string1 = Tcl_GetStringFromObj(objPtr, &length1);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 7ad2fb0..b7bcf7c 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2111,7 +2111,7 @@ ParseLexeme(
* Example: Inf + luence + () becomes a valid function call.
* [Bug 3401704]
*/
- if (TclHasInternalRep(literal, &tclDoubleType)) {
+ if (TclHasInternalRep(literal, &tclDoubleType.objType)) {
const char *p = start;
while (p < end) {
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 26f98e1..a7e6bbf 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -136,20 +136,6 @@ typedef struct Dict {
* dictionaries. */
} Dict;
-/*
- * The structure below defines the dictionary object type by means of
- * functions that can be invoked by generic object code.
- */
-
-const Tcl_ObjType tclDictType = {
- "dict",
- FreeDictInternalRep, /* freeIntRepProc */
- DupDictInternalRep, /* dupIntRepProc */
- UpdateStringOfDict, /* updateStringProc */
- SetDictFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
-};
-
#define DictSetInternalRep(objPtr, dictRepPtr) \
do { \
Tcl_ObjInternalRep ir; \
@@ -166,6 +152,20 @@ const Tcl_ObjType tclDictType = {
} while (0)
/*
+ * The structure below defines the dictionary object type by means of
+ * functions that can be invoked by generic object code.
+ */
+
+const Tcl_ObjType tclDictType = {
+ "dict",
+ FreeDictInternalRep, /* freeIntRepProc */
+ DupDictInternalRep, /* dupIntRepProc */
+ UpdateStringOfDict, /* updateStringProc */
+ SetDictFromAny, /* setFromAnyProc */
+ TCL_OBJTYPE_V0
+};
+
+/*
* The type of the specially adapted version of the Tcl_Obj*-containing hash
* table defined in the tclObj.c code. This version differs in that it
* allocates a bit more space in each hash entry in order to hold the pointers
@@ -603,7 +603,7 @@ SetDictFromAny(
* the conversion from lists to dictionaries.
*/
- if (TclHasInternalRep(objPtr, &tclListType)) {
+ if (TclHasInternalRep(objPtr, &tclListType.objType)) {
size_t objc, i;
Tcl_Obj **objv;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 950cabe..c1a2bfd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -452,11 +452,11 @@ VarHashCreateVar(
*/
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
- ((TclHasInternalRep((objPtr), &tclIntType)) \
+ ((TclHasInternalRep((objPtr), &tclIntType.objType)) \
? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (void *) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
- TclHasInternalRep((objPtr), &tclDoubleType) \
+ TclHasInternalRep((objPtr), &tclDoubleType.objType) \
? (((isnan((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
@@ -4649,7 +4649,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclNewIntObj(objResultPtr, length);
+ TclNewUIntObj(objResultPtr, length);
TRACE_APPEND(("%" TCL_Z_MODIFIER "u\n", length));
NEXT_INST_F(1, 1, 1);
@@ -4660,7 +4660,7 @@ TEBCresume(
/* special case for ArithSeries */
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
length = TclArithSeriesObjLength(valuePtr);
if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
@@ -4681,7 +4681,7 @@ TEBCresume(
*/
if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
- && !TclHasInternalRep(value2Ptr, &tclListType)) {
+ && !TclHasInternalRep(value2Ptr, &tclListType.objType)) {
int code;
DECACHE_STACK_INFO();
@@ -4723,7 +4723,7 @@ TEBCresume(
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
/* special case for ArithSeries */
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
length = TclArithSeriesObjLength(valuePtr);
/* Decode end-offset index values. */
@@ -4943,7 +4943,7 @@ TEBCresume(
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
if (objResultPtr == NULL) {
TRACE_ERROR(interp);
@@ -4971,7 +4971,7 @@ TEBCresume(
if (length > 0) {
size_t i = 0;
Tcl_Obj *o;
- int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);
+ int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType.objType);
/*
* An empty list doesn't match anything.
*/
@@ -6337,7 +6337,7 @@ TEBCresume(
case INST_TRY_CVT_TO_BOOLEAN:
valuePtr = OBJ_AT_TOS;
- if (TclHasInternalRep(valuePtr, &tclBooleanType)) {
+ if (TclHasInternalRep(valuePtr, &tclBooleanType.objType)) {
objResultPtr = TCONST(1);
} else {
int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
@@ -8357,7 +8357,7 @@ ExecuteExtendedBinaryMathOp(
overflowExpon:
if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
- || (value2Ptr->typePtr != &tclIntType)
+ || (value2Ptr->typePtr != &tclIntType.objType)
|| (Tcl_WideUInt)w2 >= (1<<28)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 650ea2d..392ccab 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1091,6 +1091,18 @@ typedef struct ActiveInterpTrace {
#define TCL_TRACE_ENTER_EXEC 1
#define TCL_TRACE_LEAVE_EXEC 2
+typedef struct { /* For internal core use only */
+ Tcl_ObjType objType;
+ struct {
+ size_t (*lengthProc)(Tcl_Obj *obj);
+ } abstractList;
+} TclObjTypeWithAbstractList;
+#define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \
+ }, {lengthProc /* For internal core use only */
+#define ABSTRACTLIST_PROC(objPtr, proc) (((objPtr)->typePtr \
+ && ((objPtr)->typePtr->version > offsetof(TclObjTypeWithAbstractList, abstractList.proc))) ? \
+ ((const TclObjTypeWithAbstractList *)(objPtr)->typePtr)->abstractList.proc : NULL)
+
/*
* The structure below defines an entry in the assocData hash table which is
* associated with an interpreter. The entry contains a pointer to a function
@@ -2613,7 +2625,7 @@ typedef struct ListRep {
* converted to a list.
*/
#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \
- (((listObj_)->typePtr == &tclListType) \
+ (((listObj_)->typePtr == &tclListType.objType) \
? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
TCL_OK) \
: Tcl_ListObjGetElements( \
@@ -2625,12 +2637,12 @@ typedef struct ListRep {
* Tcl_Obj cannot be converted to a list.
*/
#define TclListObjLengthM(interp_, listObj_, lenPtr_) \
- (((listObj_)->typePtr == &tclListType) \
+ (((listObj_)->typePtr == &tclListType.objType) \
? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
: Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
#define TclListObjIsCanonical(listObj_) \
- (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
+ (((listObj_)->typePtr == &tclListType.objType) ? ListObjIsCanonical((listObj_)) : 0)
/*
* Modes for collecting (or not) in the implementations of TclNRForeachCmd,
@@ -2650,27 +2662,27 @@ typedef struct ListRep {
#if TCL_MAJOR_VERSION > 8
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
- (((objPtr)->typePtr == &tclIntType \
- || (objPtr)->typePtr == &tclBooleanType) \
+ (((objPtr)->typePtr == &tclIntType.objType \
+ || (objPtr)->typePtr == &tclBooleanType.objType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#else
#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
- (((objPtr)->typePtr == &tclIntType) \
+ (((objPtr)->typePtr == &tclIntType.objType) \
? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
- : ((objPtr)->typePtr == &tclBooleanType) \
+ : ((objPtr)->typePtr == &tclBooleanType.objType) \
? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
#endif
#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
- (((objPtr)->typePtr == &tclIntType) \
+ (((objPtr)->typePtr == &tclIntType.objType) \
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
- (((objPtr)->typePtr == &tclIntType \
+ (((objPtr)->typePtr == &tclIntType.objType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2678,13 +2690,13 @@ typedef struct ListRep {
#endif
#define TclGetIntFromObj(interp, objPtr, intPtr) \
- (((objPtr)->typePtr == &tclIntType \
+ (((objPtr)->typePtr == &tclIntType.objType \
&& (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
- ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
+ ((((objPtr)->typePtr == &tclIntType.objType) && ((objPtr)->internalRep.wideValue >= 0) \
&& ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \
? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
@@ -2698,7 +2710,7 @@ typedef struct ListRep {
*/
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
- (((objPtr)->typePtr == &tclIntType) \
+ (((objPtr)->typePtr == &tclIntType.objType) \
? (*(wideIntPtr) = \
((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
@@ -2876,13 +2888,13 @@ MODULE_SCOPE void *tclTimeClientData;
* Variables denoting the Tcl object types defined in the core.
*/
-MODULE_SCOPE const Tcl_ObjType tclBignumType;
-MODULE_SCOPE const Tcl_ObjType tclBooleanType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclBignumType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
-MODULE_SCOPE const Tcl_ObjType tclDoubleType;
-MODULE_SCOPE const Tcl_ObjType tclIntType;
-MODULE_SCOPE const Tcl_ObjType tclListType;
-MODULE_SCOPE const Tcl_ObjType tclArithSeriesType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclDoubleType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclIntType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclListType;
+MODULE_SCOPE const TclObjTypeWithAbstractList tclArithSeriesType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -4763,7 +4775,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_ObjInternalRep ir; \
ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
- Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \
+ Tcl_StoreInternalRep(objPtr, &tclIntType.objType, &ir); \
} while (0)
#define TclSetDoubleObj(objPtr, d) \
@@ -4771,7 +4783,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_ObjInternalRep ir; \
ir.doubleValue = (double) d; \
TclInvalidateStringRep(objPtr); \
- Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \
+ Tcl_StoreInternalRep(objPtr, &tclDoubleType.objType, &ir); \
} while (0)
/*
@@ -4796,7 +4808,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
- (objPtr)->typePtr = &tclIntType; \
+ (objPtr)->typePtr = &tclIntType.objType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4815,7 +4827,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TclSetBignumInternalRep((objPtr), &bignumValue_); \
} else { \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
- (objPtr)->typePtr = &tclIntType; \
+ (objPtr)->typePtr = &tclIntType.objType; \
} \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4829,7 +4841,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
Tcl_WideUInt uw_ = (uw); \
if (uw_ >= TCL_INDEX_NONE) { \
(objPtr)->internalRep.wideValue = -1; \
- (objPtr)->typePtr = &tclIntType; \
+ (objPtr)->typePtr = &tclIntType.objType; \
} else if (uw_ > WIDE_MAX) { \
mp_int bignumValue_; \
if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \
@@ -4838,7 +4850,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
TclSetBignumInternalRep((objPtr), &bignumValue_); \
} else { \
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \
- (objPtr)->typePtr = &tclIntType; \
+ (objPtr)->typePtr = &tclIntType.objType; \
} \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
@@ -4850,7 +4862,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
(objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType; \
+ (objPtr)->typePtr = &tclDoubleType.objType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
diff --git a/generic/tclLink.c b/generic/tclLink.c
index e0e82dd..37c104b 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -547,7 +547,7 @@ GetDouble(
return 0;
} else {
#ifdef ACCEPT_NAN
- Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
+ Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
if (irPtr != NULL) {
*dblPtr = irPtr->doubleValue;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 45765a1..e29c307 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -69,7 +69,7 @@
/* Checks for when caller should have already converted to internal list type */
#define LIST_ASSERT_TYPE(listObj_) \
- LIST_ASSERT((listObj_)->typePtr == &tclListType);
+ LIST_ASSERT((listObj_)->typePtr == &tclListType.objType);
/*
@@ -143,6 +143,7 @@ static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeListInternalRep(Tcl_Obj *listPtr);
static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfList(Tcl_Obj *listPtr);
+static size_t ListLength(Tcl_Obj *listPtr);
/*
* The structure below defines the list Tcl object type by means of functions
@@ -151,13 +152,15 @@ static void UpdateStringOfList(Tcl_Obj *listPtr);
* The internal representation of a list object is ListRep defined in tcl.h.
*/
-const Tcl_ObjType tclListType = {
- "list", /* name */
+const TclObjTypeWithAbstractList tclListType = {
+ {"list", /* name */
FreeListInternalRep, /* freeIntRepProc */
DupListInternalRep, /* dupIntRepProc */
UpdateStringOfList, /* updateStringProc */
SetListFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ ListLength
+ )}
};
/* Macros to manipulate the List internal rep */
@@ -203,7 +206,7 @@ const Tcl_ObjType tclListType = {
do { \
(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr; \
- (objPtr_)->typePtr = &tclListType; \
+ (objPtr_)->typePtr = &tclListType.objType; \
} while (0)
#define ListObjOverwriteRep(objPtr_, repPtr_) \
@@ -1273,7 +1276,7 @@ TclListObjGetRep(
* to be returned. */
ListRep *repPtr) /* Location to store descriptor */
{
- if (!TclHasInternalRep(listObj, &tclListType)) {
+ if (!TclHasInternalRep(listObj, &tclListType.objType)) {
int result;
result = SetListFromAny(interp, listObj);
if (result != TCL_OK) {
@@ -1367,8 +1370,8 @@ TclListObjCopy(
{
Tcl_Obj *copyObj;
- if (!TclHasInternalRep(listObj, &tclListType)) {
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ if (!TclHasInternalRep(listObj, &tclListType.objType)) {
+ if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
return TclArithSeriesObjCopy(interp, listObj);
}
if (SetListFromAny(interp, listObj) != TCL_OK) {
@@ -1664,7 +1667,7 @@ Tcl_ListObjGetElements(
{
ListRep listRep;
- if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
}
@@ -1994,8 +1997,9 @@ Tcl_ListObjLength(
{
ListRep listRep;
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
- *lenPtr = TclArithSeriesObjLength(listObj);
+ size_t (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc);
+ if (lengthProc) {
+ *lenPtr = lengthProc(listObj);
return TCL_OK;
}
@@ -2012,6 +2016,15 @@ Tcl_ListObjLength(
*lenPtr = ListRepLength(&listRep);
return TCL_OK;
}
+
+size_t ListLength(
+ Tcl_Obj *listPtr)
+{
+ ListRep listRep;
+ ListObjGetRep(listPtr, &listRep);
+
+ return ListRepLength(&listRep);
+}
/*
*----------------------------------------------------------------------
@@ -2554,7 +2567,7 @@ TclLindexList(
* shimmering; if internal rep is already a list do not shimmer it.
* see TIP#22 and TIP#33 for the details.
*/
- if (!TclHasInternalRep(argObj, &tclListType)
+ if (!TclHasInternalRep(argObj, &tclListType.objType)
&& TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index)
== TCL_OK) {
/*
@@ -2627,7 +2640,7 @@ TclLindexFlat(
Tcl_Size i;
/* Handle ArithSeries as special case */
- if (TclHasInternalRep(listObj,&tclArithSeriesType)) {
+ if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
Tcl_Size listLen = TclArithSeriesObjLength(listObj);
Tcl_Size index;
Tcl_Obj *elemObj = NULL;
@@ -2745,7 +2758,7 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
- if (!TclHasInternalRep(indexArgObj, &tclListType)
+ if (!TclHasInternalRep(indexArgObj, &tclListType.objType)
&& TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
== TCL_OK) {
/* indexArgPtr designates a single index. */
@@ -3275,7 +3288,7 @@ SetListFromAny(
Tcl_IncrRefCount(valuePtr);
Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
}
- } else if (TclHasInternalRep(objPtr,&tclArithSeriesType)) {
+ } else if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
/*
* Convertion from Arithmetic Series is a special case
* because it can be done an order of magnitude faster
@@ -3383,7 +3396,7 @@ fail:
TclFreeInternalRep(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
- objPtr->typePtr = &tclListType;
+ objPtr->typePtr = &tclListType.objType;
return TCL_OK;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 76f1627..67b7487 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -225,37 +225,47 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
-const Tcl_ObjType tclBooleanType = {
- "boolean", /* name */
+static size_t LengthOne(TCL_UNUSED(Tcl_Obj *)) {return 1;}
+
+const TclObjTypeWithAbstractList tclBooleanType= {
+ {"boolean", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
TclSetBooleanFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ LengthOne
+ )}
};
-const Tcl_ObjType tclDoubleType = {
- "double", /* name */
+const TclObjTypeWithAbstractList tclDoubleType= {
+ {"double", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ LengthOne
+ )}
};
-const Tcl_ObjType tclIntType = {
- "int", /* name */
+const TclObjTypeWithAbstractList tclIntType = {
+ {"int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ LengthOne
+ )}
};
-const Tcl_ObjType tclBignumType = {
- "bignum", /* name */
+const TclObjTypeWithAbstractList tclBignumType = {
+ {"bignum", /* name */
FreeBignum, /* freeIntRepProc */
DupBignum, /* dupIntRepProc */
UpdateStringOfBignum, /* updateStringProc */
NULL, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ LengthOne
+ )}
};
/*
@@ -365,9 +375,9 @@ TclInitObjSubsystem(void)
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
Tcl_MutexUnlock(&tableMutex);
- Tcl_RegisterObjType(&tclDoubleType);
+ Tcl_RegisterObjType(&tclDoubleType.objType);
Tcl_RegisterObjType(&tclStringType);
- Tcl_RegisterObjType(&tclListType);
+ Tcl_RegisterObjType(&tclListType.objType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclCmdNameType);
@@ -2007,11 +2017,11 @@ Tcl_GetBoolFromObj(
return TCL_ERROR;
}
do {
- if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
+ if (objPtr->typePtr == &tclIntType.objType || objPtr->typePtr == &tclBooleanType.objType) {
result = (objPtr->internalRep.wideValue != 0);
goto boolEnd;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
/*
* Caution: Don't be tempted to check directly for the "double"
* Tcl_ObjType and then compare the internalrep to 0.0. This isn't
@@ -2028,7 +2038,7 @@ Tcl_GetBoolFromObj(
result = (d != 0.0);
goto boolEnd;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
result = 1;
boolEnd:
if (charPtr != NULL) {
@@ -2096,18 +2106,18 @@ TclSetBooleanFromAny(
*/
if (objPtr->bytes == NULL) {
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
goto badBoolean;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
goto badBoolean;
}
}
@@ -2238,13 +2248,13 @@ ParseBoolean(
goodBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
- objPtr->typePtr = &tclBooleanType;
+ objPtr->typePtr = &tclBooleanType.objType;
return TCL_OK;
numericBoolean:
TclFreeInternalRep(objPtr);
objPtr->internalRep.wideValue = newBool;
- objPtr->typePtr = &tclIntType;
+ objPtr->typePtr = &tclIntType.objType;
return TCL_OK;
}
@@ -2336,7 +2346,7 @@ Tcl_DbNewDoubleObj(
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
- objPtr->typePtr = &tclDoubleType;
+ objPtr->typePtr = &tclDoubleType.objType;
return objPtr;
}
@@ -2409,7 +2419,7 @@ Tcl_GetDoubleFromObj(
double *dblPtr) /* Place to store resulting double. */
{
do {
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (isnan(objPtr->internalRep.doubleValue)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2422,11 +2432,11 @@ Tcl_GetDoubleFromObj(
*dblPtr = (double) objPtr->internalRep.doubleValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
mp_int big;
TclUnpackBignum(objPtr, big);
@@ -2640,12 +2650,12 @@ Tcl_GetLongFromObj(
{
do {
#ifdef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
*longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
#else
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
/*
* We return any integer in the range LONG_MIN to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
@@ -2664,7 +2674,7 @@ Tcl_GetLongFromObj(
goto tooLarge;
}
#endif
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -2673,7 +2683,7 @@ Tcl_GetLongFromObj(
}
return TCL_ERROR;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
/*
* Must check for those bignum values that can fit in a long, even
* when auto-narrowing is enabled. Only those values in the signed
@@ -2901,11 +2911,11 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -2914,7 +2924,7 @@ Tcl_GetWideIntFromObj(
}
return TCL_ERROR;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideInt, even when auto-narrowing is enabled.
@@ -2986,7 +2996,7 @@ Tcl_GetWideUIntFromObj(
/* Place to store resulting long. */
{
do {
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
if (objPtr->internalRep.wideValue < 0) {
wideUIntOutOfRange:
if (interp != NULL) {
@@ -3000,10 +3010,10 @@ Tcl_GetWideUIntFromObj(
*wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
goto wideUIntOutOfRange;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
/*
* Must check for those bignum values that can fit in a
* Tcl_WideUInt, even when auto-narrowing is enabled.
@@ -3070,11 +3080,11 @@ TclGetWideBitsFromObj(
Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
{
do {
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3083,7 +3093,7 @@ TclGetWideBitsFromObj(
}
return TCL_ERROR;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
mp_int big;
mp_err err;
@@ -3162,7 +3172,7 @@ DupBignum(
mp_int bignumVal;
mp_int bignumCopy;
- copyPtr->typePtr = &tclBignumType;
+ copyPtr->typePtr = &tclBignumType.objType;
TclUnpackBignum(srcPtr, bignumVal);
if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
Tcl_Panic("initialization failure in DupBignum");
@@ -3332,7 +3342,7 @@ GetBignumFromObj(
mp_int *bignumValue) /* Returned bignum value. */
{
do {
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
if (copy || Tcl_IsShared(objPtr)) {
mp_int temp;
@@ -3357,14 +3367,14 @@ GetBignumFromObj(
}
return TCL_OK;
}
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
if (mp_init_i64(bignumValue,
objPtr->internalRep.wideValue) != MP_OKAY) {
return TCL_ERROR;
}
return TCL_OK;
}
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
@@ -3524,7 +3534,7 @@ TclSetBignumInternalRep(
void *big)
{
mp_int *bignumValue = (mp_int *)big;
- objPtr->typePtr = &tclBignumType;
+ objPtr->typePtr = &tclBignumType.objType;
PACK_BIGNUM(*bignumValue, objPtr);
/*
@@ -3567,7 +3577,7 @@ Tcl_GetNumberFromObj(
int *typePtr)
{
do {
- if (objPtr->typePtr == &tclDoubleType) {
+ if (objPtr->typePtr == &tclDoubleType.objType) {
if (isnan(objPtr->internalRep.doubleValue)) {
*typePtr = TCL_NUMBER_NAN;
} else {
@@ -3576,12 +3586,12 @@ Tcl_GetNumberFromObj(
*clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclIntType) {
+ if (objPtr->typePtr == &tclIntType.objType) {
*typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
- if (objPtr->typePtr == &tclBignumType) {
+ if (objPtr->typePtr == &tclBignumType.objType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
sizeof(mp_int));
@@ -4520,7 +4530,7 @@ Tcl_RepresentationCmd(
objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
- if (objv[1]->typePtr == &tclDoubleType) {
+ if (objv[1]->typePtr == &tclDoubleType.objType) {
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
objv[1]->internalRep.doubleValue);
} else {
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 5eafa53..ee18174 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -1019,7 +1019,7 @@ Tcl_ScanObjCmd(
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
const Tcl_ObjInternalRep *irPtr
- = TclFetchInternalRep(objPtr, &tclDoubleType);
+ = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
if (irPtr) {
dvalue = irPtr->doubleValue;
} else
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index a816062..fed2aea 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -554,7 +554,7 @@ TclParseNumber(
/* A dict can never be a (single) number */
return TCL_ERROR;
}
- if (TclHasInternalRep(objPtr, &tclListType)) {
+ if (TclHasInternalRep(objPtr, &tclListType.objType)) {
size_t length;
/* A list can only be a (single) number if its length == 1 */
TclListObjLengthM(NULL, objPtr, &length);
@@ -1377,7 +1377,7 @@ TclParseNumber(
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
- objPtr->typePtr = &tclIntType;
+ objPtr->typePtr = &tclIntType.objType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-octalSignificandWide);
@@ -1413,7 +1413,7 @@ TclParseNumber(
significandWide);
significandOverflow = 1;
} else {
- objPtr->typePtr = &tclIntType;
+ objPtr->typePtr = &tclIntType.objType;
if (signum) {
objPtr->internalRep.wideValue =
(Tcl_WideInt)(-significandWide);
@@ -1445,7 +1445,7 @@ TclParseNumber(
* k = numTrailZeros+exponent-numDigitsAfterDp.
*/
- objPtr->typePtr = &tclDoubleType;
+ objPtr->typePtr = &tclDoubleType.objType;
if (exponentSignum) {
/*
* At this point exponent>=0, so the following calculation
@@ -1496,14 +1496,14 @@ TclParseNumber(
} else {
objPtr->internalRep.doubleValue = HUGE_VAL;
}
- objPtr->typePtr = &tclDoubleType;
+ objPtr->typePtr = &tclDoubleType.objType;
break;
#ifdef IEEE_FLOATING_POINT
case sNAN:
case sNANFINISH:
objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
- objPtr->typePtr = &tclDoubleType;
+ objPtr->typePtr = &tclDoubleType.objType;
break;
#endif
case INITIAL:
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0b898f1..a53ca28 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -122,13 +122,17 @@ static int FindElement(Tcl_Interp *interp, const char *string,
* is unregistered, so has no need of a setFromAnyProc either.
*/
-static const Tcl_ObjType endOffsetType = {
- "end-offset", /* name */
+static size_t LengthOne(TCL_UNUSED(Tcl_Obj *)) {return 1;}
+
+static const TclObjTypeWithAbstractList endOffsetType = {
+ {"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
- TCL_OBJTYPE_V0
+ TCL_OBJTYPE_V0_1(
+ LengthOne
+ )}
};
/*
@@ -3455,7 +3459,7 @@ GetEndOffsetFromObj(
Tcl_WideInt offset = -1; /* Offset in the "end-offset" expression - 1 */
void *cd;
- while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
+ while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType)) == NULL) {
Tcl_ObjInternalRep ir;
size_t length;
const char *bytes = Tcl_GetStringFromObj(objPtr, &length);
@@ -3641,7 +3645,7 @@ GetEndOffsetFromObj(
parseOK:
/* Success. Store the new internal rep. */
ir.wideValue = offset;
- Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
+ Tcl_StoreInternalRep(objPtr, &endOffsetType.objType, &ir);
}
offset = irPtr->wideValue;
@@ -3743,7 +3747,7 @@ TclIndexEncode(
int idx;
if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType);
+ const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType);
if (irPtr && irPtr->wideValue >= 0) {
/* "int[+-]int" syntax, works the same here as "int" */
irPtr = NULL;
generated by cgit v0.12 at 2024-11-16 09:49:02 (GMT)