Index: doc/IntObj.3 ================================================================== --- doc/IntObj.3 +++ doc/IntObj.3 @@ -6,11 +6,11 @@ '\" .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" .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_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 .sp Tcl_Obj * @@ -20,15 +20,20 @@ \fBTcl_NewLongObj\fR(\fIlongValue\fR) .sp 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 int @@ -71,12 +76,15 @@ Integer value used to initialize or set a Tcl value. .AP long longValue in 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, +\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 \fBTcl_TakeBignumFromObj\fR, this refers to the value from which to retrieve an integral value. @@ -118,22 +126,22 @@ \fBlong long int\fR, or something else. 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_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, -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_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 +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, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might fail if Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2361,14 +2361,22 @@ int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 687 { int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } + +# TIP #648 +declare 688 { + Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue) +} +declare 689 { + void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) +} # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # -declare 688 { +declare 690 { void TclUnusedStubEntry(void) } ############################################################################## Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -1865,10 +1865,15 @@ EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 687 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n); /* 688 */ +EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); +/* 689 */ +EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, + Tcl_WideUInt uwideValue); +/* 690 */ EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; @@ -2565,11 +2570,13 @@ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */ int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ - void (*tclUnusedStubEntry) (void); /* 688 */ + Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */ + void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */ + void (*tclUnusedStubEntry) (void); /* 690 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus @@ -3893,12 +3900,16 @@ (tclStubsPtr->tcl_DStringToObj) /* 685 */ #define Tcl_UtfNcmp \ (tclStubsPtr->tcl_UtfNcmp) /* 686 */ #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 687 */ +#define Tcl_NewWideUIntObj \ + (tclStubsPtr->tcl_NewWideUIntObj) /* 688 */ +#define Tcl_SetWideUIntObj \ + (tclStubsPtr->tcl_SetWideUIntObj) /* 689 */ #define TclUnusedStubEntry \ - (tclStubsPtr->tclUnusedStubEntry) /* 688 */ + (tclStubsPtr->tclUnusedStubEntry) /* 690 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -2790,10 +2790,37 @@ #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * + * 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; + + TclNewUIntObj(objPtr, uwideValue); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewWideIntObj to create new wide integer end up calling the * debugging function Tcl_DbNewWideIntObj instead. We provide two @@ -2883,10 +2910,50 @@ Tcl_Panic("%s called with shared object", "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_u64(&bignumValue, uwideValue) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); + } + TclSetBignumInternalRep(objPtr, &bignumValue); + } { + TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); + } +} /* *---------------------------------------------------------------------- * * Tcl_GetWideIntFromObj -- Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -1488,9 +1488,11 @@ Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ Tcl_UtfNcmp, /* 686 */ Tcl_UtfNcasecmp, /* 687 */ - TclUnusedStubEntry, /* 688 */ + Tcl_NewWideUIntObj, /* 688 */ + Tcl_SetWideUIntObj, /* 689 */ + TclUnusedStubEntry, /* 690 */ }; /* !END!: Do not edit above this line. */ Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -20,15 +20,10 @@ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" -#ifdef TCL_WITH_EXTERNAL_TOMMATH -# include "tommath.h" -#else -# include "tclTomMath.h" -#endif #include "tclOO.h" #include /* * Required for Testregexp*Cmd @@ -3434,33 +3429,16 @@ TclFormatInt(buffer, (int) uintVar); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideIntObj(longVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); -#ifdef TCL_WIDE_INT_IS_LONG - if (ulongVar > WIDE_MAX) { - mp_int bignumValue; - if (mp_init_u64(&bignumValue, ulongVar) != MP_OKAY) { - Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); - } - tmp = Tcl_NewBignumObj(&bignumValue); - } else -#endif /* TCL_WIDE_INT_IS_LONG */ - tmp = Tcl_NewWideIntObj((Tcl_WideInt)ulongVar); + tmp = Tcl_NewWideUIntObj(ulongVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); - if (uwideVar > WIDE_MAX) { - mp_int bignumValue; - if (mp_init_u64(&bignumValue, uwideVar) != MP_OKAY) { - Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); - } - tmp = Tcl_NewBignumObj(&bignumValue); - } else { - 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) { int v;