diff options
Diffstat (limited to 'generic/tclBinary.c')
| -rw-r--r-- | generic/tclBinary.c | 1676 |
1 files changed, 829 insertions, 847 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c index bb370e0..c6231f0 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -1,4 +1,4 @@ -/* +/* * tclBinary.c -- * * This file contains the implementation of the "binary" Tcl built-in @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBinary.c,v 1.24 2005/05/13 17:11:59 dgp Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.25 2005/07/17 21:17:30 dkf Exp $ */ #include "tclInt.h" @@ -26,21 +26,20 @@ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* - * The following defines the maximum number of different (integer) - * numbers placed in the object cache by 'binary scan' before it bails - * out and switches back to Plan A (creating a new object for each - * value.) Theoretically, it would be possible to keep the cache - * about for the values that are already in it, but that makes the - * code slower in practise when overflow happens, and makes little - * odds the rest of the time (as measured on my machine.) It is also - * slower (on the sample I tried at least) to grow the cache to hold - * all items we might want to put in it; presumably the extra cost of - * managing the memory for the enlarged table outweighs the benefit - * from allocating fewer objects. This is probably because as the - * number of objects increases, the likelihood of reuse of any - * particular one drops, and there is very little gain from larger - * maximum cache sizes (the value below is chosen to allow caching to - * work in full with conversion of bytes.) - DKF + * The following defines the maximum number of different (integer) numbers + * placed in the object cache by 'binary scan' before it bails out and + * switches back to Plan A (creating a new object for each value.) + * Theoretically, it would be possible to keep the cache about for the values + * that are already in it, but that makes the code slower in practise when + * overflow happens, and makes little odds the rest of the time (as measured + * on my machine.) It is also slower (on the sample I tried at least) to grow + * the cache to hold all items we might want to put in it; presumably the + * extra cost of managing the memory for the enlarged table outweighs the + * benefit from allocating fewer objects. This is probably because as the + * number of objects increases, the likelihood of reuse of any particular one + * drops, and there is very little gain from larger maximum cache sizes (the + * value below is chosen to allow caching to work in full with conversion of + * bytes.) - DKF */ #define BINARY_SCAN_MAX_CACHE 260 @@ -68,28 +67,28 @@ static void CopyNumber _ANSI_ARGS_((CONST void *from, void *to, unsigned int length, int type)); /* - * 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. + * 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. + * 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. + * 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. + * 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 = { @@ -101,10 +100,10 @@ Tcl_ObjType tclByteArrayType = { }; /* - * 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. + * 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 { @@ -130,13 +129,12 @@ typedef struct ByteArray { * * Tcl_NewByteArrayObj -- * - * This procedure is creates a new ByteArray object and initializes - * it from the given array of bytes. + * 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. + * 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. @@ -147,13 +145,12 @@ typedef struct ByteArray { #ifdef TCL_MEM_DEBUG #undef Tcl_NewByteArrayObj - Tcl_Obj * Tcl_NewByteArrayObj(bytes, length) - CONST 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. */ + CONST 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. */ { return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); } @@ -162,10 +159,10 @@ Tcl_NewByteArrayObj(bytes, length) Tcl_Obj * Tcl_NewByteArrayObj(bytes, length) - CONST 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. */ + CONST 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; @@ -191,9 +188,8 @@ Tcl_NewByteArrayObj(bytes, length) * result of calling Tcl_NewByteArrayObj. * * Results: - * The newly create object is returned. This object will have no - * initial string representation. The returned object has a ref count - * of 0. + * 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. @@ -205,14 +201,14 @@ Tcl_NewByteArrayObj(bytes, length) Tcl_Obj * Tcl_DbNewByteArrayObj(bytes, length, file, line) - CONST 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. */ + CONST 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. */ CONST char *file; /* The name of the source file calling this * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ + int line; /* Line number in the source file; used for + * debugging. */ { Tcl_Obj *objPtr; @@ -225,14 +221,14 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line) Tcl_Obj * Tcl_DbNewByteArrayObj(bytes, length, file, line) - CONST 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. */ + CONST 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. */ CONST char *file; /* The name of the source file calling this * procedure; used for debugging. */ - int line; /* Line number in the source file; used - * for debugging. */ + int line; /* Line number in the source file; used for + * debugging. */ { return Tcl_NewByteArrayObj(bytes, length); } @@ -250,8 +246,8 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line) * None. * * Side effects: - * The object's old string rep and internal rep is freed. - * Memory allocated for copy of byte array argument. + * The object's old string rep and internal rep is freed. Memory + * allocated for copy of byte array argument. * *---------------------------------------------------------------------- */ @@ -261,8 +257,8 @@ Tcl_SetByteArrayObj(objPtr, bytes, length) Tcl_Obj *objPtr; /* Object to initialize as a ByteArray. */ CONST 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. */ + int length; /* Length of the array of bytes, which must be + * >= 0. */ { ByteArray *byteArrayPtr; @@ -286,9 +282,9 @@ Tcl_SetByteArrayObj(objPtr, bytes, length) * * 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. + * 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. @@ -306,7 +302,7 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr) * array of bytes in the ByteArray object. */ { ByteArray *baPtr; - + SetByteArrayFromAny(NULL, objPtr); baPtr = GET_BYTEARRAY(objPtr); @@ -321,19 +317,19 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr) * * 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. + * 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. + * 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. * *---------------------------------------------------------------------- */ @@ -344,7 +340,7 @@ Tcl_SetByteArrayLength(objPtr, length) int length; /* New length for internal byte array. */ { ByteArray *byteArrayPtr, *newByteArrayPtr; - + if (Tcl_IsShared(objPtr)) { Tcl_Panic("Tcl_SetObjLength called with shared object"); } @@ -394,7 +390,7 @@ SetByteArrayFromAny(interp, objPtr) unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch; - + if (objPtr->typePtr != &tclByteArrayType) { src = Tcl_GetStringFromObj(objPtr, &length); srcEnd = src + length; @@ -427,7 +423,7 @@ SetByteArrayFromAny(interp, objPtr) * None. * * Side effects: - * Frees memory. + * Frees memory. * *---------------------------------------------------------------------- */ @@ -444,9 +440,8 @@ FreeByteArrayInternalRep(objPtr) * * DupByteArrayInternalRep -- * - * Initialize the internal representation of a ByteArray Tcl_Obj - * to a copy of the internal representation of an existing ByteArray - * object. + * Initialize the internal representation of a ByteArray Tcl_Obj to a + * copy of the internal representation of an existing ByteArray object. * * Results: * None. @@ -463,7 +458,7 @@ DupByteArrayInternalRep(srcPtr, copyPtr) Tcl_Obj *copyPtr; /* Object with internal rep to set. */ { int length; - ByteArray *srcArrayPtr, *copyArrayPtr; + ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); length = srcArrayPtr->used; @@ -483,19 +478,19 @@ DupByteArrayInternalRep(srcPtr, copyPtr) * * 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. 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'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. + * The object becomes a string object -- the internal rep is discarded + * and the typePtr becomes NULL. * *---------------------------------------------------------------------- */ @@ -517,7 +512,7 @@ UpdateStringOfByteArray(objPtr) /* * How much space will string rep need? */ - + size = length; for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { @@ -578,10 +573,10 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) * cursor has visited.*/ char *errorString, *errorValue, *str; int offset, size, length, index; - static CONST char *options[] = { - "format", "scan", NULL + static CONST char *options[] = { + "format", "scan", NULL }; - enum options { + enum options { BINARY_FORMAT, BINARY_SCAN }; @@ -596,771 +591,753 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) } switch ((enum options) index) { - case BINARY_FORMAT: { - if (objc < 3) { - Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?"); - return TCL_ERROR; + 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_GetString(objv[2]); + arg = 3; + offset = 0; + length = 0; + while (*format != '\0') { + str = format; + if (!GetFormatSpec(&format, &cmd, &count)) { + break; } + switch (cmd) { + case 'a': + case 'A': + case 'b': + case 'B': + case 'h': + case 'H': + /* + * For string-type specifiers, the count corresponds to the + * number of bytes in a single argument. + */ - /* - * 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_GetString(objv[2]); - arg = 3; - offset = 0; - length = 0; - while (*format != '\0') { - str = format; - if (!GetFormatSpec(&format, &cmd, &count)) { - break; + if (arg >= objc) { + goto badIndex; + } + if (count == BINARY_ALL) { + Tcl_GetByteArrayFromObj(objv[arg], &count); + } else if (count == BINARY_NOCOUNT) { + count = 1; + } + arg++; + if (cmd == 'a' || cmd == 'A') { + offset += count; + } else if (cmd == 'b' || cmd == 'B') { + offset += (count + 7) / 8; + } else { + offset += (count + 1) / 2; + } + break; + case 'c': + size = 1; + goto doNumbers; + case 't': + case 's': + case 'S': + size = 2; + goto doNumbers; + case 'n': + case 'i': + case 'I': + size = 4; + goto doNumbers; + case 'm': + case 'w': + case 'W': + size = 8; + goto doNumbers; + case 'r': + case 'R': + case 'f': + size = sizeof(float); + goto doNumbers; + case 'q': + case 'Q': + case 'd': + size = sizeof(double); + + doNumbers: + if (arg >= objc) { + goto badIndex; } - switch (cmd) { - case 'a': - case 'A': - case 'b': - case 'B': - case 'h': - case 'H': { - /* - * For string-type specifiers, the count corresponds - * to the number of bytes in a single argument. - */ - - if (arg >= objc) { - goto badIndex; - } - if (count == BINARY_ALL) { - Tcl_GetByteArrayFromObj(objv[arg], &count); - } else if (count == BINARY_NOCOUNT) { - count = 1; - } - arg++; - if (cmd == 'a' || cmd == 'A') { - offset += count; - } else if (cmd == 'b' || cmd == 'B') { - offset += (count + 7) / 8; - } else { - offset += (count + 1) / 2; - } - break; - } - case 'c': { - size = 1; - goto doNumbers; - } - case 't': - case 's': - case 'S': { - size = 2; - goto doNumbers; - } - case 'n': - case 'i': - case 'I': { - size = 4; - goto doNumbers; - } - case 'm': - case 'w': - case 'W': { - size = 8; - goto doNumbers; - } - case 'r': - case 'R': - case 'f': { - size = sizeof(float); - goto doNumbers; - } - case 'q': - case 'Q': - case 'd': { - size = sizeof(double); - - doNumbers: - if (arg >= objc) { - goto badIndex; - } - /* - * For number-type specifiers, the count corresponds - * to the number of elements in the list stored in - * a single argument. If no count is specified, then - * the argument is taken as a single non-list value. - */ + /* + * For number-type specifiers, the count corresponds to the + * number of elements in the list stored in a single argument. + * If no count is specified, then the argument is taken as a + * single non-list value. + */ - if (count == BINARY_NOCOUNT) { - arg++; - count = 1; - } else { - int listc; - Tcl_Obj **listv; - if (Tcl_ListObjGetElements(interp, objv[arg++], - &listc, &listv) != TCL_OK) { - return TCL_ERROR; - } - if (count == BINARY_ALL) { - count = listc; - } else if (count > listc) { - Tcl_AppendResult(interp, - "number of elements in list does not match count", - (char *) NULL); - return TCL_ERROR; - } - } - offset += count*size; - break; - } - case 'x': { - if (count == BINARY_ALL) { - 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': { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if ((count > offset) || (count == BINARY_ALL)) { - count = offset; - } - if (offset > length) { - length = offset; - } - offset -= count; - break; - } - case '@': { - if (offset > length) { - length = offset; - } - if (count == BINARY_ALL) { - offset = length; - } else if (count == BINARY_NOCOUNT) { - goto badCount; - } else { - offset = count; - } - break; + if (count == BINARY_NOCOUNT) { + arg++; + count = 1; + } else { + int listc; + Tcl_Obj **listv; + + if (Tcl_ListObjGetElements(interp, objv[arg++], &listc, + &listv) != TCL_OK) { + return TCL_ERROR; } - default: { - errorString = str; - goto badField; + if (count == BINARY_ALL) { + count = listc; + } else if (count > listc) { + Tcl_AppendResult(interp, + "number of elements in list does not match count", + (char *) NULL); + return TCL_ERROR; } } + offset += count*size; + break; + + case 'x': + if (count == BINARY_ALL) { + 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': + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count > offset) || (count == BINARY_ALL)) { + count = offset; + } + if (offset > length) { + length = offset; + } + offset -= count; + break; + case '@': + if (offset > length) { + length = offset; + } + if (count == BINARY_ALL) { + offset = length; + } else if (count == BINARY_NOCOUNT) { + goto badCount; + } else { + offset = count; + } + break; + default: + errorString = str; + goto badField; + } + } + if (offset > length) { + length = offset; + } + if (length == 0) { + return TCL_OK; + } + + /* + * Prepare the result object by preallocating the caclulated number of + * bytes and filling with nulls. + */ + + resultPtr = Tcl_NewObj(); + buffer = Tcl_SetByteArrayLength(resultPtr, length); + memset((VOID *) buffer, 0, (size_t) length); + + /* + * Pack the data into the result object. Note that we can skip the + * error checking during this pass, since we have already parsed the + * string once. + */ + + arg = 3; + format = Tcl_GetString(objv[2]); + cursor = buffer; + maxPos = cursor; + while (*format != 0) { + if (!GetFormatSpec(&format, &cmd, &count)) { + break; } - if (offset > length) { - length = offset; + if ((count == 0) && (cmd != '@')) { + arg++; + continue; } - if (length == 0) { - return TCL_OK; + switch (cmd) { + case 'a': + case 'A': { + char pad = (char) (cmd == 'a' ? '\0' : ' '); + unsigned char *bytes; + + bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); + + if (count == BINARY_ALL) { + count = length; + } else if (count == BINARY_NOCOUNT) { + count = 1; + } + if (length >= count) { + memcpy((VOID *) cursor, (VOID *) bytes, (size_t) count); + } else { + memcpy((VOID *) cursor, (VOID *) bytes, (size_t) length); + memset((VOID *) (cursor + length), pad, + (size_t) (count - length)); + } + cursor += count; + break; } - - /* - * Prepare the result object by preallocating the caclulated - * number of bytes and filling with nulls. - */ - - resultPtr = Tcl_NewObj(); - buffer = Tcl_SetByteArrayLength(resultPtr, length); - memset((VOID *) buffer, 0, (size_t) length); - - /* - * Pack the data into the result object. Note that we can skip - * the error checking during this pass, since we have already - * parsed the string once. - */ - - arg = 3; - format = Tcl_GetString(objv[2]); - cursor = buffer; - maxPos = cursor; - while (*format != 0) { - if (!GetFormatSpec(&format, &cmd, &count)) { - break; + case 'b': + case 'B': { + unsigned char *last; + + str = Tcl_GetStringFromObj(objv[arg++], &length); + if (count == BINARY_ALL) { + count = length; + } else if (count == BINARY_NOCOUNT) { + count = 1; } - if ((count == 0) && (cmd != '@')) { - arg++; - continue; + last = cursor + ((count + 7) / 8); + if (count > length) { + count = length; } - switch (cmd) { - case 'a': - case 'A': { - char pad = (char) (cmd == 'a' ? '\0' : ' '); - unsigned char *bytes; - - bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length); - - if (count == BINARY_ALL) { - count = length; - } else if (count == BINARY_NOCOUNT) { - count = 1; + value = 0; + errorString = "binary"; + if (cmd == 'B') { + for (offset = 0; offset < count; offset++) { + value <<= 1; + if (str[offset] == '1') { + value |= 1; + } else if (str[offset] != '0') { + errorValue = str; + goto badValue; } - if (length >= count) { - memcpy((VOID *) cursor, (VOID *) bytes, - (size_t) count); - } else { - memcpy((VOID *) cursor, (VOID *) bytes, - (size_t) length); - memset((VOID *) (cursor + length), pad, - (size_t) (count - length)); + if (((offset + 1) % 8) == 0) { + *cursor++ = (unsigned char) value; + value = 0; } - cursor += count; - break; } - case 'b': - case 'B': { - unsigned char *last; - - str = Tcl_GetStringFromObj(objv[arg++], &length); - if (count == BINARY_ALL) { - count = length; - } else if (count == BINARY_NOCOUNT) { - count = 1; - } - last = cursor + ((count + 7) / 8); - if (count > length) { - count = length; + } else { + for (offset = 0; offset < count; offset++) { + value >>= 1; + if (str[offset] == '1') { + value |= 128; + } else if (str[offset] != '0') { + errorValue = str; + goto badValue; } - value = 0; - errorString = "binary"; - if (cmd == 'B') { - for (offset = 0; offset < count; offset++) { - value <<= 1; - if (str[offset] == '1') { - value |= 1; - } else if (str[offset] != '0') { - errorValue = str; - goto badValue; - } - if (((offset + 1) % 8) == 0) { - *cursor++ = (unsigned char) value; - value = 0; - } - } - } else { - for (offset = 0; offset < count; offset++) { - value >>= 1; - if (str[offset] == '1') { - value |= 128; - } else if (str[offset] != '0') { - errorValue = str; - goto badValue; - } - if (!((offset + 1) % 8)) { - *cursor++ = (unsigned char) value; - value = 0; - } - } - } - if ((offset % 8) != 0) { - if (cmd == 'B') { - value <<= 8 - (offset % 8); - } else { - value >>= 8 - (offset % 8); - } + if (!((offset + 1) % 8)) { *cursor++ = (unsigned char) value; + value = 0; } - while (cursor < last) { - *cursor++ = '\0'; - } - break; } - case 'h': - case 'H': { - unsigned char *last; - int c; - - str = Tcl_GetStringFromObj(objv[arg++], &length); - if (count == BINARY_ALL) { - count = length; - } else if (count == BINARY_NOCOUNT) { - count = 1; + } + if ((offset % 8) != 0) { + if (cmd == 'B') { + value <<= 8 - (offset % 8); + } else { + value >>= 8 - (offset % 8); + } + *cursor++ = (unsigned char) value; + } + while (cursor < last) { + *cursor++ = '\0'; + } + break; + } + case 'h': + case 'H': { + unsigned char *last; + int c; + + str = Tcl_GetStringFromObj(objv[arg++], &length); + if (count == BINARY_ALL) { + count = length; + } else if (count == BINARY_NOCOUNT) { + count = 1; + } + last = cursor + ((count + 1) / 2); + if (count > length) { + count = length; + } + value = 0; + errorString = "hexadecimal"; + if (cmd == 'H') { + for (offset = 0; offset < count; offset++) { + value <<= 4; + if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ + errorValue = str; + goto badValue; } - last = cursor + ((count + 1) / 2); - if (count > length) { - count = length; + c = str[offset] - '0'; + if (c > 9) { + c += ('0' - 'A') + 10; } - value = 0; - errorString = "hexadecimal"; - if (cmd == 'H') { - for (offset = 0; offset < count; offset++) { - value <<= 4; - 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; - } - } - } else { - for (offset = 0; offset < count; offset++) { - value >>= 4; - - 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++ = (unsigned char)(value & 0xff); - value = 0; - } - } + if (c > 16) { + c += ('A' - 'a'); } + value |= (c & 0xf); if (offset % 2) { - if (cmd == 'H') { - value <<= 4; - } else { - value >>= 4; - } - *cursor++ = (unsigned char) value; + *cursor++ = (char) value; + value = 0; } + } + } else { + for (offset = 0; offset < count; offset++) { + value >>= 4; - while (cursor < last) { - *cursor++ = '\0'; + if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ + errorValue = str; + goto badValue; } - break; - } - case 'c': - case 't': - case 's': - case 'S': - case 'n': - case 'i': - case 'I': - case 'm': - case 'w': - case 'W': - case 'r': - case 'R': - case 'd': - case 'q': - case 'Q': - case 'f': { - int listc, i; - Tcl_Obj **listv; - - if (count == BINARY_NOCOUNT) { - /* - * Note that we are casting away the const-ness of - * objv, but this is safe since we aren't going to - * modify the array. - */ - - listv = (Tcl_Obj**)(objv + arg); - listc = 1; - count = 1; - } else { - Tcl_ListObjGetElements(interp, objv[arg], - &listc, &listv); - if (count == BINARY_ALL) { - count = listc; - } + c = str[offset] - '0'; + if (c > 9) { + c += ('0' - 'A') + 10; } - arg++; - for (i = 0; i < count; i++) { - if (FormatNumber(interp, cmd, listv[i], &cursor) - != TCL_OK) { - return TCL_ERROR; - } + if (c > 16) { + c += ('A' - 'a'); } - break; - } - case 'x': { - if (count == BINARY_NOCOUNT) { - count = 1; + value |= ((c << 4) & 0xf0); + if (offset % 2) { + *cursor++ = (unsigned char)(value & 0xff); + value = 0; } - memset(cursor, 0, (size_t) count); - cursor += count; - break; } - case 'X': { - if (cursor > maxPos) { - maxPos = cursor; - } - if (count == BINARY_NOCOUNT) { - count = 1; - } - if ((count == BINARY_ALL) - || (count > (cursor - buffer))) { - cursor = buffer; - } else { - cursor -= count; - } - break; + } + if (offset % 2) { + if (cmd == 'H') { + value <<= 4; + } else { + value >>= 4; } - case '@': { - if (cursor > maxPos) { - maxPos = cursor; - } - if (count == BINARY_ALL) { - cursor = maxPos; - } else { - cursor = buffer + count; - } - break; + *cursor++ = (unsigned char) value; + } + + while (cursor < last) { + *cursor++ = '\0'; + } + break; + } + case 'c': + case 't': + case 's': + case 'S': + case 'n': + case 'i': + case 'I': + case 'm': + case 'w': + case 'W': + case 'r': + case 'R': + case 'd': + case 'q': + case 'Q': + case 'f': { + int listc, i; + Tcl_Obj **listv; + + if (count == BINARY_NOCOUNT) { + /* + * Note that we are casting away the const-ness of objv, + * but this is safe since we aren't going to modify the + * array. + */ + + listv = (Tcl_Obj**)(objv + arg); + listc = 1; + count = 1; + } else { + Tcl_ListObjGetElements(interp, objv[arg], &listc, &listv); + if (count == BINARY_ALL) { + count = listc; + } + } + arg++; + for (i = 0; i < count; i++) { + if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { + return TCL_ERROR; } } + break; + } + case 'x': + if (count == BINARY_NOCOUNT) { + count = 1; + } + memset(cursor, 0, (size_t) count); + cursor += count; + break; + case 'X': + if (cursor > maxPos) { + maxPos = cursor; + } + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count == BINARY_ALL) || (count > (cursor - buffer))) { + cursor = buffer; + } else { + cursor -= count; + } + break; + case '@': + if (cursor > maxPos) { + maxPos = cursor; + } + if (count == BINARY_ALL) { + cursor = maxPos; + } else { + cursor = buffer + count; + } + break; } - Tcl_SetObjResult(interp, resultPtr); - break; } - case BINARY_SCAN: { - int i; - Tcl_Obj *valuePtr, *elementPtr; - Tcl_HashTable numberCacheHash; - Tcl_HashTable *numberCachePtr; - - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "value formatString ?varName varName ...?"); - return TCL_ERROR; + Tcl_SetObjResult(interp, resultPtr); + break; + case BINARY_SCAN: { + int i; + Tcl_Obj *valuePtr, *elementPtr; + Tcl_HashTable numberCacheHash; + Tcl_HashTable *numberCachePtr; + + if (objc < 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "value formatString ?varName varName ...?"); + return TCL_ERROR; + } + numberCachePtr = &numberCacheHash; + Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); + buffer = Tcl_GetByteArrayFromObj(objv[2], &length); + format = Tcl_GetString(objv[3]); + cursor = buffer; + arg = 4; + offset = 0; + while (*format != '\0') { + str = format; + if (!GetFormatSpec(&format, &cmd, &count)) { + goto done; } - numberCachePtr = &numberCacheHash; - Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = Tcl_GetByteArrayFromObj(objv[2], &length); - format = Tcl_GetString(objv[3]); - cursor = buffer; - arg = 4; - offset = 0; - while (*format != '\0') { - str = format; - if (!GetFormatSpec(&format, &cmd, &count)) { - goto done; + switch (cmd) { + case 'a': + case 'A': { + unsigned char *src; + + if (arg >= objc) { + DeleteScanNumberCache(numberCachePtr); + goto badIndex; + } + if (count == BINARY_ALL) { + count = length - offset; + } else { + if (count == BINARY_NOCOUNT) { + count = 1; + } + if (count > (length - offset)) { + goto done; + } } - switch (cmd) { - case 'a': - case 'A': { - unsigned char *src; - - if (arg >= objc) { - DeleteScanNumberCache(numberCachePtr); - goto badIndex; - } - if (count == BINARY_ALL) { - count = length - offset; - } else { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if (count > (length - offset)) { - goto done; - } - } - src = buffer + offset; - size = count; + src = buffer + offset; + size = count; - /* - * Trim trailing nulls and spaces, if necessary. - */ + /* + * Trim trailing nulls and spaces, if necessary. + */ - if (cmd == 'A') { - while (size > 0) { - if (src[size-1] != '\0' && src[size-1] != ' ') { - break; - } - size--; - } - } - valuePtr = Tcl_NewByteArrayObj(src, size); - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], - NULL, valuePtr, TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - Tcl_DecrRefCount(valuePtr); /* unneeded */ - return TCL_ERROR; + if (cmd == 'A') { + while (size > 0) { + if (src[size-1] != '\0' && src[size-1] != ' ') { + break; } - offset += count; - break; + size--; } - case 'b': - case 'B': { - unsigned char *src; - char *dest; - - if (arg >= objc) { - DeleteScanNumberCache(numberCachePtr); - goto badIndex; - } - if (count == BINARY_ALL) { - count = (length - offset) * 8; - } else { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if (count > (length - offset) * 8) { - goto done; - } - } - src = buffer + offset; - valuePtr = Tcl_NewObj(); - Tcl_SetObjLength(valuePtr, count); - dest = Tcl_GetString(valuePtr); - - if (cmd == 'b') { - for (i = 0; i < count; i++) { - if (i % 8) { - value >>= 1; - } else { - value = *src++; - } - *dest++ = (char) ((value & 1) ? '1' : '0'); - } - } else { - for (i = 0; i < count; i++) { - if (i % 8) { - value <<= 1; - } else { - value = *src++; - } - *dest++ = (char) ((value & 0x80) ? '1' : '0'); - } - } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], - NULL, valuePtr, TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - Tcl_DecrRefCount(valuePtr); /* unneeded */ - return TCL_ERROR; - } - offset += (count + 7 ) / 8; - break; + } + + /* + * Have to do this #ifdef-fery because (as part of defining + * Tcl_NewByteArrayObj) we removed the #def that hides this + * stuff normally. If this code ever gets copied to another + * file, it should be changed back to the simpler version. + */ + +#ifdef TCL_MEM_DEBUG + valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__); +#else + valuePtr = Tcl_NewByteArrayObj(src, size); +#endif /* TCL_MEM_DEBUG */ + + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, + TCL_LEAVE_ERR_MSG); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + Tcl_DecrRefCount(valuePtr); /* unneeded */ + return TCL_ERROR; + } + offset += count; + break; + } + case 'b': + case 'B': { + unsigned char *src; + char *dest; + + if (arg >= objc) { + DeleteScanNumberCache(numberCachePtr); + goto badIndex; + } + if (count == BINARY_ALL) { + count = (length - offset) * 8; + } else { + if (count == BINARY_NOCOUNT) { + count = 1; } - case 'h': - case 'H': { - char *dest; - unsigned char *src; - int i; - static char hexdigit[] = "0123456789abcdef"; - - if (arg >= objc) { - DeleteScanNumberCache(numberCachePtr); - goto badIndex; - } - if (count == BINARY_ALL) { - count = (length - offset)*2; + if (count > (length - offset) * 8) { + goto done; + } + } + src = buffer + offset; + valuePtr = Tcl_NewObj(); + Tcl_SetObjLength(valuePtr, count); + dest = Tcl_GetString(valuePtr); + + if (cmd == 'b') { + for (i = 0; i < count; i++) { + if (i % 8) { + value >>= 1; } else { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if (count > (length - offset)*2) { - goto done; - } + value = *src++; } - src = buffer + offset; - valuePtr = Tcl_NewObj(); - Tcl_SetObjLength(valuePtr, count); - dest = Tcl_GetString(valuePtr); - - if (cmd == 'h') { - for (i = 0; i < count; i++) { - if (i % 2) { - value >>= 4; - } else { - value = *src++; - } - *dest++ = hexdigit[value & 0xf]; - } + *dest++ = (char) ((value & 1) ? '1' : '0'); + } + } else { + for (i = 0; i < count; i++) { + if (i % 8) { + value <<= 1; } else { - for (i = 0; i < count; i++) { - if (i % 2) { - value <<= 4; - } else { - value = *src++; - } - *dest++ = hexdigit[(value >> 4) & 0xf]; - } + value = *src++; } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], - NULL, valuePtr, TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - Tcl_DecrRefCount(valuePtr); /* unneeded */ - return TCL_ERROR; - } - offset += (count + 1) / 2; - break; - } - case 'c': { - size = 1; - goto scanNumber; - } - case 't': - case 's': - case 'S': { - size = 2; - goto scanNumber; + *dest++ = (char) ((value & 0x80) ? '1' : '0'); } - case 'n': - case 'i': - case 'I': { - size = 4; - goto scanNumber; - } - case 'm': - case 'w': - case 'W': { - size = 8; - goto scanNumber; + } + + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, + TCL_LEAVE_ERR_MSG); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + Tcl_DecrRefCount(valuePtr); /* unneeded */ + return TCL_ERROR; + } + offset += (count + 7 ) / 8; + break; + } + case 'h': + case 'H': { + char *dest; + unsigned char *src; + int i; + static char hexdigit[] = "0123456789abcdef"; + + if (arg >= objc) { + DeleteScanNumberCache(numberCachePtr); + goto badIndex; + } + if (count == BINARY_ALL) { + count = (length - offset)*2; + } else { + if (count == BINARY_NOCOUNT) { + count = 1; } - case 'r': - case 'R': - case 'f': { - size = sizeof(float); - goto scanNumber; + if (count > (length - offset)*2) { + goto done; } - case 'q': - case 'Q': - case 'd': { - unsigned char *src; - - size = sizeof(double); - /* fall through */ - - scanNumber: - if (arg >= objc) { - DeleteScanNumberCache(numberCachePtr); - goto badIndex; - } - if (count == BINARY_NOCOUNT) { - if ((length - offset) < size) { - goto done; - } - valuePtr = ScanNumber(buffer+offset, cmd, - &numberCachePtr); - offset += size; + } + src = buffer + offset; + valuePtr = Tcl_NewObj(); + Tcl_SetObjLength(valuePtr, count); + dest = Tcl_GetString(valuePtr); + + if (cmd == 'h') { + for (i = 0; i < count; i++) { + if (i % 2) { + value >>= 4; } else { - if (count == BINARY_ALL) { - count = (length - offset) / size; - } - if ((length - offset) < (count * size)) { - goto done; - } - valuePtr = Tcl_NewObj(); - src = buffer+offset; - for (i = 0; i < count; i++) { - elementPtr = ScanNumber(src, cmd, - &numberCachePtr); - src += size; - Tcl_ListObjAppendElement(NULL, valuePtr, - elementPtr); - } - offset += count*size; - } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], - NULL, valuePtr, TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - Tcl_DecrRefCount(valuePtr); /* unneeded */ - return TCL_ERROR; + value = *src++; } - break; + *dest++ = hexdigit[value & 0xf]; } - case 'x': { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if ((count == BINARY_ALL) - || (count > (length - offset))) { - offset = length; + } else { + for (i = 0; i < count; i++) { + if (i % 2) { + value <<= 4; } else { - offset += count; + value = *src++; } - break; + *dest++ = hexdigit[(value >> 4) & 0xf]; } - case 'X': { - if (count == BINARY_NOCOUNT) { - count = 1; - } - if ((count == BINARY_ALL) || (count > offset)) { - offset = 0; - } else { - offset -= count; - } - break; + } + + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, + TCL_LEAVE_ERR_MSG); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + Tcl_DecrRefCount(valuePtr); /* unneeded */ + return TCL_ERROR; + } + offset += (count + 1) / 2; + break; + } + case 'c': + size = 1; + goto scanNumber; + case 't': + case 's': + case 'S': + size = 2; + goto scanNumber; + case 'n': + case 'i': + case 'I': + size = 4; + goto scanNumber; + case 'm': + case 'w': + case 'W': + size = 8; + goto scanNumber; + case 'r': + case 'R': + case 'f': + size = sizeof(float); + goto scanNumber; + case 'q': + case 'Q': + case 'd': { + unsigned char *src; + + size = sizeof(double); + /* fall through */ + + scanNumber: + if (arg >= objc) { + DeleteScanNumberCache(numberCachePtr); + goto badIndex; + } + if (count == BINARY_NOCOUNT) { + if ((length - offset) < size) { + goto done; } - case '@': { - if (count == BINARY_NOCOUNT) { - DeleteScanNumberCache(numberCachePtr); - goto badCount; - } - if ((count == BINARY_ALL) || (count > length)) { - offset = length; - } else { - offset = count; - } - break; + valuePtr = ScanNumber(buffer+offset, cmd, &numberCachePtr); + offset += size; + } else { + if (count == BINARY_ALL) { + count = (length - offset) / size; + } + if ((length - offset) < (count * size)) { + goto done; } - default: { - DeleteScanNumberCache(numberCachePtr); - errorString = str; - goto badField; + valuePtr = Tcl_NewObj(); + src = buffer+offset; + for (i = 0; i < count; i++) { + elementPtr = ScanNumber(src, cmd, &numberCachePtr); + src += size; + Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); } + offset += count*size; } + + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, + TCL_LEAVE_ERR_MSG); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + Tcl_DecrRefCount(valuePtr); /* unneeded */ + return TCL_ERROR; + } + break; + } + case 'x': + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count == BINARY_ALL) || (count > (length - offset))) { + offset = length; + } else { + offset += count; + } + break; + case 'X': + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count == BINARY_ALL) || (count > offset)) { + offset = 0; + } else { + offset -= count; + } + break; + case '@': + if (count == BINARY_NOCOUNT) { + DeleteScanNumberCache(numberCachePtr); + goto badCount; + } + if ((count == BINARY_ALL) || (count > length)) { + offset = length; + } else { + offset = count; + } + break; + default: + DeleteScanNumberCache(numberCachePtr); + errorString = str; + goto badField; } + } - /* - * Set the result to the last position of the cursor. - */ + /* + * Set the result to the last position of the cursor. + */ - done: - Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4)); - DeleteScanNumberCache(numberCachePtr); - break; - } + done: + Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4)); + DeleteScanNumberCache(numberCachePtr); + break; + } } return TCL_OK; - badValue: + badValue: Tcl_ResetResult(interp); Tcl_AppendResult(interp, "expected ", errorString, " string but got \"", errorValue, "\" instead", NULL); return TCL_ERROR; - badCount: + badCount: errorString = "missing count for \"@\" field specifier"; goto error; - badIndex: + badIndex: errorString = "not enough arguments for all format specifiers"; goto error; - badField: + badField: { Tcl_UniChar ch; char buf[TCL_UTF_MAX + 1]; @@ -1371,7 +1348,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - error: + error: Tcl_AppendResult(interp, errorString, NULL); return TCL_ERROR; } @@ -1381,15 +1358,15 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv) * * GetFormatSpec -- * - * This function parses the format strings used in the binary - * format and scan commands. + * This function parses the format strings used in the binary format and + * scan commands. * * Results: - * Moves the formatPtr to the start of the next command. Returns - * the current command character and count in cmdPtr and countPtr. - * The count is set to BINARY_ALL if the count character was '*' - * or BINARY_NOCOUNT if no count was specified. Returns 1 on - * success, or 0 if the string did not have a format specifier. + * Moves the formatPtr to the start of the next command. Returns the + * current command character and count in cmdPtr and countPtr. The count + * is set to BINARY_ALL if the count character was '*' or BINARY_NOCOUNT + * if no count was specified. Returns 1 on success, or 0 if the string + * did not have a format specifier. * * Side effects: * None. @@ -1441,26 +1418,25 @@ GetFormatSpec(formatPtr, cmdPtr, countPtr) * * NeedReversing -- * - * This routine determines, if bytes of a number need to be - * reversed. This depends on the endiannes of the machine and - * the desired format. It is in effect a table (whose contents - * depend on the endianness of the system) describing whether a - * value needs reversing or not. Anyone porting the code to a - * big-endian platform should take care to make sure that they - * define WORDS_BIGENDIAN though this is already done by - * configure for the Unix build; little-endian platforms - * (including Windows) don't need to do anything. + * This routine determines, if bytes of a number need to be reversed. + * This depends on the endiannes of the machine and the desired format. + * It is in effect a table (whose contents depend on the endianness of + * the system) describing whether a value needs reversing or not. Anyone + * porting the code to a big-endian platform should take care to make + * sure that they define WORDS_BIGENDIAN though this is already done by + * configure for the Unix build; little-endian platforms (including + * Windows) don't need to do anything. * * Results: * 1 if reversion is required, 0 if not. * * Side effects: * None - * + * *---------------------------------------------------------------------- */ -static int +static int NeedReversing(format) int format; { @@ -1516,11 +1492,10 @@ NeedReversing(format) * * CopyNumber -- * - * This routine is called by FormatNumber and ScanNumber to copy - * a floating-point number. If required, bytes are reversed - * while copying. The behaviour is only fully defined when used - * with IEEE float and double values (guaranteed to be 4 and 8 - * bytes long, respectively.) + * This routine is called by FormatNumber and ScanNumber to copy a + * floating-point number. If required, bytes are reversed while copying. + * The behaviour is only fully defined when used with IEEE float and + * double values (guaranteed to be 4 and 8 bytes long, respectively.) * * Results: * None @@ -1531,7 +1506,7 @@ NeedReversing(format) *---------------------------------------------------------------------- */ -static void +static void CopyNumber(from, to, length, type) CONST void *from; /* source */ void *to; /* destination */ @@ -1561,7 +1536,7 @@ CopyNumber(from, to, length, type) break; } } else { - memcpy(to, from, length); + memcpy(to, from, length); } } @@ -1570,11 +1545,11 @@ CopyNumber(from, to, length, type) * * FormatNumber -- * - * This routine is called by Tcl_BinaryObjCmd to format a number - * into a location pointed at by cursor. + * This routine is called by Tcl_BinaryObjCmd to format a number into a + * location pointed at by cursor. * * Results: - * A standard Tcl result. + * A standard Tcl result. * * Side effects: * Moves the cursor to the next location to be written into. @@ -1600,9 +1575,9 @@ FormatNumber(interp, type, src, cursorPtr) case 'q': case 'Q': /* - * Double-precision floating point values. - * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but - * we can check by comparing the object's type pointer. + * Double-precision floating point values. Tcl_GetDoubleFromObj + * returns TCL_ERROR for NaN, but we can check by comparing the + * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { @@ -1619,9 +1594,9 @@ FormatNumber(interp, type, src, cursorPtr) case 'r': case 'R': /* - * Single-precision floating point values. - * Tcl_GetDoubleFromObj returns TCL_ERROR for NaN, but - * we can check by comparing the object's type pointer. + * Single-precision floating point values. Tcl_GetDoubleFromObj + * returns TCL_ERROR for NaN, but we can check by comparing the + * object's type pointer. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { @@ -1632,9 +1607,9 @@ FormatNumber(interp, type, src, cursorPtr) } /* - * Because some compilers will generate floating point exceptions - * on an overflow cast (e.g. Borland), we restrict the values - * to the valid range for float. + * Because some compilers will generate floating point exceptions on + * an overflow cast (e.g. Borland), we restrict the values to the + * valid range for float. */ if (fabs(dvalue) > (double)FLT_MAX) { @@ -1725,7 +1700,7 @@ FormatNumber(interp, type, src, cursorPtr) } *(*cursorPtr)++ = (unsigned char) value; return TCL_OK; - + default: Tcl_Panic("unexpected fallthrough"); return TCL_ERROR; @@ -1777,10 +1752,10 @@ ScanNumber(buffer, type, numberCachePtrPtr) 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. + * 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]; @@ -1790,8 +1765,8 @@ ScanNumber(buffer, type, numberCachePtrPtr) goto returnNumericObject; /* - * 16-bit numeric values. We need the sign extension trick - * (see above) here as well. + * 16-bit numeric values. We need the sign extension trick (see + * above) here as well. */ case 's': @@ -1815,7 +1790,7 @@ ScanNumber(buffer, type, numberCachePtrPtr) case 'I': case 'n': if (NeedReversing(type)) { - value = (long) (buffer[0] + value = (long) (buffer[0] + (buffer[1] << 8) + (buffer[2] << 16) + (buffer[3] << 24)); @@ -1827,8 +1802,8 @@ ScanNumber(buffer, type, numberCachePtrPtr) } /* - * Check to see if the value was sign extended properly on - * systems where an int is more than 32-bits. + * Check to see if the value was sign extended properly on systems + * where an int is more than 32-bits. */ if ((value & (((unsigned int)1)<<31)) && (value > 0)) { @@ -1852,13 +1827,12 @@ ScanNumber(buffer, type, numberCachePtrPtr) if (tablePtr->numEntries > BINARY_SCAN_MAX_CACHE) { /* - * We've overflowed the cache! Someone's parsing a - * LOT of varied binary data in a single call! Bail - * out by switching back to the old behaviour for the - * rest of the scan. + * We've overflowed the cache! Someone's parsing a LOT of + * varied binary data in a single call! Bail out by switching + * back to the old behaviour for the rest of the scan. * - * Note that anyone just using the 'c' conversion (for - * bytes) cannot trigger this. + * Note that anyone just using the 'c' conversion (for bytes) + * cannot trigger this. */ DeleteScanNumberCache(tablePtr); @@ -1874,8 +1848,8 @@ ScanNumber(buffer, type, numberCachePtrPtr) } /* - * Do not cache wide (64-bit) values; they are already too - * large to use as keys. + * Do not cache wide (64-bit) values; they are already too large to + * use as keys. */ case 'w': @@ -1903,9 +1877,9 @@ ScanNumber(buffer, type, numberCachePtrPtr) return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); /* - * Do not cache double values; they are already too large to - * use as keys and the values stored are utterly incompatible - * with the integer part of the cache. + * Do not cache double values; they are already too large to use as + * keys and the values stored are utterly incompatible with the + * integer part of the cache. */ /* @@ -1935,7 +1909,7 @@ ScanNumber(buffer, type, numberCachePtrPtr) *---------------------------------------------------------------------- * * DeleteScanNumberCache -- - * + * * Deletes the hash table acting as a scan number cache. * * Results: @@ -1949,9 +1923,9 @@ ScanNumber(buffer, type, numberCachePtrPtr) static void DeleteScanNumberCache(numberCachePtr) - Tcl_HashTable *numberCachePtr; /* Pointer to the hash table, or - * NULL (when the cache has already - * been deleted due to overflow.) */ + Tcl_HashTable *numberCachePtr; /* Pointer to the hash table, or NULL + * (when the cache has already been + * deleted due to overflow.) */ { Tcl_HashEntry *hEntry; Tcl_HashSearch search; @@ -1971,3 +1945,11 @@ DeleteScanNumberCache(numberCachePtr) } Tcl_DeleteHashTable(numberCachePtr); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |