TIP #648: New functions Tcl_NewWideUIntObj()/Tcl_SetWideUIntObj()

5 files changed, 90 insertions, 32 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 3a135ed..34f5af1 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2506,6 +2506,14 @@ declare 687 {
     int TclUtfNcasecmp(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 3e3cb85..29b96b0 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -2018,8 +2018,11 @@ EXTERN int		TclUtfNcmp(const char *s1, const char *s2, size_t n);
 /* 687 */
 EXTERN int		TclUtfNcasecmp(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);
 
@@ -2745,8 +2748,8 @@ typedef struct TclStubs {
     Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */
     int (*tclUtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */
     int (*tclUtfNcasecmp) (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;
 
@@ -4138,8 +4141,10 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tclUtfNcmp) /* 686 */
 #define TclUtfNcasecmp \
 	(tclStubsPtr->tclUtfNcasecmp) /* 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 2b86a25..4d7800a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -3179,6 +3179,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
@@ -3272,6 +3299,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 f97f3bd..1ac6801 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1984,8 +1984,8 @@ const TclStubs tclStubs = {
     Tcl_DStringToObj, /* 685 */
     TclUtfNcmp, /* 686 */
     TclUtfNcasecmp, /* 687 */
-    0, /* 688 */
-    0, /* 689 */
+    Tcl_NewWideUIntObj, /* 688 */
+    Tcl_SetWideUIntObj, /* 689 */
     TclUnusedStubEntry, /* 690 */
 };
 
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7360c94..3731b3a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -28,11 +28,6 @@
 #   define TCL_UTF_MAX 3
 #endif
 #include "tclInt.h"
-#ifdef TCL_WITH_EXTERNAL_TOMMATH
-#   include "tommath.h"
-#else
-#   include "tclTomMath.h"
-#endif
 #include "tclOO.h"
 #include <math.h>
 
@@ -3401,29 +3396,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) {