summaryrefslogtreecommitdiffstats
path: root/generic/tclBinary.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBinary.c')
-rw-r--r--generic/tclBinary.c418
1 files changed, 280 insertions, 138 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 8bd65a8..d8b9ae9 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -15,6 +15,7 @@
#include "tommath.h"
#include <math.h>
+#include <assert.h>
/*
* The following constants are used by GetFormatSpec to indicate various
@@ -56,9 +57,12 @@
static void DupByteArrayInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
+static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
static int FormatNumber(Tcl_Interp *interp, int type,
Tcl_Obj *src, unsigned char **cursorPtr);
static void FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int GetFormatSpec(const char **formatPtr, char *cmdPtr,
int *countPtr, int *flagsPtr);
static Tcl_Obj * ScanNumber(unsigned char *buffer, int type,
@@ -155,35 +159,103 @@ static const EnsembleImplMap decodeMap[] = {
};
/*
- * The following object type represents an array of bytes. An array of bytes
- * is not equivalent to an internationalized string. Conceptually, a string is
- * an array of 16-bit quantities organized as a sequence of properly formed
- * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
- * Accessor functions are provided to convert a ByteArray to a String or a
- * String to a ByteArray. Two or more consecutive bytes in an array of bytes
- * may look like a single UTF-8 character if the array is casually treated as
- * a string. But obtaining the String from a ByteArray is guaranteed to
- * produced properly formed UTF-8 sequences so that there is a one-to-one map
- * between bytes and characters.
- *
- * Converting a ByteArray to a String proceeds by casting each byte in the
- * array to a 16-bit quantity, treating that number as a Unicode character,
- * and storing the UTF-8 version of that Unicode character in the String. For
- * ByteArrays consisting entirely of values 1..127, the corresponding String
- * representation is the same as the ByteArray representation.
- *
- * Converting a String to a ByteArray proceeds by getting the Unicode
- * representation of each character in the String, casting it to a byte by
- * truncating the upper 8 bits, and then storing the byte in the ByteArray.
- * Converting from ByteArray to String and back to ByteArray is not lossy, but
- * converting an arbitrary String to a ByteArray may be.
+ * The following object types represent an array of bytes. The intent is to
+ * allow arbitrary binary data to pass through Tcl as a Tcl value without loss
+ * or damage. Such values are useful for things like encoded strings or Tk
+ * images to name just two.
+ *
+ * It's strange to have two Tcl_ObjTypes in place for this task when one would
+ * do, so a bit of detail and history how we got to this point and where we
+ * might go from here.
+ *
+ * A bytearray is an ordered sequence of bytes. Each byte is an integer value
+ * in the range [0-255]. To be a Tcl value type, we need a way to encode each
+ * value in the value set as a Tcl string. The simplest encoding is to
+ * represent each byte value as the same codepoint value. A bytearray of N
+ * bytes is encoded into a Tcl string of N characters where the codepoint of
+ * each character is the value of corresponding byte. This approach creates a
+ * one-to-one map between all bytearray values and a subset of Tcl string
+ * values.
+ *
+ * When converting a Tcl string value to the bytearray internal rep, the
+ * question arises what to do with strings outside that subset? That is,
+ * those Tcl strings containing at least one codepoint greater than 255? The
+ * obviously correct answer is to raise an error! That string value does not
+ * represent any valid bytearray value. Full Stop. The setFromAnyProc
+ * signature has a completion code return value for just this reason, to
+ * reject invalid inputs.
+ *
+ * Unfortunately this was not the path taken by the authors of the original
+ * tclByteArrayType. They chose to accept all Tcl string values as acceptable
+ * string encodings of the bytearray values that result from masking away the
+ * high bits of any codepoint value at all. This meant that every bytearray
+ * value had multiple accepted string representations.
+ *
+ * The implications of this choice are truly ugly. When a Tcl value has a
+ * string representation, we are required to accept that as the true value.
+ * Bytearray values that possess a string representation cannot be processed
+ * as bytearrays because we cannot know which true value that bytearray
+ * represents. The consequence is that we drag around an internal rep that we
+ * cannot make any use of. This painful price is extracted at any point after
+ * a string rep happens to be generated for the value. This happens even when
+ * the troublesome codepoints outside the byte range never show up. This
+ * happens rather routinely in normal Tcl operations unless we burden the
+ * script writer with the cognitive burden of avoiding it. The price is also
+ * paid by callers of the C interface. The routine
+ *
+ * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
+ *
+ * has a guarantee to always return a non-NULL value, but that value points to
+ * a byte sequence that cannot be used by the caller to process the Tcl value
+ * absent some sideband testing that objPtr is "pure". Tcl offers no public
+ * interface to perform this test, so callers either break encapsulation or
+ * are unavoidably buggy. Tcl has defined a public interface that cannot be
+ * used correctly. The Tcl source code itself suffers the same problem, and
+ * has been buggy, but progressively less so as more and more portions of the
+ * code have been retrofitted with the required "purity testing". The set of
+ * values able to pass the purity test can be increased via the introduction
+ * of a "canonical" flag marker, but the only way the broken interface itself
+ * can be discarded is to start over and define the Tcl_ObjType properly.
+ * Bytearrays should simply be usable as bytearrays without a kabuki dance of
+ * testing.
+ *
+ * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation
+ * of bytearrays. Any Tcl value with the type properByteArrayType can have
+ * its bytearray value fetched and used with confidence that acting on that
+ * value is equivalent to acting on the true Tcl string value. This still
+ * implies a side testing burden -- past mistakes will not let us avoid that
+ * immediately, but it is at least a conventional test of type, and can be
+ * implemented entirely by examining the objPtr fields, with no need to query
+ * the intrep, as a canonical flag would require.
+ *
+ * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised
+ * to admit the possibility of returning NULL when the true value is not a
+ * valid bytearray, we need a mechanism to retain compatibility with the
+ * deployed callers of the broken interface. That's what the retained
+ * "tclByteArrayType" provides. In those unusual circumstances where we
+ * convert an invalid bytearray value to a bytearray type, it is to this
+ * legacy type. Essentially any time this legacy type gets used, it's a
+ * signal of a bug being ignored. A TIP should be drafted to remove this
+ * connection to the broken past so that Tcl 9 will no longer have any trace
+ * of it. Prescribing a migration path will be the key element of that work.
+ * The internal changes now in place are the limit of what can be done short
+ * of interface repair. They provide a great expansion of the histories over
+ * which bytearray values can be useful in the meanwhile.
*/
+static const Tcl_ObjType properByteArrayType = {
+ "bytearray",
+ FreeProperByteArrayInternalRep,
+ DupProperByteArrayInternalRep,
+ UpdateStringOfByteArray,
+ NULL
+};
+
const Tcl_ObjType tclByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
- UpdateStringOfByteArray,
+ NULL,
SetByteArrayFromAny
};
@@ -195,9 +267,9 @@ const Tcl_ObjType tclByteArrayType = {
*/
typedef struct ByteArray {
- int used; /* The number of bytes used in the byte
+ unsigned int used; /* The number of bytes used in the byte
* array. */
- int allocated; /* The amount of space actually allocated
+ unsigned int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[1]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
@@ -205,12 +277,17 @@ typedef struct ByteArray {
} ByteArray;
#define BYTEARRAY_SIZE(len) \
- ((unsigned) (TclOffset(ByteArray, bytes) + (len)))
-#define GET_BYTEARRAY(objPtr) \
- ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+ (offsetof(ByteArray, bytes) + (len))
+#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
+#define SET_BYTEARRAY(irPtr, baPtr) \
+ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
+int
+TclIsPureByteArray(
+ Tcl_Obj * objPtr)
+{
+ return TclHasIntRep(objPtr, &properByteArrayType);
+}
/*
*----------------------------------------------------------------------
@@ -324,11 +401,11 @@ Tcl_SetByteArrayObj(
* be >= 0. */
{
ByteArray *byteArrayPtr;
+ Tcl_ObjIntRep ir;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
- TclFreeIntRep(objPtr);
TclInvalidateStringRep(objPtr);
if (length < 0) {
@@ -339,10 +416,11 @@ Tcl_SetByteArrayObj(
byteArrayPtr->allocated = length;
if ((bytes != NULL) && (length > 0)) {
- memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
+ memcpy(byteArrayPtr->bytes, bytes, length);
}
- objPtr->typePtr = &tclByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+
+ Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}
/*
@@ -370,16 +448,24 @@ Tcl_GetByteArrayFromObj(
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- baPtr = GET_BYTEARRAY(objPtr);
+ baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
}
- return (unsigned char *) baPtr->bytes;
+ return baPtr->bytes;
}
/*
@@ -410,22 +496,36 @@ Tcl_SetByteArrayLength(
int length) /* New length for internal byte array. */
{
ByteArray *byteArrayPtr;
+ unsigned newLength;
+ Tcl_ObjIntRep *irPtr;
+
+ assert(length >= 0);
+ newLength = (unsigned int)length;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- if (length > byteArrayPtr->allocated) {
- byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
- byteArrayPtr->allocated = length;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
+ if (newLength > byteArrayPtr->allocated) {
+ byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
+ byteArrayPtr->allocated = newLength;
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
TclInvalidateStringRep(objPtr);
- byteArrayPtr->used = length;
+ byteArrayPtr->used = newLength;
return byteArrayPtr->bytes;
}
@@ -450,29 +550,38 @@ SetByteArrayFromAny(
Tcl_Interp *interp, /* Not used. */
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
- int length;
+ size_t length;
+ int improper = 0;
const char *src, *srcEnd;
unsigned char *dst;
- ByteArray *byteArrayPtr;
Tcl_UniChar ch = 0;
+ ByteArray *byteArrayPtr;
+ Tcl_ObjIntRep ir;
- if (objPtr->typePtr != &tclByteArrayType) {
- src = TclGetStringFromObj(objPtr, &length);
- srcEnd = src + length;
-
- byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
- for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
- src += TclUtfToUniChar(src, &ch);
- *dst++ = UCHAR(ch);
- }
+ if (TclHasIntRep(objPtr, &properByteArrayType)) {
+ return TCL_OK;
+ }
+ if (TclHasIntRep(objPtr, &tclByteArrayType)) {
+ return TCL_OK;
+ }
- byteArrayPtr->used = dst - byteArrayPtr->bytes;
- byteArrayPtr->allocated = length;
+ src = TclGetString(objPtr);
+ length = objPtr->length;
+ srcEnd = src + length;
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &tclByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += TclUtfToUniChar(src, &ch);
+ improper = improper || (ch > 255);
+ *dst++ = UCHAR(ch);
}
+
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
+ byteArrayPtr->allocated = length;
+
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+ Tcl_StoreIntRep(objPtr,
+ improper ? &tclByteArrayType : &properByteArrayType, &ir);
return TCL_OK;
}
@@ -497,8 +606,14 @@ static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree(GET_BYTEARRAY(objPtr));
- objPtr->typePtr = NULL;
+ ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
+}
+
+static void
+FreeProperByteArrayInternalRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
+{
+ ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
}
/*
@@ -523,19 +638,41 @@ DupByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- int length;
+ unsigned int length;
+ ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
+
+ srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
+ length = srcArrayPtr->used;
+
+ copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr->used = length;
+ copyArrayPtr->allocated = length;
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
+
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
+}
+
+static void
+DupProperByteArrayInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
- srcArrayPtr = GET_BYTEARRAY(srcPtr);
+ srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
length = srcArrayPtr->used;
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
- memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
- SET_BYTEARRAY(copyPtr, copyArrayPtr);
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
- copyPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
/*
@@ -543,9 +680,7 @@ DupByteArrayInternalRep(
*
* UpdateStringOfByteArray --
*
- * Update the string representation for a ByteArray data object. Note:
- * This procedure does not invalidate an existing old string rep so
- * storage will be lost if this has not already been done.
+ * Update the string representation for a ByteArray data object.
*
* Results:
* None.
@@ -554,9 +689,6 @@ DupByteArrayInternalRep(
* The object's string is set to a valid string that results from the
* ByteArray-to-string conversion.
*
- * The object becomes a string object -- the internal rep is discarded
- * and the typePtr becomes NULL.
- *
*----------------------------------------------------------------------
*/
@@ -565,41 +697,37 @@ UpdateStringOfByteArray(
Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
- int i, length, size;
- unsigned char *src;
- char *dst;
- ByteArray *byteArrayPtr;
-
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- src = byteArrayPtr->bytes;
- length = byteArrayPtr->used;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
+ unsigned char *src = byteArrayPtr->bytes;
+ unsigned int i, length = byteArrayPtr->used;
+ unsigned int size = length;
/*
* How much space will string rep need?
*/
- size = length;
- for (i = 0; i < length && size >= 0; i++) {
+ for (i = 0; i < length && size <= INT_MAX; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size++;
}
}
- if (size < 0) {
+ if (size > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- dst = ckalloc(size + 1);
- objPtr->bytes = dst;
- objPtr->length = size;
-
if (size == length) {
- memcpy(dst, src, (size_t) size);
- dst[size] = '\0';
+ char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
+
+ TclOOM(dst, size);
} else {
+ char *dst = Tcl_InitStringRep(objPtr, NULL, size);
+
+ TclOOM(dst, size);
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
- *dst = '\0';
+ (void) Tcl_InitStringRep(objPtr, NULL, size);
}
}
@@ -629,7 +757,8 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
- int needed;
+ unsigned int length, needed;
+ Tcl_ObjIntRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -645,23 +774,34 @@ TclAppendBytesToByteArray(
return;
}
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ length = (unsigned int) len;
+
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
- if (len > INT_MAX - byteArrayPtr->used) {
+ if (length > INT_MAX - byteArrayPtr->used) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- needed = byteArrayPtr->used + len;
+ needed = byteArrayPtr->used + length;
/*
* If we need to, resize the allocated space in the byte array.
*/
if (needed > byteArrayPtr->allocated) {
ByteArray *ptr = NULL;
- int attempt;
+ unsigned int attempt;
if (needed <= INT_MAX/2) {
/*
@@ -677,7 +817,7 @@ TclAppendBytesToByteArray(
*/
unsigned int limit = INT_MAX - needed;
- unsigned int extra = len + TCL_MIN_GROWTH;
+ unsigned int extra = length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
@@ -693,13 +833,13 @@ TclAppendBytesToByteArray(
}
byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
if (bytes) {
- memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+ memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length);
}
- byteArrayPtr->used += len;
+ byteArrayPtr->used += length;
TclInvalidateStringRep(objPtr);
}
@@ -945,7 +1085,7 @@ BinaryFormatCmd(
resultPtr = Tcl_NewObj();
buffer = Tcl_SetByteArrayLength(resultPtr, length);
- memset(buffer, 0, (size_t) length);
+ memset(buffer, 0, length);
/*
* Pack the data into the result object. Note that we can skip the error
@@ -982,10 +1122,10 @@ BinaryFormatCmd(
count = 1;
}
if (length >= count) {
- memcpy(cursor, bytes, (size_t) count);
+ memcpy(cursor, bytes, count);
} else {
- memcpy(cursor, bytes, (size_t) length);
- memset(cursor + length, pad, (size_t) (count - length));
+ memcpy(cursor, bytes, length);
+ memset(cursor + length, pad, count - length);
}
cursor += count;
break;
@@ -1174,7 +1314,7 @@ BinaryFormatCmd(
if (count == BINARY_NOCOUNT) {
count = 1;
}
- memset(cursor, 0, (size_t) count);
+ memset(cursor, 0, count);
cursor += count;
break;
case 'X':
@@ -1577,7 +1717,7 @@ BinaryScanCmd(
*/
done:
- Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(arg - 3));
DeleteScanNumberCache(numberCachePtr);
return TCL_OK;
@@ -1885,7 +2025,6 @@ FormatNumber(
Tcl_Obj *src, /* Number to format. */
unsigned char **cursorPtr) /* Pointer to index into destination buffer. */
{
- long value;
double dvalue;
Tcl_WideInt wvalue;
float fvalue;
@@ -1901,10 +2040,11 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
*cursorPtr += sizeof(double);
@@ -1920,10 +2060,12 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);
+
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
/*
@@ -1947,7 +2089,7 @@ FormatNumber(
case 'w':
case 'W':
case 'm':
- if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
@@ -1977,19 +2119,19 @@ FormatNumber(
case 'i':
case 'I':
case 'n':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = UCHAR(value);
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value >> 16);
- *(*cursorPtr)++ = UCHAR(value >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
} else {
- *(*cursorPtr)++ = UCHAR(value >> 24);
- *(*cursorPtr)++ = UCHAR(value >> 16);
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
}
return TCL_OK;
@@ -1999,15 +2141,15 @@ FormatNumber(
case 's':
case 'S':
case 't':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = UCHAR(value);
- *(*cursorPtr)++ = UCHAR(value >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
} else {
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
}
return TCL_OK;
@@ -2015,10 +2157,10 @@ FormatNumber(
* 8-bit integer values.
*/
case 'c':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue);
return TCL_OK;
default:
@@ -2144,7 +2286,7 @@ ScanNumber(
returnNumericObject:
if (*numberCachePtrPtr == NULL) {
- return Tcl_NewLongObj(value);
+ return Tcl_NewWideIntObj(value);
} else {
register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
register Tcl_HashEntry *hPtr;
@@ -2155,7 +2297,7 @@ ScanNumber(
return Tcl_GetHashValue(hPtr);
}
if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
- register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
+ register Tcl_Obj *objPtr = Tcl_NewWideIntObj(value);
Tcl_IncrRefCount(objPtr);
Tcl_SetHashValue(hPtr, objPtr);
@@ -2173,7 +2315,7 @@ ScanNumber(
DeleteScanNumberCache(tablePtr);
*numberCachePtrPtr = NULL;
- return Tcl_NewLongObj(value);
+ return Tcl_NewWideIntObj(value);
}
/*
@@ -2207,7 +2349,7 @@ ScanNumber(
Tcl_Obj *bigObj = NULL;
mp_int big;
- TclBNInitBignumFromWideUInt(&big, uwvalue);
+ TclInitBignumFromWideUInt(&big, uwvalue);
bigObj = Tcl_NewBignumObj(&big);
return bigObj;
}
@@ -2407,7 +2549,7 @@ BinaryDecodeHex(
}
c = *data++;
- if (!isxdigit((int) c)) {
+ if (!isxdigit(UCHAR(c))) {
if (strict || !TclIsSpaceProc(c)) {
goto badChar;
}
@@ -2521,7 +2663,7 @@ BinaryEncode64(
}
break;
case OPT_WRAPCHAR:
- wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
+ wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
if (wrapcharlen == 0) {
maxlen = 0;
}