New functions Tcl_NewWideUIntObj()/Tcl_SetWideUIntObj() (still experimental)

8 files changed, 95 insertions, 6 deletions

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) {