diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-04-20 22:23:45 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2024-04-20 22:23:45 (GMT) |
commit | 0fef61d372c72ef6f6eaae70fc2bf9087e0f3789 (patch) | |
tree | 3b6bc85dd3c22260f2880497df13aad94502fc28 /generic | |
parent | 200d3711e7e5c5a249a3f272ae8338931329e0d8 (diff) | |
parent | ec54c35ce008768e317a58468b971a8f82af634a (diff) | |
download | tcl-0fef61d372c72ef6f6eaae70fc2bf9087e0f3789.zip tcl-0fef61d372c72ef6f6eaae70fc2bf9087e0f3789.tar.gz tcl-0fef61d372c72ef6f6eaae70fc2bf9087e0f3789.tar.bz2 |
TIP #648: New functions Tcl_NewWideUIntObj()/Tcl_SetWideUIntObj()
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 8 | ||||
-rw-r--r-- | generic/tclDecls.h | 17 | ||||
-rw-r--r-- | generic/tclObj.c | 67 | ||||
-rw-r--r-- | generic/tclStubInit.c | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 26 |
5 files changed, 90 insertions, 32 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 641d2b1..5650967 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2364,6 +2364,14 @@ 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 690 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d4fee5e..896deed 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1867,8 +1867,11 @@ 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); -/* Slot 688 is reserved */ -/* Slot 689 is reserved */ +/* 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); @@ -2570,8 +2573,8 @@ typedef struct TclStubs { 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 (*reserved688)(void); - void (*reserved689)(void); + Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */ + void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */ void (*tclUnusedStubEntry) (void); /* 690 */ } TclStubs; @@ -3900,8 +3903,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfNcmp) /* 686 */ #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 687 */ -/* Slot 688 is reserved */ -/* Slot 689 is reserved */ +#define Tcl_NewWideUIntObj \ + (tclStubsPtr->tcl_NewWideUIntObj) /* 688 */ +#define Tcl_SetWideUIntObj \ + (tclStubsPtr->tcl_SetWideUIntObj) /* 689 */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 690 */ diff --git a/generic/tclObj.c b/generic/tclObj.c index e23d900..30634a0 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2792,6 +2792,33 @@ 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; + + TclNewUIntObj(objPtr, uwideValue); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to @@ -2885,6 +2912,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_u64(&bignumValue, uwideValue) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); + } + TclSetBignumInternalRep(objPtr, &bignumValue); + } { + TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); + } +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index fc0f6fa..3504bf7 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1491,8 +1491,8 @@ const TclStubs tclStubs = { Tcl_DStringToObj, /* 685 */ Tcl_UtfNcmp, /* 686 */ Tcl_UtfNcasecmp, /* 687 */ - 0, /* 688 */ - 0, /* 689 */ + Tcl_NewWideUIntObj, /* 688 */ + Tcl_SetWideUIntObj, /* 689 */ TclUnusedStubEntry, /* 690 */ }; diff --git a/generic/tclTest.c b/generic/tclTest.c index d8fbb00..d04b715 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -22,11 +22,6 @@ # 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 <math.h> @@ -3436,29 +3431,12 @@ TestlinkCmd( 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) { |