summaryrefslogtreecommitdiffstats
path: root/generic/tclBinary.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBinary.c')
-rw-r--r--generic/tclBinary.c827
1 files changed, 645 insertions, 182 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index e15fe4c..6a34810 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2,14 +2,14 @@
* tclBinary.c --
*
* This file contains the implementation of the "binary" Tcl built-in
- * command .
+ * command and the Tcl binary data object.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * SCCS: @(#) tclBinary.c 1.26 97/11/05 13:02:05
+ * SCCS: @(#) tclBinary.c 1.30 98/02/05 20:20:50
*/
#include <math.h>
@@ -28,11 +28,417 @@
* Prototypes for local procedures defined in this file:
*/
+static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
+ Tcl_Obj *src, unsigned char **cursorPtr));
+static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
char *cmdPtr, int *countPtr));
-static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
- Tcl_Obj *src, char **cursorPtr));
-static Tcl_Obj * ScanNumber _ANSI_ARGS_((char *buffer, int type));
+static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer, int type));
+static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr));
+
+
+/*
+ * 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.
+ */
+
+Tcl_ObjType tclByteArrayType = {
+ "bytearray",
+ FreeByteArrayInternalRep,
+ DupByteArrayInternalRep,
+ UpdateStringOfByteArray,
+ SetByteArrayFromAny
+};
+
+/*
+ * The following structure is the internal rep for a ByteArray object.
+ * Keeps track of how much memory has been used and how much has been
+ * allocated for the byte array to enable growing and shrinking of the
+ * ByteArray object with fewer mallocs.
+ */
+
+typedef struct ByteArray {
+ int used; /* The number of bytes used in the byte
+ * array. */
+ int allocated; /* The amount of space actually allocated
+ * minus 1 byte. */
+ unsigned char bytes[4]; /* The array of bytes. The actual size of
+ * this field depends on the 'allocated' field
+ * above. */
+} ByteArray;
+
+#define BYTEARRAY_SIZE(len) \
+ ((unsigned) (sizeof(ByteArray) - 4 + (len)))
+#define GET_BYTEARRAY(objPtr) \
+ ((ByteArray *) (objPtr)->internalRep.otherValuePtr)
+#define SET_BYTEARRAY(objPtr, baPtr) \
+ (objPtr)->internalRep.otherValuePtr = (VOID *) (baPtr)
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_NewByteArrayObj --
+ *
+ * This procedure is creates a new ByteArray object and initializes
+ * it from the given array of bytes.
+ *
+ * Results:
+ * The newly create object is returned. This object will have no
+ * initial string representation. The returned object has a ref count
+ * of 0.
+ *
+ * Side effects:
+ * Memory allocated for new object and copy of byte array argument.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_NewByteArrayObj(bytes, length)
+ unsigned char *bytes; /* The array of bytes used to initialize
+ * the new object. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+{
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ Tcl_SetByteArrayObj(objPtr, bytes, length);
+ return objPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_SetByteArrayObj --
+ *
+ * Modify an object to be a ByteArray object and to have the specified
+ * array of bytes as its value.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's old string rep and internal rep is freed.
+ * Memory allocated for copy of byte array argument.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetByteArrayObj(objPtr, bytes, length)
+ Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */
+ unsigned char *bytes; /* The array of bytes to use as the new
+ * value. */
+ int length; /* Length of the array of bytes, which must
+ * be >= 0. */
+{
+ Tcl_ObjType *typePtr;
+ ByteArray *byteArrayPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_SetByteArrayObj called with shared object");
+ }
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ Tcl_InvalidateStringRep(objPtr);
+
+ byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ byteArrayPtr->used = length;
+ byteArrayPtr->allocated = length;
+ memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
+
+ objPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetByteArrayFromObj --
+ *
+ * Attempt to get the array of bytes from the Tcl object. If the
+ * object is not already a ByteArray object, an attempt will be
+ * made to convert it to one.
+ *
+ * Results:
+ * Pointer to array of bytes representing the ByteArray object.
+ *
+ * Side effects:
+ * Frees old internal rep. Allocates memory for new internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned char *
+Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
+ Tcl_Obj *objPtr; /* The ByteArray object. */
+ int *lengthPtr; /* If non-NULL, filled with length of the
+ * array of bytes in the ByteArray object. */
+{
+ ByteArray *baPtr;
+
+ SetByteArrayFromAny(NULL, objPtr);
+ baPtr = GET_BYTEARRAY(objPtr);
+
+ if (lengthPtr != NULL) {
+ *lengthPtr = baPtr->used;
+ }
+ return (unsigned char *) baPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetByteArrayLength --
+ *
+ * This procedure changes the length of the byte array for this
+ * object. Once the caller has set the length of the array, it
+ * is acceptable to directly modify the bytes in the array up until
+ * Tcl_GetStringFromObj() has been called on this object.
+ *
+ * Results:
+ * The new byte array of the specified length.
+ *
+ * Side effects:
+ * Allocates enough memory for an array of bytes of the requested
+ * size. When growing the array, the old array is copied to the
+ * new array; new bytes are undefined. When shrinking, the
+ * old array is truncated to the specified length.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned char *
+Tcl_SetByteArrayLength(objPtr, length)
+ Tcl_Obj *objPtr; /* The ByteArray object. */
+ int length; /* New length for internal byte array. */
+{
+ ByteArray *byteArrayPtr, *newByteArrayPtr;
+
+ if (Tcl_IsShared(objPtr)) {
+ panic("Tcl_SetObjLength called with shared object");
+ }
+ if (objPtr->typePtr != &tclByteArrayType) {
+ SetByteArrayFromAny(NULL, objPtr);
+ }
+
+ byteArrayPtr = GET_BYTEARRAY(objPtr);
+ if (length > byteArrayPtr->allocated) {
+ newByteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ newByteArrayPtr->used = length;
+ newByteArrayPtr->allocated = length;
+ memcpy((VOID *) newByteArrayPtr->bytes,
+ (VOID *) byteArrayPtr->bytes, (size_t) byteArrayPtr->used);
+ ckfree((char *) byteArrayPtr);
+ byteArrayPtr = newByteArrayPtr;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+ Tcl_InvalidateStringRep(objPtr);
+ byteArrayPtr->used = length;
+ return byteArrayPtr->bytes;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetByteArrayFromAny --
+ *
+ * Generate the ByteArray internal rep from the string rep.
+ *
+ * Results:
+ * The return value is always TCL_OK.
+ *
+ * Side effects:
+ * A ByteArray object is stored as the internal rep of objPtr.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetByteArrayFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Not used. */
+ Tcl_Obj *objPtr; /* The object to convert to type ByteArray. */
+{
+ Tcl_ObjType *typePtr;
+ int length;
+ char *src, *srcEnd;
+ unsigned char *dst;
+ ByteArray *byteArrayPtr;
+ Tcl_UniChar ch;
+
+ typePtr = objPtr->typePtr;
+ if (typePtr != &tclByteArrayType) {
+ src = Tcl_GetStringFromObj(objPtr, &length);
+ srcEnd = src + length;
+
+ byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ *dst++ = (unsigned char) ch;
+ }
+
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
+ byteArrayPtr->allocated = length;
+
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(objPtr, byteArrayPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeByteArrayInternalRep --
+ *
+ * Deallocate the storage associated with a ByteArray data object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeByteArrayInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Object with internal rep to free. */
+{
+ ckfree((char *) GET_BYTEARRAY(objPtr));
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DupByteArrayInternalRep --
+ *
+ * Initialize the internal representation of a ByteArray Tcl_Obj
+ * to a copy of the internal representation of an existing ByteArray
+ * object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DupByteArrayInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ int length;
+ ByteArray *srcArrayPtr, *copyArrayPtr;
+
+ srcArrayPtr = GET_BYTEARRAY(srcPtr);
+ length = srcArrayPtr->used;
+
+ copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr->used = length;
+ copyArrayPtr->allocated = length;
+ memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes,
+ (size_t) length);
+ SET_BYTEARRAY(copyPtr, copyArrayPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfByteArray(objPtr)
+ 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;
+
+ /*
+ * How much space will string rep need?
+ */
+
+ size = length;
+ for (i = 0; i < length; i++) {
+ if ((src[i] == 0) || (src[i] > 127)) {
+ size++;
+ }
+ }
+
+ dst = (char *) ckalloc((unsigned) (size + 1));
+ objPtr->bytes = dst;
+ objPtr->length = size;
+
+ if (size == length) {
+ memcpy((VOID *) dst, (VOID *) src, (size_t) size);
+ dst[size] = '\0';
+ } else {
+ for (i = 0; i < length; i++) {
+ dst += Tcl_UniCharToUtf(src[i], dst);
+ }
+ *dst = '\0';
+ }
+}
/*
*----------------------------------------------------------------------
@@ -65,43 +471,49 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
* character. */
char *format; /* Pointer to current position in format
* string. */
- char *cursor; /* Current position within result buffer. */
- char *maxPos; /* Greatest position within result buffer that
+ Tcl_Obj *resultPtr; /* Object holding result buffer. */
+ unsigned char *buffer; /* Start of result buffer. */
+ unsigned char *cursor; /* Current position within result buffer. */
+ unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
- char *buffer; /* Start of data buffer. */
char *errorString, *errorValue, *str;
- int offset, size, length;
- Tcl_Obj *resultPtr;
-
- static char *subCmds[] = { "format", "scan", (char *) NULL };
- enum { BinaryFormat, BinaryScan } index;
+ int offset, size, length, index;
+ static char *options[] = {
+ "format", "scan", NULL
+ };
+ enum options {
+ BINARY_FORMAT, BINARY_SCAN
+ };
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- if (Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,
- (int *) &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- switch (index) {
- case BinaryFormat:
+ switch ((enum options) index) {
+ case BINARY_FORMAT: {
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
return TCL_ERROR;
}
+
/*
* To avoid copying the data, we format the string in two passes.
* The first pass computes the size of the output buffer. The
* second pass places the formatted data into the buffer.
*/
- format = Tcl_GetStringFromObj(objv[2], NULL);
+ format = Tcl_GetString(objv[2]);
arg = 3;
- offset = length = 0;
- while (*format != 0) {
+ offset = 0;
+ length = 0;
+ while (*format != '\0') {
+ str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
break;
}
@@ -111,17 +523,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'b':
case 'B':
case 'h':
- case 'H':
+ case 'H': {
/*
* For string-type specifiers, the count corresponds
- * to the number of characters in a single argument.
+ * to the number of bytes in a single argument.
*/
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_ALL) {
- (void)Tcl_GetStringFromObj(objv[arg], &count);
+ Tcl_GetByteArrayFromObj(objv[arg], &count);
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -134,24 +546,29 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += (count + 1) / 2;
}
break;
-
- case 'c':
+ }
+ case 'c': {
size = 1;
goto doNumbers;
+ }
case 's':
- case 'S':
+ case 'S': {
size = 2;
goto doNumbers;
+ }
case 'i':
- case 'I':
+ case 'I': {
size = 4;
goto doNumbers;
- case 'f':
+ }
+ case 'f': {
size = sizeof(float);
goto doNumbers;
- case 'd':
+ }
+ case 'd': {
size = sizeof(double);
- doNumbers:
+
+ doNumbers:
if (arg >= objc) {
goto badIndex;
}
@@ -176,23 +593,28 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
- errorString = "number of elements in list does not match count";
- goto error;
+ Tcl_AppendResult(interp,
+ "number of elements in list does not match count",
+ (char *) NULL);
+ return TCL_ERROR;
}
}
offset += count*size;
break;
-
- case 'x':
+ }
+ case 'x': {
if (count == BINARY_ALL) {
- errorString = "cannot use \"*\" in format string with \"x\"";
- goto error;
+ Tcl_AppendResult(interp,
+ "cannot use \"*\" in format string with \"x\"",
+ (char *) NULL);
+ return TCL_ERROR;
} else if (count == BINARY_NOCOUNT) {
count = 1;
}
offset += count;
break;
- case 'X':
+ }
+ case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -204,7 +626,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
offset -= count;
break;
- case '@':
+ }
+ case '@': {
if (offset > length) {
length = offset;
}
@@ -216,15 +639,10 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset = count;
}
break;
+ }
default: {
- char buf[2];
-
- Tcl_ResetResult(interp);
- buf[0] = cmd;
- buf[1] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad field specifier \"", buf, "\"", NULL);
- return TCL_ERROR;
+ errorString = str;
+ goto badfield;
}
}
}
@@ -241,9 +659,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*/
resultPtr = Tcl_GetObjResult(interp);
- Tcl_SetObjLength(resultPtr, length);
- buffer = Tcl_GetStringFromObj(resultPtr, NULL);
- memset(buffer, 0, (size_t) length);
+ buffer = Tcl_SetByteArrayLength(resultPtr, length);
+ memset((VOID *) buffer, 0, (size_t) length);
/*
* Pack the data into the result object. Note that we can skip
@@ -252,7 +669,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
*/
arg = 3;
- format = Tcl_GetStringFromObj(objv[2], NULL);
+ format = Tcl_GetString(objv[2]);
cursor = buffer;
maxPos = cursor;
while (*format != 0) {
@@ -267,8 +684,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'a':
case 'A': {
char pad = (char) (cmd == 'a' ? '\0' : ' ');
+ unsigned char *bytes;
- str = Tcl_GetStringFromObj(objv[arg++], &length);
+ bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
count = length;
@@ -276,12 +694,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
count = 1;
}
if (length >= count) {
- memcpy((VOID *) cursor, (VOID *) str,
+ memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) count);
} else {
- memcpy((VOID *) cursor, (VOID *) str,
+ memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
- memset(cursor+length, pad,
+ memset((VOID *) (cursor + length), pad,
(size_t) (count - length));
}
cursor += count;
@@ -289,7 +707,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case 'b':
case 'B': {
- char *last;
+ unsigned char *last;
str = Tcl_GetStringFromObj(objv[arg++], &length);
if (count == BINARY_ALL) {
@@ -313,7 +731,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (((offset + 1) % 8) == 0) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -327,7 +745,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (!((offset + 1) % 8)) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -338,7 +756,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
value >>= 8 - (offset % 8);
}
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
}
while (cursor < last) {
*cursor++ = '\0';
@@ -347,7 +765,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case 'h':
case 'H': {
- char *last;
+ unsigned char *last;
int c;
str = Tcl_GetStringFromObj(objv[arg++], &length);
@@ -365,15 +783,18 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (cmd == 'H') {
for (offset = 0; offset < count; offset++) {
value <<= 4;
- c = tolower(((unsigned char *) str)[offset]);
- if ((c >= 'a') && (c <= 'f')) {
- value |= ((c - 'a' + 10) & 0xf);
- } else if ((c >= '0') && (c <= '9')) {
- value |= (c - '0') & 0xf;
- } else {
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
errorValue = str;
goto badValue;
}
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= (c & 0xf);
if (offset % 2) {
*cursor++ = (char) value;
value = 0;
@@ -382,17 +803,21 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
for (offset = 0; offset < count; offset++) {
value >>= 4;
- c = tolower(((unsigned char *) str)[offset]);
- if ((c >= 'a') && (c <= 'f')) {
- value |= ((c - 'a' + 10) << 4) & 0xf0;
- } else if ((c >= '0') && (c <= '9')) {
- value |= ((c - '0') << 4) & 0xf0;
- } else {
+
+ if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
errorValue = str;
goto badValue;
}
+ c = str[offset] - '0';
+ if (c > 9) {
+ c += ('0' - 'A') + 10;
+ }
+ if (c > 16) {
+ c += ('A' - 'a');
+ }
+ value |= ((c << 4) & 0xf0);
if (offset % 2) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char)(value & 0xff);
value = 0;
}
}
@@ -403,7 +828,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
value >>= 4;
}
- *cursor++ = (char) value;
+ *cursor++ = (unsigned char) value;
}
while (cursor < last) {
@@ -447,14 +872,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
break;
}
- case 'x':
+ case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
memset(cursor, 0, (size_t) count);
cursor += count;
break;
- case 'X':
+ }
+ case 'X': {
if (cursor > maxPos) {
maxPos = cursor;
}
@@ -468,7 +894,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (cursor > maxPos) {
maxPos = cursor;
}
@@ -478,11 +905,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor = buffer + count;
}
break;
+ }
}
}
break;
-
- case BinaryScan: {
+ }
+ case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
@@ -491,18 +919,21 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
"value formatString ?varName varName ...?");
return TCL_ERROR;
}
- buffer = Tcl_GetStringFromObj(objv[2], &length);
- format = Tcl_GetStringFromObj(objv[3], NULL);
+ buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
+ format = Tcl_GetString(objv[3]);
cursor = buffer;
arg = 4;
offset = 0;
- while (*format != 0) {
+ while (*format != '\0') {
+ str = format;
if (!GetFormatSpec(&format, &cmd, &count)) {
goto done;
}
switch (cmd) {
case 'a':
- case 'A':
+ case 'A': {
+ unsigned char *src;
+
if (arg >= objc) {
goto badIndex;
}
@@ -517,7 +948,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
- str = buffer + offset;
+ src = buffer + offset;
size = count;
/*
@@ -526,50 +957,54 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (cmd == 'A') {
while (size > 0) {
- if (str[size-1] != '\0' && str[size-1] != ' ') {
+ if (src[size-1] != '\0' && src[size-1] != ' ') {
break;
}
size--;
}
}
- valuePtr = Tcl_NewStringObj(str, size);
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ valuePtr = Tcl_NewByteArrayObj(src, size);
+ resultPtr = Tcl_SetObjVar2(interp,
+ Tcl_GetString(objv[arg]),
+ NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
offset += count;
break;
+ }
case 'b':
case 'B': {
+ unsigned char *src;
char *dest;
if (arg >= objc) {
goto badIndex;
}
if (count == BINARY_ALL) {
- count = (length - offset)*8;
+ count = (length - offset) * 8;
} else {
if (count == BINARY_NOCOUNT) {
count = 1;
}
- if (count > (length - offset)*8) {
+ if (count > (length - offset) * 8) {
goto done;
}
}
- str = buffer + offset;
+ src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetStringFromObj(valuePtr, NULL);
+ dest = Tcl_GetString(valuePtr);
if (cmd == 'b') {
for (i = 0; i < count; i++) {
if (i % 8) {
value >>= 1;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = (char) ((value & 1) ? '1' : '0');
}
@@ -578,15 +1013,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (i % 8) {
value <<= 1;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = (char) ((value & 0x80) ? '1' : '0');
}
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_SetObjVar2(interp,
+ Tcl_GetString(objv[arg]),
+ NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
@@ -597,6 +1034,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'h':
case 'H': {
char *dest;
+ unsigned char *src;
int i;
static char hexdigit[] = "0123456789abcdef";
@@ -613,17 +1051,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto done;
}
}
- str = buffer + offset;
+ src = buffer + offset;
valuePtr = Tcl_NewObj();
Tcl_SetObjLength(valuePtr, count);
- dest = Tcl_GetStringFromObj(valuePtr, NULL);
+ dest = Tcl_GetString(valuePtr);
if (cmd == 'h') {
for (i = 0; i < count; i++) {
if (i % 2) {
value >>= 4;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = hexdigit[value & 0xf];
}
@@ -632,15 +1070,17 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
if (i % 2) {
value <<= 4;
} else {
- value = *str++;
+ value = *src++;
}
*dest++ = hexdigit[(value >> 4) & 0xf];
}
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_SetObjVar2(interp,
+ Tcl_GetString(objv[arg]),
+ NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
@@ -648,24 +1088,31 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += (count + 1) / 2;
break;
}
- case 'c':
+ case 'c': {
size = 1;
goto scanNumber;
+ }
case 's':
- case 'S':
+ case 'S': {
size = 2;
goto scanNumber;
+ }
case 'i':
- case 'I':
+ case 'I': {
size = 4;
goto scanNumber;
- case 'f':
+ }
+ case 'f': {
size = sizeof(float);
goto scanNumber;
- case 'd':
+ }
+ case 'd': {
+ unsigned char *src;
+
size = sizeof(double);
/* fall through */
- scanNumber:
+
+ scanNumber:
if (arg >= objc) {
goto badIndex;
}
@@ -683,25 +1130,28 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto done;
}
valuePtr = Tcl_NewObj();
- str = buffer+offset;
+ src = buffer+offset;
for (i = 0; i < count; i++) {
- elementPtr = ScanNumber(str, cmd);
- str += size;
+ elementPtr = ScanNumber(src, cmd);
+ src += size;
Tcl_ListObjAppendElement(NULL, valuePtr,
elementPtr);
}
offset += count*size;
}
- resultPtr = Tcl_ObjSetVar2(interp, objv[arg++], NULL,
- valuePtr,
- TCL_LEAVE_ERR_MSG | TCL_PARSE_PART1);
+ resultPtr = Tcl_SetObjVar2(interp,
+ Tcl_GetString(objv[arg]),
+ NULL, valuePtr,
+ TCL_LEAVE_ERR_MSG);
+ arg++;
if (resultPtr == NULL) {
Tcl_DecrRefCount(valuePtr); /* unneeded */
return TCL_ERROR;
}
break;
- case 'x':
+ }
+ case 'x': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -712,7 +1162,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += count;
}
break;
- case 'X':
+ }
+ case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -722,7 +1173,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (count == BINARY_NOCOUNT) {
goto badCount;
}
@@ -732,15 +1184,10 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset = count;
}
break;
+ }
default: {
- char buf[2];
-
- Tcl_ResetResult(interp);
- buf[0] = cmd;
- buf[1] = '\0';
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "bad field specifier \"", buf, "\"", NULL);
- return TCL_ERROR;
+ errorString = str;
+ goto badfield;
}
}
}
@@ -771,9 +1218,18 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
errorString = "not enough arguments for all format specifiers";
goto error;
+ badfield: {
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX + 1];
+
+ Tcl_UtfToUniChar(errorString, &ch);
+ buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
+ Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
+ return TCL_ERROR;
+ }
+
error:
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), errorString, -1);
+ Tcl_AppendResult(interp, errorString, NULL);
return TCL_ERROR;
}
@@ -829,7 +1285,7 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr)
if (**formatPtr == '*') {
(*formatPtr)++;
(*countPtr) = BINARY_ALL;
- } else if (isdigit(**formatPtr)) {
+ } else if (isdigit(**formatPtr)) { /* INTL: digit */
(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
} else {
(*countPtr) = BINARY_NOCOUNT;
@@ -860,13 +1316,12 @@ FormatNumber(interp, type, src, cursorPtr)
* errors. */
int type; /* Type of number to format. */
Tcl_Obj *src; /* Number to format. */
- char **cursorPtr; /* Pointer to index into destination buffer. */
+ unsigned char **cursorPtr; /* Pointer to index into destination buffer. */
{
int value;
double dvalue;
- char cmd = (char)type;
- if (cmd == 'd' || cmd == 'f') {
+ if ((type == 'd') || (type == 'f')) {
/*
* For floating point types, we need to copy the data using
* memcpy to avoid alignment issues.
@@ -875,9 +1330,9 @@ FormatNumber(interp, type, src, cursorPtr)
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
return TCL_ERROR;
}
- if (cmd == 'd') {
- memcpy((*cursorPtr), &dvalue, sizeof(double));
- (*cursorPtr) += sizeof(double);
+ if (type == 'd') {
+ memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
+ *cursorPtr += sizeof(double);
} else {
float fvalue;
@@ -892,31 +1347,31 @@ FormatNumber(interp, type, src, cursorPtr)
} else {
fvalue = (float) dvalue;
}
- memcpy((*cursorPtr), &fvalue, sizeof(float));
- (*cursorPtr) += sizeof(float);
+ memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
+ *cursorPtr += sizeof(float);
}
} else {
if (Tcl_GetIntFromObj(interp, src, &value) != TCL_OK) {
return TCL_ERROR;
}
- if (cmd == 'c') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- } else if (cmd == 's') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- } else if (cmd == 'S') {
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)(value & 0xff);
- } else if (cmd == 'i') {
- *(*cursorPtr)++ = (char)(value & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
- } else if (cmd == 'I') {
- *(*cursorPtr)++ = (char)((value >> 24) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 16) & 0xff);
- *(*cursorPtr)++ = (char)((value >> 8) & 0xff);
- *(*cursorPtr)++ = (char)(value & 0xff);
+ if (type == 'c') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ } else if (type == 's') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ } else if (type == 'S') {
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
+ } else if (type == 'i') {
+ *(*cursorPtr)++ = (unsigned char) value;
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ } else if (type == 'I') {
+ *(*cursorPtr)++ = (unsigned char) (value >> 24);
+ *(*cursorPtr)++ = (unsigned char) (value >> 16);
+ *(*cursorPtr)++ = (unsigned char) (value >> 8);
+ *(*cursorPtr)++ = (unsigned char) value;
}
}
return TCL_OK;
@@ -942,10 +1397,10 @@ FormatNumber(interp, type, src, cursorPtr)
static Tcl_Obj *
ScanNumber(buffer, type)
- char *buffer; /* Buffer to scan number from. */
+ unsigned char *buffer; /* Buffer to scan number from. */
int type; /* Format character from "binary scan" */
{
- int value;
+ long value;
/*
* We cannot rely on the compiler to properly sign extend integer values
@@ -955,37 +1410,45 @@ ScanNumber(buffer, type)
* needed.
*/
- switch ((char) type) {
- case 'c':
- value = buffer[0];
+ switch (type) {
+ case 'c': {
+ /*
+ * Characters need special handling. We want to produce a
+ * signed result, but on some platforms (such as AIX) chars
+ * are unsigned. To deal with this, check for a value that
+ * should be negative but isn't.
+ */
+ value = buffer[0];
if (value & 0x80) {
value |= -0x100;
}
return Tcl_NewLongObj((long)value);
- case 's':
- value = (((unsigned char)buffer[0])
- + ((unsigned char)buffer[1] << 8));
+ }
+ case 's': {
+ value = (long) (buffer[0] + (buffer[1] << 8));
goto shortValue;
- case 'S':
- value = (((unsigned char)buffer[1])
- + ((unsigned char)buffer[0] << 8));
+ }
+ case 'S': {
+ value = (long) (buffer[1] + (buffer[0] << 8));
shortValue:
if (value & 0x8000) {
value |= -0x10000;
}
- return Tcl_NewLongObj((long)value);
- case 'i':
- value = (((unsigned char)buffer[0])
- + ((unsigned char)buffer[1] << 8)
- + ((unsigned char)buffer[2] << 16)
- + ((unsigned char)buffer[3] << 24));
+ return Tcl_NewLongObj(value);
+ }
+ case 'i': {
+ value = (long) (buffer[0]
+ + (buffer[1] << 8)
+ + (buffer[2] << 16)
+ + (buffer[3] << 24));
goto intValue;
- case 'I':
- value = (((unsigned char)buffer[3])
- + ((unsigned char)buffer[2] << 8)
- + ((unsigned char)buffer[1] << 16)
- + ((unsigned char)buffer[0] << 24));
+ }
+ case 'I': {
+ value = (long) (buffer[3]
+ + (buffer[2] << 8)
+ + (buffer[1] << 16)
+ + (buffer[0] << 24));
intValue:
/*
* Check to see if the value was sign extended properly on
@@ -996,16 +1459,16 @@ ScanNumber(buffer, type)
value -= (((unsigned int)1)<<31);
value -= (((unsigned int)1)<<31);
}
-
- return Tcl_NewLongObj((long)value);
+ return Tcl_NewLongObj(value);
+ }
case 'f': {
float fvalue;
- memcpy(&fvalue, buffer, sizeof(float));
+ memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float));
return Tcl_NewDoubleObj(fvalue);
}
case 'd': {
double dvalue;
- memcpy(&dvalue, buffer, sizeof(double));
+ memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double));
return Tcl_NewDoubleObj(dvalue);
}
}
generated by cgit v0.12 at 2024-07-15 20:20:19 (GMT)