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_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +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 .SH SYNOPSIS .nf \fB#include \fR .sp Tcl_Obj * @@ -38,10 +38,13 @@ \fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR) .sp int \fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) .sp +int +\fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR) +.sp .sp \fB#include \fR .sp Tcl_Obj * \fBTcl_NewBignumObj\fR(\fIbigValue\fR) @@ -80,10 +83,12 @@ Points to place to store the integer value retrieved from \fIobjPtr\fR. .AP long *longPtr out Points to place to store the long integer value retrieved from \fIobjPtr\fR. .AP Tcl_WideInt *widePtr out Points to place to store the wide integer value retrieved from \fIobjPtr\fR. +.AP Tcl_WideUInt *uwidePtr out +Points to place to store the unsigned wide integer value retrieved from \fIobjPtr\fR. .AP mp_int *bigValue in/out Points to a multi-precision integer structure declared by the LibTomMath library. .AP double doubleValue in Double value from which the integer part is determined and Index: doc/LinkVar.3 ================================================================== --- doc/LinkVar.3 +++ doc/LinkVar.3 @@ -237,12 +237,11 @@ . The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR (which is an unsigned integer type at least 64-bits wide on all platforms that can support it.) Any value written into the Tcl variable must have a proper unsigned -wideinteger form acceptable to \fBTcl_GetBignumFromObj\fR and in the -platform's defined range for the \fBTcl_WideUInt\fR type; +wideinteger form acceptable to \fBTcl_GetWideUIntFromObj\fR; attempts to write non-integer values into \fIvarName\fR will be rejected with Tcl errors. Incomplete integer representations (like the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted as if they are valid too. .TP Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2558,15 +2558,15 @@ #} #declare 685 { # void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) #} -# TIP #650 (reserved) -#declare 686 { -# int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, -# Tcl_WideUInt *uwidePtr) -#} +# TIP #650 +declare 686 { + int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Tcl_WideUInt *uwidePtr) +} # TIP 651 declare 687 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -2040,11 +2040,13 @@ Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); /* Slot 684 is reserved */ /* Slot 685 is reserved */ -/* Slot 686 is reserved */ +/* 686 */ +EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 687 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2764,11 +2766,11 @@ 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 */ void (*reserved684)(void); void (*reserved685)(void); - void (*reserved686)(void); + int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 686 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 687 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4166,11 +4168,12 @@ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ /* Slot 684 is reserved */ /* Slot 685 is reserved */ -/* Slot 686 is reserved */ +#define Tcl_GetWideUIntFromObj \ + (tclStubsPtr->tcl_GetWideUIntFromObj) /* 686 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 687 */ #endif /* defined(USE_TCL_STUBS) */ Index: generic/tclLink.c ================================================================== --- generic/tclLink.c +++ generic/tclLink.c @@ -524,60 +524,18 @@ static inline int GetUWide( Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr) { - Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr; - void *clientData; - int type, intValue; - - if (Tcl_GetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) { - if (type == TCL_NUMBER_INT) { - *widePtr = *((const Tcl_WideInt *) clientData); - return (*widePtr < 0); - } else if (type == TCL_NUMBER_BIG) { - mp_int *numPtr = (mp_int *)clientData; - Tcl_WideUInt value = 0; - union { - Tcl_WideUInt value; - unsigned char bytes[sizeof(Tcl_WideUInt)]; - } scratch; - size_t numBytes; - unsigned char *bytes = scratch.bytes; - - if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr, - bytes, sizeof(Tcl_WideUInt), &numBytes))) { - /* - * If the sign bit is set (a negative value) or if the value - * can't possibly fit in the bits of an unsigned wide, there's - * no point in doing further conversion. - */ - return 1; - } -#ifndef WORDS_BIGENDIAN - while (numBytes-- > 0) { - value = (value << CHAR_BIT) | *bytes++; - } -#else /* WORDS_BIGENDIAN */ - /* - * Big-endian can read the value directly. - */ - value = scratch.value; -#endif /* WORDS_BIGENDIAN */ - *uwidePtr = value; - return 0; - } - } - - /* - * Evil edge case fallback. - */ - - if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) { - return 1; - } - *uwidePtr = intValue; + if (Tcl_GetWideUIntFromObj(NULL, objPtr, uwidePtr) != TCL_OK) { + int intValue; + + if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) { + return 1; + } + *uwidePtr = intValue; + } return 0; } static inline int GetDouble( Index: generic/tclObj.c ================================================================== --- generic/tclObj.c +++ generic/tclObj.c @@ -3396,10 +3396,94 @@ } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY)==TCL_OK); return TCL_ERROR; } +/* + *---------------------------------------------------------------------- + * + * Tcl_GetWideUIntFromObj -- + * + * Attempt to return a unsigned wide integer from the Tcl object "objPtr". If the + * object is not already a wide int object or a bignum object, an attempt will + * be made to convert it to one. + * + * Results: + * The return value is a standard Tcl object result. If an error occurs + * during conversion, an error message is left in the interpreter's + * result unless "interp" is NULL. + * + * Side effects: + * If the object is not already an int object, the conversion will free + * any old internal representation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetWideUIntFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* Object from which to get a wide int. */ + Tcl_WideUInt *wideUIntPtr) + /* Place to store resulting long. */ +{ + do { + if (objPtr->typePtr == &tclIntType) { + if (objPtr->internalRep.wideValue < 0) { + wideUIntOutOfRange: + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected unsigned integer but got \"%s\"", + TclGetString(objPtr))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + } + return TCL_ERROR; + } + *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue; + return TCL_OK; + } + if (objPtr->typePtr == &tclDoubleType) { + goto wideUIntOutOfRange; + } + if (objPtr->typePtr == &tclBignumType) { + /* + * Must check for those bignum values that can fit in a + * Tcl_WideUInt, even when auto-narrowing is enabled. + */ + + mp_int big; + Tcl_WideUInt value = 0; + size_t numBytes; + Tcl_WideUInt scratch; + unsigned char *bytes = (unsigned char *) &scratch; + + TclUnpackBignum(objPtr, big); + if (big.sign == MP_NEG) { + goto wideUIntOutOfRange; + } + if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideUInt), &numBytes) == MP_OKAY) { + while (numBytes-- > 0) { + value = (value << CHAR_BIT) | *bytes++; + } + *wideUIntPtr = (Tcl_WideUInt)value; + return TCL_OK; + } + + if (interp != NULL) { + const char *s = "integer value too large to represent"; + Tcl_Obj *msg = Tcl_NewStringObj(s, -1); + + Tcl_SetObjResult(interp, msg); + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); + } + return TCL_ERROR; + } + } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL, + TCL_PARSE_INTEGER_ONLY)==TCL_OK); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * * TclGetWideBitsFromObj -- * Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -2055,10 +2055,10 @@ Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ 0, /* 684 */ 0, /* 685 */ - 0, /* 686 */ + Tcl_GetWideUIntFromObj, /* 686 */ Tcl_DStringToObj, /* 687 */ }; /* !END!: Do not edit above this line. */