From f3896e51875d3696de089804ab5e205403ee842a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 4 Nov 2022 11:11:18 +0000 Subject: New functions Tcl_NewWideUIntObj()/Tcl_SetWideUIntObj() (still experimental) --- doc/IntObj.3 | 29 +++++++++++++--------- generic/tcl.decls | 8 ++++++ generic/tclClock.c | 4 +-- generic/tclCmdMZ.c | 2 +- generic/tclDecls.h | 11 +++++++++ generic/tclLink.c | 4 +-- generic/tclObj.c | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubInit.c | 2 ++ generic/tclTest.c | 2 +- 9 files changed, 113 insertions(+), 17 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index d640dbb..5577cc9 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -22,12 +22,17 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewWideIntObj\fR(\fIwideValue\fR) .sp +Tcl_Obj * +\fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) +.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp \fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) .sp +\fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) +.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp @@ -66,6 +71,8 @@ Integer value used to initialize or set a Tcl value. Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. +.AP Tcl_WideUInt uwideValue in +Unsigned wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an @@ -107,18 +114,18 @@ The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, -and \fBTcl_NewBignumObj\fR routines each create and return a new -Tcl value initialized to the integral value of the argument. The -returned Tcl value is unshared. +\fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create +and return a new Tcl value initialized to the integral value of the +argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -and \fBTcl_SetBignumObj\fR routines each set the value of an existing -Tcl value pointed to by \fIobjPtr\fR to the integral value provided -by the other argument. The \fIobjPtr\fR argument must point to an -unshared Tcl value. Any attempt to set the value of a shared Tcl value -violates Tcl's copy-on-write policy. Any existing string representation -or internal representation in the unshared Tcl value will be freed -as a consequence of setting the new value. +\fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set +the value of an existing Tcl value pointed to by \fIobjPtr\fR to the +integral value provided by the other argument. The \fIobjPtr\fR +argument must point to an unshared Tcl value. Any attempt to set the +value of a shared Tcl value violates Tcl's copy-on-write policy. Any +existing string representation or internal representation in the unshared +Tcl value will be freed as a consequence of setting the new value. .PP The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index value from the Tcl value \fIobjPtr\fR. If the attempt succeeds, diff --git a/generic/tcl.decls b/generic/tcl.decls index 994af13..f3d8924 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2552,6 +2552,14 @@ declare 683 { int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) } +# TIP #648 +declare 684 { + Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue) +} +declare 685 { + void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## diff --git a/generic/tclClock.c b/generic/tclClock.c index a9ba70c..72605ca 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1810,7 +1810,7 @@ ClockMillisecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj( now.sec * 1000 + now.usec / 1000)); return TCL_OK; } @@ -1998,7 +1998,7 @@ ClockSecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj(now.sec)); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index b063689..3f42438 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4099,7 +4099,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec); + objs[0] = Tcl_NewWideUIntObj((count <= 0) ? 0 : (Tcl_WideUInt)totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8cb77b8..f7523fd 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2038,6 +2038,11 @@ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); +/* 684 */ +EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); +/* 685 */ +EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, + Tcl_WideUInt uwideValue); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2757,6 +2762,8 @@ typedef struct TclStubs { int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ + Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 684 */ + void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 685 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4155,6 +4162,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ +#define Tcl_NewWideUIntObj \ + (tclStubsPtr->tcl_NewWideUIntObj) /* 684 */ +#define Tcl_SetWideUIntObj \ + (tclStubsPtr->tcl_SetWideUIntObj) /* 685 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclLink.c b/generic/tclLink.c index 0d57d44..7775cf8 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -1456,7 +1456,7 @@ ObjValue( memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { - TclNewIntObj(objv[i], (Tcl_WideInt) + objv[i] = Tcl_NewWideUIntObj( linkPtr->lastValue.uwPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); @@ -1464,7 +1464,7 @@ ObjValue( return resultObj; } linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); - return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw); + return Tcl_NewWideUIntObj(linkPtr->lastValue.uw); case TCL_LINK_STRING: p = LinkedVar(char *); diff --git a/generic/tclObj.c b/generic/tclObj.c index ce8e610..806f910 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3219,6 +3219,34 @@ Tcl_NewWideIntObj( /* *---------------------------------------------------------------------- * + * Tcl_NewWideUIntObj -- + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_NewWideUIntObj( + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the new + * object. */ +{ + Tcl_Obj *objPtr; + + TclNewObj(objPtr); + Tcl_SetWideUIntObj(objPtr, uwideValue); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to @@ -3312,6 +3340,46 @@ Tcl_SetWideIntObj( TclSetIntObj(objPtr, wideValue); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetWideUIntObj -- + * + * Modify an object to be a wide integer object or a bignum object + * and to have the specified unsigned wide integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetWideUIntObj( + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the + * object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + } + + if (uwideValue > WIDE_MAX) { + mp_int bignumValue; + if (mp_init_i64(&bignumValue, uwideValue) != MP_OKAY) { + Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + } + TclSetBignumInternalRep(objPtr, &bignumValue); + } { + TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); + } +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1ffe916..8c72144 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2050,6 +2050,8 @@ const TclStubs tclStubs = { Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ + Tcl_NewWideUIntObj, /* 684 */ + Tcl_SetWideUIntObj, /* 685 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index c9bad56..878e51f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -3119,7 +3119,7 @@ TestlinkCmd( Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); - tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); + tmp = Tcl_NewWideUIntObj(uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { -- cgit v0.12 From 3b7f710d06680e498bd8d451f6c47cb6c78918f7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 Nov 2022 22:18:01 +0000 Subject: New functions Tcl_NewSizeObj/Tcl_SetSizeObj --- generic/tclDecls.h | 8 ++++++++ generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 6 +++--- generic/tclListObj.c | 8 +++----- 4 files changed, 15 insertions(+), 9 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 9344d68..d802789 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4431,6 +4431,14 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) +#if TCL_MAJOR_VERSION > 8 +# define Tcl_NewSizeObj(value) (((value) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetSizeObj(objPtr, value) (((value) == TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +#else +# define Tcl_NewSizeObj Tcl_NewIntObj +# define Tcl_SetSizeObj Tcl_SetIntObj +#endif + #if TCL_UTF_MAX < 4 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString diff --git a/generic/tclInt.decls b/generic/tclInt.decls index c0e0e06..b3e352a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -701,7 +701,7 @@ declare 258 { # TIP 625: for unit testing - create list objects with span declare 260 { - Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace) + Tcl_Obj *TclListTestObj(Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) } # TIP 625: for unit testing - check list invariants diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3da8567..4c8d897 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -660,8 +660,8 @@ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* Slot 259 is reserved */ /* 260 */ -EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace, - int endSpace); +EXTERN Tcl_Obj * TclListTestObj(Tcl_Size length, + Tcl_Size leadingSpace, Tcl_Size endSpace); /* 261 */ EXTERN void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj); @@ -930,7 +930,7 @@ typedef struct TclIntStubs { void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ void (*reserved259)(void); - Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */ + Tcl_Obj * (*tclListTestObj) (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace); /* 260 */ void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */ } TclIntStubs; diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 8ee0f48..6950d9d 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -3514,10 +3514,8 @@ UpdateStringOfList( *------------------------------------------------------------------------ */ Tcl_Obj * -TclListTestObj (int length, int leadingSpace, int endSpace) +TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) { - if (length < 0) - length = 0; if (leadingSpace < 0) leadingSpace = 0; if (endSpace < 0) @@ -3538,9 +3536,9 @@ TclListTestObj (int length, int leadingSpace, int endSpace) ListRepInit(capacity, NULL, 0, &listRep); ListStore *storePtr = listRep.storePtr; - int i; + Tcl_Size i; for (i = 0; i < length; ++i) { - storePtr->slots[i + leadingSpace] = Tcl_NewIntObj(i); + storePtr->slots[i + leadingSpace] = Tcl_NewSizeObj(i); Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]); } storePtr->firstUsed = leadingSpace; -- cgit v0.12 From 9dd0e900483a5b0cca9e68966d34dffa814b43e2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 15:21:13 +0000 Subject: If value is out-of-range (e.g. on 32-bit system >= 2^32-1), Tcl_NewSizeObj() will result in a '-1' object as well --- generic/tclDecls.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d802789..b9d2347 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4432,8 +4432,8 @@ extern const TclStubs *tclStubsPtr; #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_MAJOR_VERSION > 8 -# define Tcl_NewSizeObj(value) (((value) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) -# define Tcl_SetSizeObj(objPtr, value) (((value) == TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +# define Tcl_NewSizeObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetSizeObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) #else # define Tcl_NewSizeObj Tcl_NewIntObj # define Tcl_SetSizeObj Tcl_SetIntObj -- cgit v0.12 From 29f4c762f29d31c1d2184e4bdb515038ec1d5d27 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 17:28:15 +0000 Subject: Update doc --- doc/IntObj.3 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 5577cc9..7ca7f75 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -25,6 +25,9 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp +Tcl_Obj * +\fBTcl_NewSizeObj\fR(\fIsizeValue\fR) +.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) @@ -33,6 +36,8 @@ Tcl_Obj * .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp +\fBTcl_SetSizeObj\fR(\fIobjPtr, sizeValue\fR) +.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp @@ -73,8 +78,12 @@ Long integer value used to initialize or set a Tcl value. Wide integer value used to initialize or set a Tcl value. .AP Tcl_WideUInt uwideValue in Unsigned wide integer value used to initialize or set a Tcl value. +.AP Tcl_Size sizeValue in +\fTcl_Size\f integer value used to initialize or set a Tcl value. +In Tcl 8.x, \fTcl_Size\f is actually the same as int. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetSizeObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and -- cgit v0.12 From ee898100a16badc57acbcc0bac4f211b9253d1e9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 17:44:56 +0000 Subject: Tcl_NewSizeObj -> Tcl_NewIndexObj --- doc/IntObj.3 | 24 ++++++++++++------------ generic/tclDecls.h | 8 ++++---- generic/tclListObj.c | 7 +------ 3 files changed, 17 insertions(+), 22 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 7ca7f75..cfae9a0 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewIndexObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_SetIndexObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -26,7 +26,7 @@ Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp Tcl_Obj * -\fBTcl_NewSizeObj\fR(\fIsizeValue\fR) +\fBTcl_NewIndexObj\fR(\fIindexValue\fR) .sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp @@ -36,7 +36,7 @@ Tcl_Obj * .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp -\fBTcl_SetSizeObj\fR(\fIobjPtr, sizeValue\fR) +\fBTcl_SetIndexObj\fR(\fIobjPtr, indexValue\fR) .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) @@ -78,12 +78,12 @@ Long integer value used to initialize or set a Tcl value. Wide integer value used to initialize or set a Tcl value. .AP Tcl_WideUInt uwideValue in Unsigned wide integer value used to initialize or set a Tcl value. -.AP Tcl_Size sizeValue in -\fTcl_Size\f integer value used to initialize or set a Tcl value. +.AP Tcl_Size indexValue in +\fTcl_Size\f value used to initialize or set a Tcl value. In Tcl 8.x, \fTcl_Size\f is actually the same as int. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideUIntObj\fR, \fBTcl_SetSizeObj\fR, +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and @@ -123,14 +123,14 @@ The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, -\fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create -and return a new Tcl value initialized to the integral value of the -argument. The returned Tcl value is unshared. +\fBTcl_NewWideUIntObj\fR, \fBTcl_NewIndexObj\fR, and \fBTcl_NewBignumObj\fR +routines each create and return a new Tcl value initialized to the +integral value of the argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set -the value of an existing Tcl value pointed to by \fIobjPtr\fR to the -integral value provided by the other argument. The \fIobjPtr\fR +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, and \fBTcl_SetBignumObj\fR +routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR +to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the value of a shared Tcl value violates Tcl's copy-on-write policy. Any existing string representation or internal representation in the unshared diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b9d2347..6fcd08d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4432,11 +4432,11 @@ extern const TclStubs *tclStubsPtr; #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_MAJOR_VERSION > 8 -# define Tcl_NewSizeObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) -# define Tcl_SetSizeObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +# define Tcl_NewIndexObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetIndexObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) #else -# define Tcl_NewSizeObj Tcl_NewIntObj -# define Tcl_SetSizeObj Tcl_SetIntObj +# define Tcl_NewIndexObj Tcl_NewIntObj +# define Tcl_SetIndexObj Tcl_SetIntObj #endif #if TCL_UTF_MAX < 4 diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 6950d9d..f016224 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -3516,11 +3516,6 @@ UpdateStringOfList( Tcl_Obj * TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) { - if (leadingSpace < 0) - leadingSpace = 0; - if (endSpace < 0) - endSpace = 0; - ListRep listRep; Tcl_Size capacity; Tcl_Obj *listObj; @@ -3538,7 +3533,7 @@ TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) ListStore *storePtr = listRep.storePtr; Tcl_Size i; for (i = 0; i < length; ++i) { - storePtr->slots[i + leadingSpace] = Tcl_NewSizeObj(i); + storePtr->slots[i + leadingSpace] = Tcl_NewIndexObj(i); Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]); } storePtr->firstUsed = leadingSpace; -- cgit v0.12 From 0a5df8ec7faf67b198d81d81ff4efe575614db00 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Nov 2022 22:26:03 +0000 Subject: Fix for Tcl_SetWideUIntObj --- generic/tclClock.c | 2 +- generic/tclCmdMZ.c | 2 +- generic/tclObj.c | 2 +- generic/tclScan.c | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 72605ca..d64348e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1810,7 +1810,7 @@ ClockMillisecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideUIntObj( + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj((Tcl_WideUInt) now.sec * 1000 + now.usec / 1000)); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3f42438..ff466d9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3775,7 +3775,7 @@ TclNRSwitchObjCmd( TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { - TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE); + TclNewIntObj(rangeObjAry[1], -1); rangeObjAry[0] = rangeObjAry[1]; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 7871692..0d56eec 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3371,7 +3371,7 @@ Tcl_SetWideUIntObj( if (uwideValue > WIDE_MAX) { mp_int bignumValue; - if (mp_init_i64(&bignumValue, uwideValue) != MP_OKAY) { + if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); } TclSetBignumInternalRep(objPtr, &bignumValue); diff --git a/generic/tclScan.c b/generic/tclScan.c index 6bc914d..c0cf49f 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -1090,7 +1090,7 @@ Tcl_ScanObjCmd( if (code == TCL_OK) { if (underflow && (nconversions == 0)) { if (numVars) { - TclNewIndexObj(objPtr, TCL_INDEX_NONE); + TclNewIntObj(objPtr, -1); } else { if (objPtr) { Tcl_SetListObj(objPtr, 0, NULL); -- cgit v0.12 From 3c61afae6735dd0fd14a8ec428464827a8cc68cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Nov 2022 22:48:53 +0000 Subject: Fix panic message --- generic/tclObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 0d56eec..4639731 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3372,7 +3372,7 @@ Tcl_SetWideUIntObj( if (uwideValue > WIDE_MAX) { mp_int bignumValue; if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { - Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); } TclSetBignumInternalRep(objPtr, &bignumValue); } { -- cgit v0.12 From 2be590933b8f279e5c7e7f11b6b6d1150018cbf2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Apr 2024 15:07:59 +0000 Subject: Remove Tcl_NewIndexObj/Tcl_SetIndexObj. Since Tcl_Size is signed now, it doesn't add much value any more. --- doc/IntObj.3 | 13 ++++--------- generic/tclDecls.h | 8 -------- 2 files changed, 4 insertions(+), 17 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 98cba9b..2cc3593 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewIndexObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_SetIndexObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -25,9 +25,6 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp -Tcl_Obj * -\fBTcl_NewIndexObj\fR(\fIindexValue\fR) -.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) @@ -36,8 +33,6 @@ Tcl_Obj * .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp -\fBTcl_SetIndexObj\fR(\fIobjPtr, indexValue\fR) -.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp @@ -90,7 +85,7 @@ Unsigned wide integer value used to initialize or set a Tcl value. In Tcl 8.x, \fTcl_Size\f is actually the same as int. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, +\fBTcl_SetWideUIntObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and @@ -136,12 +131,12 @@ The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, -\fBTcl_NewWideUIntObj\fR, \fBTcl_NewIndexObj\fR, and \fBTcl_NewBignumObj\fR +\fBTcl_NewWideUIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create and return a new Tcl value initialized to the integral value of the argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, and \fBTcl_SetBignumObj\fR +\fBTcl_SetWideUIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the diff --git a/generic/tclDecls.h b/generic/tclDecls.h index dc942b0..e497928 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4086,14 +4086,6 @@ extern const TclStubs *tclStubsPtr; #define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR) #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) -#if TCL_MAJOR_VERSION > 8 -# define Tcl_NewIndexObj(value) (((Tcl_WideUInt)(value) > (((size_t)-1)>>1)) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(value)) -# define Tcl_SetIndexObj(objPtr, value) (((Tcl_WideUInt)(value) > (((size_t)-1)>>1)) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) -#else -# define Tcl_NewIndexObj Tcl_NewIntObj -# define Tcl_SetIndexObj Tcl_SetIntObj -#endif - #if TCL_UTF_MAX < 4 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString -- cgit v0.12