summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/IntObj.329
-rw-r--r--generic/tcl.decls8
-rw-r--r--generic/tclClock.c4
-rw-r--r--generic/tclCmdMZ.c2
-rw-r--r--generic/tclDecls.h11
-rw-r--r--generic/tclLink.c4
-rw-r--r--generic/tclObj.c68
-rw-r--r--generic/tclStubInit.c2
-rw-r--r--generic/tclTest.c2
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 <tcl.h>\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) {
generated by cgit v0.12 at 2024-10-22 22:29:16 (GMT)