diff options
author | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
commit | 494c2de3a748b449c69ce322a1a741f5a31fd4d5 (patch) | |
tree | c3ece48c0ae3f4ba54787e0e8e729b65752ef3f9 /generic/tclBinary.c | |
parent | 7a698c0488d99c0af42022714638ae1ba2afaa49 (diff) | |
download | tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.zip tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.gz tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.bz2 |
Added contents of Tcl 8.1a2
Diffstat (limited to 'generic/tclBinary.c')
-rw-r--r-- | generic/tclBinary.c | 827 |
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); } } |