From 826db93d76965d85df64187e05ec05095a6eae56 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 23 Nov 2022 17:04:18 +0000 Subject: Internal abstract list, don't let "llength" shimmer any more. --- generic/tclArithSeries.c | 29 +++++++------- generic/tclArithSeries.h | 10 ++--- generic/tclBasic.c | 14 +++---- generic/tclBinary.c | 4 +- generic/tclClock.c | 2 +- generic/tclCmdAH.c | 4 +- generic/tclCmdIL.c | 8 ++-- generic/tclCmdMZ.c | 12 +++--- generic/tclCompExpr.c | 2 +- generic/tclDictObj.c | 30 +++++++------- generic/tclExecute.c | 18 ++++----- generic/tclInt.h | 58 +++++++++++++++------------ generic/tclLink.c | 2 +- generic/tclListObj.c | 59 ++++++++++++++++++--------- generic/tclObj.c | 102 +++++++++++++++++++++++++---------------------- generic/tclScan.c | 2 +- generic/tclStrToD.c | 12 +++--- generic/tclUtil.c | 15 ++++--- generic/tclVar.c | 8 +++- 19 files changed, 217 insertions(+), 174 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 3fa9792..ccae8aa 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,14 @@ 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 +155,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 +202,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 +388,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,11 +428,11 @@ 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); - if (index < 0 || index >= arithSeriesRepPtr->len) { + if ((unsigned long long)index >= arithSeriesRepPtr->len) { return TCL_ERROR; } /* List[i] = Start + (Step * index) */ @@ -460,7 +461,7 @@ TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **ele * *---------------------------------------------------------------------- */ -Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr) +unsigned long long TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr) { ArithSeries *arithSeriesRepPtr = (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1; @@ -491,7 +492,7 @@ FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr) ArithSeries *arithSeriesRepPtr = (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1; if (arithSeriesRepPtr->elements) { - Tcl_WideInt i; + unsigned long long i; Tcl_Obj**elmts = arithSeriesRepPtr->elements; for(i=0; ilen; i++) { if (elmts[i]) { @@ -538,7 +539,7 @@ DupArithSeriesInternalRep( copyArithSeriesRepPtr->elements = NULL; copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; copyPtr->internalRep.twoPtrValue.ptr2 = NULL; - copyPtr->typePtr = &tclArithSeriesType; + copyPtr->typePtr = &tclArithSeriesType.objType; } /* @@ -576,7 +577,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr) (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1; char *elem, *p; Tcl_Obj *elemObj; - Tcl_WideInt i; + unsigned long long i; Tcl_WideInt length = 0; int slen; @@ -845,7 +846,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/tclArithSeries.h b/generic/tclArithSeries.h index f7f2fa8..8392a57 100644 --- a/generic/tclArithSeries.h +++ b/generic/tclArithSeries.h @@ -15,16 +15,16 @@ * Note that the len can in theory be always computed by start,end,step * but it's faster to cache it inside the internal representation. */ -typedef struct ArithSeries { - Tcl_WideInt len; +typedef struct { + unsigned long long len; Tcl_Obj **elements; int isDouble; Tcl_WideInt start; Tcl_WideInt end; Tcl_WideInt step; } ArithSeries; -typedef struct ArithSeriesDbl { - Tcl_WideInt len; +typedef struct { + unsigned long long len; Tcl_Obj **elements; int isDouble; double start; @@ -39,7 +39,7 @@ MODULE_SCOPE int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj); MODULE_SCOPE int TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj); -MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); +MODULE_SCOPE unsigned long long TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx); MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Interp *interp, diff --git a/generic/tclBasic.c b/generic/tclBasic.c index cd1bfc8..0f968e1 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 84188ef..975b8e6 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2017,7 +2017,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; } @@ -2037,7 +2037,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 6fd8327..36f82e6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -432,7 +432,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 a5384fd..928b68f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2726,7 +2726,7 @@ EachloopCmd( } /* 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) { @@ -2868,7 +2868,7 @@ ForeachAssignments( Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; inumLists ; i++) { - int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType); + int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType); for (v=0 ; vvarcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 1ca6c5e..befcb9a 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 { @@ -2746,7 +2746,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) { @@ -3145,7 +3145,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); @@ -4728,7 +4728,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 8abf166..7506e66 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 fbd59d8..5e7806d 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 926fd61..610b88e 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)), \ @@ -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 554d642..8d850db 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1076,6 +1076,14 @@ typedef struct ActiveInterpTrace { * in reverse order. */ } ActiveInterpTrace; + +#define TCL_OBJTYPE_V0_1 ((size_t)1) /* For internal core use only */ + +typedef struct { /* For internal core use only */ + Tcl_ObjType objType; + unsigned long long (*lengthProc)(Tcl_Obj *obj); +} TclObjTypeWithAbstractList; + /* * Flag values designating types of execution traces. See tclTrace.c for * related flag values. @@ -2613,7 +2621,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 +2633,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 +2658,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 +2686,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 +2706,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 +2884,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; @@ -4764,7 +4772,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) \ @@ -4772,7 +4780,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) /* @@ -4797,7 +4805,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) @@ -4816,7 +4824,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) @@ -4830,7 +4838,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) { \ @@ -4839,7 +4847,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) @@ -4851,7 +4859,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 a0212ee..a28a030 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 ea5afac..d9fcada 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -68,7 +68,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); /* @@ -142,6 +142,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 unsigned long long ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions @@ -150,13 +151,14 @@ 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 */ @@ -202,7 +204,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_) \ @@ -1272,7 +1274,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) { @@ -1366,8 +1368,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) { @@ -1663,7 +1665,7 @@ Tcl_ListObjGetElements( { ListRep listRep; - if (TclHasInternalRep(objPtr,&tclArithSeriesType)) { + if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) { return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr); } @@ -1991,11 +1993,19 @@ Tcl_ListObjLength( Tcl_Obj *listObj, /* List object whose #elements to return. */ Tcl_Size *lenPtr) /* The resulting int is stored here. */ { - ListRep listRep; - - if (TclHasInternalRep(listObj,&tclArithSeriesType)) { - *lenPtr = TclArithSeriesObjLength(listObj); - return TCL_OK; + if (listObj->typePtr && (listObj->typePtr->version == TCL_OBJTYPE_V0_1)) { + const TclObjTypeWithAbstractList *objType = (const TclObjTypeWithAbstractList *)listObj->typePtr; + if (objType->lengthProc) { + unsigned long long len = objType->lengthProc(listObj); + if (len >= TCL_INDEX_NONE) { + if (interp) { + Tcl_AppendResult(interp, "List too large"); + } + return TCL_ERROR; + } + *lenPtr = len; + return TCL_OK; + } } /* @@ -2005,12 +2015,23 @@ Tcl_ListObjLength( * other hand, this code will be faster for the case where the object * is currently a dict. Benchmark the two cases. */ + ListRep listRep; + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } *lenPtr = ListRepLength(&listRep); return TCL_OK; } + +unsigned long long ListLength( + Tcl_Obj *listPtr) +{ + ListRep listRep; + ListObjGetRep(listPtr, &listRep); + + return ListRepLength(&listRep); +} /* *---------------------------------------------------------------------- @@ -2553,7 +2574,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) { /* @@ -2626,7 +2647,7 @@ TclLindexFlat( Tcl_Size i; /* Handle ArithSeries as special case */ - if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) { Tcl_WideInt listLen = TclArithSeriesObjLength(listObj); Tcl_Size index; Tcl_Obj *elemObj = NULL; @@ -2744,7 +2765,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. */ @@ -3274,7 +3295,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 @@ -3382,7 +3403,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..5e3f4f1 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -225,37 +225,43 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * implementations. */ -const Tcl_ObjType tclBooleanType = { - "boolean", /* name */ +static unsigned long long 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 +371,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 +2013,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 +2034,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 +2102,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 +2244,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 +2342,7 @@ Tcl_DbNewDoubleObj( objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; - objPtr->typePtr = &tclDoubleType; + objPtr->typePtr = &tclDoubleType.objType; return objPtr; } @@ -2409,7 +2415,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 +2428,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 +2646,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 +2670,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 +2679,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 +2907,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 +2920,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 +2992,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 +3006,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 +3076,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 +3089,7 @@ TclGetWideBitsFromObj( } return TCL_ERROR; } - if (objPtr->typePtr == &tclBignumType) { + if (objPtr->typePtr == &tclBignumType.objType) { mp_int big; mp_err err; @@ -3162,7 +3168,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 +3338,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 +3363,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 +3530,7 @@ TclSetBignumInternalRep( void *big) { mp_int *bignumValue = (mp_int *)big; - objPtr->typePtr = &tclBignumType; + objPtr->typePtr = &tclBignumType.objType; PACK_BIGNUM(*bignumValue, objPtr); /* @@ -3567,7 +3573,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 +3582,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 +4526,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 0a8e9ae..3e9cfae 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..b23d134 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -122,13 +122,16 @@ 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 unsigned long long 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 +3458,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 +3644,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 +3746,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; diff --git a/generic/tclVar.c b/generic/tclVar.c index 6226e1e..f7ec7c8 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4042,8 +4042,7 @@ ArraySetCmd( size_t elemLen; Tcl_Obj **elemPtrs, *copyListObj; - result = TclListObjGetElementsM(interp, arrayElemObj, - &elemLen, &elemPtrs); + result = TclListObjLengthM(interp, arrayElemObj, &elemLen); if (result != TCL_OK) { return result; } @@ -4056,6 +4055,11 @@ ArraySetCmd( if (elemLen == 0) { goto ensureArray; } + result = TclListObjGetElementsM(interp, arrayElemObj, + &elemLen, &elemPtrs); + if (result != TCL_OK) { + return result; + } /* * We needn't worry about traces invalidating arrayPtr: should that be -- cgit v0.12