diff options
Diffstat (limited to 'generic/tclBinary.c')
| -rw-r--r-- | generic/tclBinary.c | 2356 |
1 files changed, 1035 insertions, 1321 deletions
diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 9ba06ee..8eb3ac3 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 @@ -7,13 +7,12 @@ * Copyright (c) 1997 by Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution of - * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" -#include "tommath.h" - +#include "tclPort.h" #include <math.h> /* @@ -25,27 +24,21 @@ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* - * The following flags may be ORed together and returned by GetFormatSpec - */ - -#define BINARY_SIGNED 0 /* Field to be read as signed data */ -#define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */ - -/* - * 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 @@ -54,46 +47,46 @@ * Prototypes for local procedures defined in this file: */ -static void DupByteArrayInternalRep(Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr); -static int FormatNumber(Tcl_Interp *interp, int type, - Tcl_Obj *src, unsigned char **cursorPtr); -static void FreeByteArrayInternalRep(Tcl_Obj *objPtr); -static int GetFormatSpec(char **formatPtr, char *cmdPtr, - int *countPtr, int *flagsPtr); -static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, - int flags, Tcl_HashTable **numberCachePtr); -static int SetByteArrayFromAny(Tcl_Interp *interp, - Tcl_Obj *objPtr); -static void UpdateStringOfByteArray(Tcl_Obj *listPtr); -static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); -static int NeedReversing(int format); -static void CopyNumber(const void *from, void *to, - unsigned int length, int type); +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 CopyNumber _ANSI_ARGS_((CONST VOID *from, VOID *to, + unsigned int length)); +static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); +static int GetFormatSpec _ANSI_ARGS_((char **formatPtr, + char *cmdPtr, int *countPtr)); +static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned char *buffer, + int type, Tcl_HashTable **numberCachePtr)); +static int SetByteArrayFromAny _ANSI_ARGS_((Tcl_Interp *interp, + Tcl_Obj *objPtr)); +static void UpdateStringOfByteArray _ANSI_ARGS_((Tcl_Obj *listPtr)); +static void DeleteScanNumberCache _ANSI_ARGS_(( + Tcl_HashTable *numberCachePtr)); /* - * 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 + * 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. + * 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. + * 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 = { @@ -105,10 +98,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 { @@ -116,12 +109,12 @@ typedef struct ByteArray { * 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 + 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) \ +#define BYTEARRAY_SIZE(len) \ ((unsigned) (sizeof(ByteArray) - 4 + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.otherValuePtr) @@ -130,32 +123,34 @@ 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. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewByteArrayObj + Tcl_Obj * -Tcl_NewByteArrayObj( - 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_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. */ { return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0); } @@ -163,11 +158,11 @@ Tcl_NewByteArrayObj( #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * -Tcl_NewByteArrayObj( - 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_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. */ { Tcl_Obj *objPtr; @@ -178,7 +173,7 @@ Tcl_NewByteArrayObj( #endif /* TCL_MEM_DEBUG */ /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * Tcl_DbNewByteArrayObj -- * @@ -193,27 +188,28 @@ Tcl_NewByteArrayObj( * 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. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG Tcl_Obj * -Tcl_DbNewByteArrayObj( - 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 +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 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,15 +221,15 @@ Tcl_DbNewByteArrayObj( #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * -Tcl_DbNewByteArrayObj( - 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 +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 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); } @@ -251,38 +247,37 @@ Tcl_DbNewByteArrayObj( * 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. * *---------------------------------------------------------------------- */ void -Tcl_SetByteArrayObj( - Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ - const unsigned char *bytes, /* The array of bytes to use as the new +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. */ { + Tcl_ObjType *typePtr; ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); + panic("Tcl_SetByteArrayObj called with shared object"); + } + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); } - TclFreeIntRep(objPtr); Tcl_InvalidateStringRep(objPtr); - if (length < 0) { - length = 0; - } byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; + memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length); - if ((bytes != NULL) && (length > 0)) { - memcpy(byteArrayPtr->bytes, bytes, (size_t) length); - } objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } @@ -292,30 +287,28 @@ Tcl_SetByteArrayObj( * * 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. * * Side effects: - * Frees old internal rep. Allocates memory for new internal rep. + * Frees old internal rep. Allocates memory for new internal rep. * *---------------------------------------------------------------------- */ unsigned char * -Tcl_GetByteArrayFromObj( - Tcl_Obj *objPtr, /* The ByteArray object. */ - int *lengthPtr) /* If non-NULL, filled with length of the +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; - - if (objPtr->typePtr != &tclByteArrayType) { - SetByteArrayFromAny(NULL, objPtr); - } + + SetByteArrayFromAny(NULL, objPtr); baPtr = GET_BYTEARRAY(objPtr); if (lengthPtr != NULL) { @@ -329,32 +322,32 @@ Tcl_GetByteArrayFromObj( * * 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. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ unsigned char * -Tcl_SetByteArrayLength( - Tcl_Obj *objPtr, /* The ByteArray object. */ - int length) /* New length for internal byte array. */ +Tcl_SetByteArrayLength(objPtr, length) + Tcl_Obj *objPtr; /* The ByteArray object. */ + int length; /* New length for internal byte array. */ { - ByteArray *byteArrayPtr; - + ByteArray *byteArrayPtr, *newByteArrayPtr; + if (Tcl_IsShared(objPtr)) { - Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); + panic("Tcl_SetObjLength called with shared object"); } if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); @@ -362,9 +355,13 @@ Tcl_SetByteArrayLength( byteArrayPtr = GET_BYTEARRAY(objPtr); if (length > byteArrayPtr->allocated) { - byteArrayPtr = (ByteArray *) ckrealloc( - (char *) byteArrayPtr, BYTEARRAY_SIZE(length)); - byteArrayPtr->allocated = length; + 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); @@ -373,7 +370,7 @@ Tcl_SetByteArrayLength( } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * SetByteArrayFromAny -- * @@ -385,22 +382,24 @@ Tcl_SetByteArrayLength( * Side effects: * A ByteArray object is stored as the internal rep of objPtr. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ static int -SetByteArrayFromAny( - Tcl_Interp *interp, /* Not used. */ - Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ +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; - - if (objPtr->typePtr != &tclByteArrayType) { - src = TclGetStringFromObj(objPtr, &length); + + typePtr = objPtr->typePtr; + if (typePtr != &tclByteArrayType) { + src = Tcl_GetStringFromObj(objPtr, &length); srcEnd = src + length; byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); @@ -412,7 +411,9 @@ SetByteArrayFromAny( byteArrayPtr->used = dst - byteArrayPtr->bytes; byteArrayPtr->allocated = length; - TclFreeIntRep(objPtr); + if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) { + (*typePtr->freeIntRepProc)(objPtr); + } objPtr->typePtr = &tclByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } @@ -431,26 +432,26 @@ SetByteArrayFromAny( * None. * * Side effects: - * Frees memory. + * Frees memory. * *---------------------------------------------------------------------- */ static void -FreeByteArrayInternalRep( - Tcl_Obj *objPtr) /* Object with internal rep to free. */ +FreeByteArrayInternalRep(objPtr) + Tcl_Obj *objPtr; /* Object with internal rep to free. */ { ckfree((char *) GET_BYTEARRAY(objPtr)); - objPtr->typePtr = NULL; } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * 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. @@ -458,16 +459,16 @@ FreeByteArrayInternalRep( * Side effects: * Allocates memory. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ static void -DupByteArrayInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ +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; + ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); length = srcArrayPtr->used; @@ -475,37 +476,38 @@ DupByteArrayInternalRep( copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; - memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); + memcpy((VOID *) copyArrayPtr->bytes, (VOID *) srcArrayPtr->bytes, + (size_t) length); SET_BYTEARRAY(copyPtr, copyArrayPtr); copyPtr->typePtr = &tclByteArrayType; } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * * 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. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ static void -UpdateStringOfByteArray( - Tcl_Obj *objPtr) /* ByteArray object whose string rep to +UpdateStringOfByteArray(objPtr) + Tcl_Obj *objPtr; /* ByteArray object whose string rep to * update. */ { int i, length, size; @@ -520,23 +522,20 @@ UpdateStringOfByteArray( /* * How much space will string rep need? */ - + size = length; - for (i = 0; i < length && size >= 0; i++) { + for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } dst = (char *) ckalloc((unsigned) (size + 1)); objPtr->bytes = dst; objPtr->length = size; if (size == length) { - memcpy(dst, src, (size_t) size); + memcpy((VOID *) dst, (VOID *) src, (size_t) size); dst[size] = '\0'; } else { for (i = 0; i < length; i++) { @@ -563,11 +562,11 @@ UpdateStringOfByteArray( */ int -Tcl_BinaryObjCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ +Tcl_BinaryObjCmd(dummy, interp, objc, objv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. @@ -575,21 +574,19 @@ Tcl_BinaryObjCmd( char cmd; /* Current format character. */ int count; /* Count associated with current format * character. */ - int flags; /* Format field flags */ char *format; /* Pointer to current position in format * string. */ - Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ + 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.*/ - const char *errorString; - char *errorValue, *str; + 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 }; @@ -604,765 +601,760 @@ Tcl_BinaryObjCmd( } 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. - */ + /* + * 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 = TclGetString(objv[2]); - arg = 3; - offset = 0; - length = 0; - while (*format != '\0') { - str = format; - flags = 0; - if (!GetFormatSpec(&format, &cmd, &count, &flags)) { - 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. - */ - - if (arg >= objc) { - goto badIndex; + format = Tcl_GetString(objv[2]); + arg = 3; + offset = 0; + length = 0; + while (*format != '\0') { + str = format; + if (!GetFormatSpec(&format, &cmd, &count)) { + break; } - 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. - */ + 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 's': + case 'S': { + size = 2; + goto doNumbers; + } + case 'i': + case 'I': { + size = 4; + goto doNumbers; + } + case 'w': + case 'W': { + size = 8; + goto doNumbers; + } + case 'f': { + size = sizeof(float); + goto doNumbers; + } + case 'd': { + size = sizeof(double); + + doNumbers: + if (arg >= objc) { + goto badIndex; + } - if (count == BINARY_NOCOUNT) { - arg++; - count = 1; - } else { - int listc; - Tcl_Obj **listv; + /* + * 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. + */ - /* The macro evals its args more than once: avoid arg++ */ - if (TclListObjGetElements(interp, objv[arg], &listc, - &listv) != TCL_OK) { - return TCL_ERROR; + 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; } - arg++; - - if (count == BINARY_ALL) { - count = listc; - } else if (count > listc) { - Tcl_AppendResult(interp, - "number of elements in list does not match count", - NULL); - return TCL_ERROR; + 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; } } - offset += count*size; - break; - - case 'x': - if (count == BINARY_ALL) { - Tcl_AppendResult(interp, - "cannot use \"*\" in format string with \"x\"", - 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; - } + 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. - */ + /* + * Prepare the result object by preallocating the caclulated + * number of bytes and filling with nulls. + */ - resultPtr = Tcl_NewObj(); - buffer = Tcl_SetByteArrayLength(resultPtr, length); - memset(buffer, 0, (size_t) length); + resultPtr = Tcl_GetObjResult(interp); + if (Tcl_IsShared(resultPtr)) { + TclNewObj(resultPtr); + Tcl_SetObjResult(interp, resultPtr); + } + 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. - */ + /* + * 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 = TclGetString(objv[2]); - cursor = buffer; - maxPos = cursor; - while (*format != 0) { - flags = 0; - if (!GetFormatSpec(&format, &cmd, &count, &flags)) { - break; - } - if ((count == 0) && (cmd != '@')) { - if (cmd != 'x') { - arg++; - } - continue; - } - 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(cursor, bytes, (size_t) count); - } else { - memcpy(cursor, bytes, (size_t) length); - memset(cursor + length, pad, (size_t) (count - length)); + arg = 3; + format = Tcl_GetString(objv[2]); + cursor = buffer; + maxPos = cursor; + while (*format != 0) { + if (!GetFormatSpec(&format, &cmd, &count)) { + break; } - cursor += count; - break; - } - case 'b': - case 'B': { - unsigned char *last; - - str = TclGetStringFromObj(objv[arg], &length); - arg++; - if (count == BINARY_ALL) { - count = length; - } else if (count == BINARY_NOCOUNT) { - count = 1; - } - last = cursor + ((count + 7) / 8); - if (count > length) { - count = length; + if ((count == 0) && (cmd != '@')) { + if (cmd != 'x') { + arg++; + } + continue; } - 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; - Tcl_DecrRefCount(resultPtr); - goto badValue; + 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 (((offset + 1) % 8) == 0) { - *cursor++ = (unsigned char) value; - value = 0; + 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; } - } else { - for (offset = 0; offset < count; offset++) { - value >>= 1; - if (str[offset] == '1') { - value |= 128; - } else if (str[offset] != '0') { - errorValue = str; - Tcl_DecrRefCount(resultPtr); - goto badValue; + 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 (!((offset + 1) % 8)) { + last = cursor + ((count + 7) / 8); + if (count > length) { + count = length; + } + 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); + } *cursor++ = (unsigned char) value; - value = 0; } + while (cursor < last) { + *cursor++ = '\0'; + } + break; } - } - 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 = TclGetStringFromObj(objv[arg], &length); - arg++; - 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; - Tcl_DecrRefCount(resultPtr); - goto badValue; + 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; } - c = str[offset] - '0'; - if (c > 9) { - c += ('0' - 'A') + 10; + last = cursor + ((count + 1) / 2); + if (count > length) { + count = length; } - if (c > 16) { - c += ('A' - 'a'); + 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; + } + } } - value |= (c & 0xf); if (offset % 2) { - *cursor++ = (char) value; - value = 0; + if (cmd == 'H') { + value <<= 4; + } else { + value >>= 4; + } + *cursor++ = (unsigned char) value; } - } - } else { - for (offset = 0; offset < count; offset++) { - value >>= 4; - if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */ - errorValue = str; - Tcl_DecrRefCount(resultPtr); - goto badValue; + while (cursor < last) { + *cursor++ = '\0'; } - c = str[offset] - '0'; - if (c > 9) { - c += ('0' - 'A') + 10; + break; + } + case 'c': + case 's': + case 'S': + case 'i': + case 'I': + case 'w': + case 'W': + case 'd': + 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; + } } - if (c > 16) { - c += ('A' - 'a'); - } - value |= ((c << 4) & 0xf0); - if (offset % 2) { - *cursor++ = (unsigned char)(value & 0xff); - value = 0; + arg++; + for (i = 0; i < count; i++) { + if (FormatNumber(interp, cmd, listv[i], &cursor) + != TCL_OK) { + return TCL_ERROR; + } } + break; } - } - if (offset % 2) { - if (cmd == 'H') { - value <<= 4; - } else { - value >>= 4; + case 'x': { + if (count == BINARY_NOCOUNT) { + count = 1; + } + memset(cursor, 0, (size_t) count); + cursor += 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 { - TclListObjGetElements(interp, objv[arg], &listc, &listv); - if (count == BINARY_ALL) { - count = listc; + 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; } - } - arg++; - for (i = 0; i < count; i++) { - if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { - Tcl_DecrRefCount(resultPtr); - return TCL_ERROR; + case '@': { + if (cursor > maxPos) { + maxPos = cursor; + } + if (count == BINARY_ALL) { + cursor = maxPos; + } else { + cursor = buffer + count; + } + break; } } - 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; + break; } - numberCachePtr = &numberCacheHash; - Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS); - buffer = Tcl_GetByteArrayFromObj(objv[2], &length); - format = TclGetString(objv[3]); - cursor = buffer; - arg = 4; - offset = 0; - while (*format != '\0') { - str = format; - flags = 0; - if (!GetFormatSpec(&format, &cmd, &count, &flags)) { - goto done; + 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; } - 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; - } + 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; + } + } - 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; + if (cmd == 'A') { + while (size > 0) { + if (src[size-1] != '\0' && src[size-1] != ' ') { + break; + } + size--; + } } - size--; + valuePtr = Tcl_NewByteArrayObj(src, size); + Tcl_IncrRefCount(valuePtr); + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], + NULL, valuePtr, TCL_LEAVE_ERR_MSG); + Tcl_DecrRefCount(valuePtr); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + return TCL_ERROR; + } + offset += count; + 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 */ + 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); - 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; - } - if (count > (length - offset) * 8) { - goto done; + Tcl_IncrRefCount(valuePtr); + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], + NULL, valuePtr, TCL_LEAVE_ERR_MSG); + Tcl_DecrRefCount(valuePtr); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + return TCL_ERROR; + } + offset += (count + 7 ) / 8; + break; } - } - src = buffer + offset; - valuePtr = Tcl_NewObj(); - Tcl_SetObjLength(valuePtr, count); - dest = TclGetString(valuePtr); - - if (cmd == 'b') { - for (i = 0; i < count; i++) { - if (i % 8) { - value >>= 1; + case 'h': + case 'H': { + char *dest; + unsigned char *src; + int i; + static CONST char hexdigit[] = "0123456789abcdef"; + + if (arg >= objc) { + DeleteScanNumberCache(numberCachePtr); + goto badIndex; + } + if (count == BINARY_ALL) { + count = (length - offset)*2; } else { - value = *src++; + if (count == BINARY_NOCOUNT) { + count = 1; + } + if (count > (length - offset)*2) { + goto done; + } } - *dest++ = (char) ((value & 1) ? '1' : '0'); - } - } else { - for (i = 0; i < count; i++) { - if (i % 8) { - value <<= 1; + 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]; + } } else { - value = *src++; + for (i = 0; i < count; i++) { + if (i % 2) { + value <<= 4; + } else { + value = *src++; + } + *dest++ = hexdigit[(value >> 4) & 0xf]; + } + } + + Tcl_IncrRefCount(valuePtr); + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], + NULL, valuePtr, TCL_LEAVE_ERR_MSG); + Tcl_DecrRefCount(valuePtr); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + return TCL_ERROR; } - *dest++ = (char) ((value & 0x80) ? '1' : '0'); + offset += (count + 1) / 2; + break; } - } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, - TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - return TCL_ERROR; - } - offset += (count + 7) / 8; - break; - } - case 'h': - case 'H': { - char *dest; - unsigned char *src; - int i; - static const 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 'c': { + size = 1; + goto scanNumber; } - if (count > (length - offset)*2) { - goto done; + case 's': + case 'S': { + size = 2; + goto scanNumber; } - } - src = buffer + offset; - valuePtr = Tcl_NewObj(); - Tcl_SetObjLength(valuePtr, count); - dest = TclGetString(valuePtr); - - if (cmd == 'h') { - for (i = 0; i < count; i++) { - if (i % 2) { - value >>= 4; + case 'i': + case 'I': { + size = 4; + goto scanNumber; + } + case 'w': + case 'W': { + size = 8; + goto scanNumber; + } + case 'f': { + size = sizeof(float); + goto scanNumber; + } + 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; } else { - value = *src++; + 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; } - *dest++ = hexdigit[value & 0xf]; + + Tcl_IncrRefCount(valuePtr); + resultPtr = Tcl_ObjSetVar2(interp, objv[arg], + NULL, valuePtr, TCL_LEAVE_ERR_MSG); + Tcl_DecrRefCount(valuePtr); + arg++; + if (resultPtr == NULL) { + DeleteScanNumberCache(numberCachePtr); + return TCL_ERROR; + } + break; } - } else { - for (i = 0; i < count; i++) { - if (i % 2) { - value <<= 4; + case 'x': { + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count == BINARY_ALL) + || (count > (length - offset))) { + offset = length; } else { - value = *src++; + offset += count; } - *dest++ = hexdigit[(value >> 4) & 0xf]; + break; } - } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, - TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - 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; - } - valuePtr = ScanNumber(buffer+offset, cmd, flags, - &numberCachePtr); - offset += size; - } else { - if (count == BINARY_ALL) { - count = (length - offset) / size; + case 'X': { + if (count == BINARY_NOCOUNT) { + count = 1; + } + if ((count == BINARY_ALL) || (count > offset)) { + offset = 0; + } else { + offset -= count; + } + break; } - if ((length - offset) < (count * 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 = Tcl_NewObj(); - src = buffer+offset; - for (i = 0; i < count; i++) { - elementPtr = ScanNumber(src, cmd, flags, - &numberCachePtr); - src += size; - Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr); + default: { + DeleteScanNumberCache(numberCachePtr); + errorString = str; + goto badField; } - offset += count*size; } - - resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr, - TCL_LEAVE_ERR_MSG); - arg++; - if (resultPtr == NULL) { - DeleteScanNumberCache(numberCachePtr); - 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_ResetResult(interp); + Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4); + DeleteScanNumberCache(numberCachePtr); + break; + } } return TCL_OK; - badValue: + badValue: Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "expected ", errorString, + Tcl_AppendStringsToObj(Tcl_GetObjResult(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]; @@ -1373,7 +1365,7 @@ Tcl_BinaryObjCmd( return TCL_ERROR; } - error: + error: Tcl_AppendResult(interp, errorString, NULL); return TCL_ERROR; } @@ -1383,15 +1375,15 @@ Tcl_BinaryObjCmd( * * 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. @@ -1400,11 +1392,10 @@ Tcl_BinaryObjCmd( */ static int -GetFormatSpec( - char **formatPtr, /* Pointer to format string. */ - char *cmdPtr, /* Pointer to location of command char. */ - int *countPtr, /* Pointer to repeat count value. */ - int *flagsPtr) /* Pointer to field flags */ +GetFormatSpec(formatPtr, cmdPtr, countPtr) + char **formatPtr; /* Pointer to format string. */ + char *cmdPtr; /* Pointer to location of command char. */ + int *countPtr; /* Pointer to repeat count value. */ { /* * Skip any leading blanks. @@ -1428,10 +1419,6 @@ GetFormatSpec( *cmdPtr = **formatPtr; (*formatPtr)++; - if (**formatPtr == 'u') { - (*formatPtr)++; - (*flagsPtr) |= BINARY_UNSIGNED; - } if (**formatPtr == '*') { (*formatPtr)++; (*countPtr) = BINARY_ALL; @@ -1446,193 +1433,13 @@ GetFormatSpec( /* *---------------------------------------------------------------------- * - * NeedReversing -- - * - * This routine determines, if bytes of a number need to be re-ordered, - * and returns a numeric code indicating the re-ordering to be done. - * 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: - * 0 No re-ordering needed. - * 1 Reverse the bytes: 01234567 <-> 76543210 (little to big) - * 2 Apply this re-ordering: 01234567 <-> 45670123 (Nokia to little) - * 3 Apply this re-ordering: 01234567 <-> 32107654 (Nokia to big) - * - * Side effects: - * None - * - *---------------------------------------------------------------------- - */ - -static int -NeedReversing( - int format) -{ - switch (format) { - /* native floats and doubles: never reverse */ - case 'd': - case 'f': - /* big endian ints: never reverse */ - case 'I': - case 'S': - case 'W': -#ifdef WORDS_BIGENDIAN - /* native ints: reverse if we're little-endian */ - case 'n': - case 't': - case 'm': - /* f: reverse if we're little-endian */ - case 'Q': - case 'R': -#else /* !WORDS_BIGENDIAN */ - /* small endian floats: reverse if we're big-endian */ - case 'r': -#endif /* WORDS_BIGENDIAN */ - return 0; - -#ifdef WORDS_BIGENDIAN - /* small endian floats: reverse if we're big-endian */ - case 'q': - case 'r': -#else /* !WORDS_BIGENDIAN */ - /* native ints: reverse if we're little-endian */ - case 'n': - case 't': - case 'm': - /* f: reverse if we're little-endian */ - case 'R': -#endif /* WORDS_BIGENDIAN */ - /* small endian ints: always reverse */ - case 'i': - case 's': - case 'w': - return 1; - -#ifndef WORDS_BIGENDIAN - /* - * The Q and q formats need special handling to account for the unusual - * byte ordering of 8-byte floats on Nokia 770 systems, which claim to be - * little-endian, but also reverse word order. - */ - - case 'Q': - if (TclNokia770Doubles()) { - return 3; - } - return 1; - case 'q': - if (TclNokia770Doubles()) { - return 2; - } - return 0; -#endif - } - - Tcl_Panic("unexpected fallthrough"); - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * 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.) - * - * Results: - * None - * - * Side effects: - * Copies length bytes - * - *---------------------------------------------------------------------- - */ - -static void -CopyNumber( - const void *from, /* source */ - void *to, /* destination */ - unsigned int length, /* Number of bytes to copy */ - int type) /* What type of thing are we copying? */ -{ - switch (NeedReversing(type)) { - case 0: - memcpy(to, from, length); - break; - case 1: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; - - switch (length) { - case 4: - toPtr[0] = fromPtr[3]; - toPtr[1] = fromPtr[2]; - toPtr[2] = fromPtr[1]; - toPtr[3] = fromPtr[0]; - break; - case 8: - toPtr[0] = fromPtr[7]; - toPtr[1] = fromPtr[6]; - toPtr[2] = fromPtr[5]; - toPtr[3] = fromPtr[4]; - toPtr[4] = fromPtr[3]; - toPtr[5] = fromPtr[2]; - toPtr[6] = fromPtr[1]; - toPtr[7] = fromPtr[0]; - break; - } - break; - } - case 2: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; - - toPtr[0] = fromPtr[4]; - toPtr[1] = fromPtr[5]; - toPtr[2] = fromPtr[6]; - toPtr[3] = fromPtr[7]; - toPtr[4] = fromPtr[0]; - toPtr[5] = fromPtr[1]; - toPtr[6] = fromPtr[2]; - toPtr[7] = fromPtr[3]; - break; - } - case 3: { - const unsigned char *fromPtr = from; - unsigned char *toPtr = to; - - toPtr[0] = fromPtr[3]; - toPtr[1] = fromPtr[2]; - toPtr[2] = fromPtr[1]; - toPtr[3] = fromPtr[0]; - toPtr[4] = fromPtr[7]; - toPtr[5] = fromPtr[6]; - toPtr[6] = fromPtr[5]; - toPtr[7] = fromPtr[4]; - break; - } - } -} - -/* - *---------------------------------------------------------------------- - * * 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. @@ -1641,79 +1448,64 @@ CopyNumber( */ static int -FormatNumber( - Tcl_Interp *interp, /* Current interpreter, used to report +FormatNumber(interp, type, src, cursorPtr) + Tcl_Interp *interp; /* Current interpreter, used to report * errors. */ - int type, /* Type of number to format. */ - Tcl_Obj *src, /* Number to format. */ - unsigned char **cursorPtr) /* Pointer to index into destination buffer. */ + int type; /* Type of number to format. */ + Tcl_Obj *src; /* Number to format. */ + unsigned char **cursorPtr; /* Pointer to index into destination buffer. */ { long value; double dvalue; Tcl_WideInt wvalue; - float fvalue; switch (type) { case 'd': - 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. - */ - - if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - if (src->typePtr != &tclDoubleType) { - return TCL_ERROR; - } - dvalue = src->internalRep.doubleValue; - } - CopyNumber(&dvalue, *cursorPtr, sizeof(double), type); - *cursorPtr += sizeof(double); - return TCL_OK; - case 'f': - 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. + * For floating point types, we need to copy the data using + * memcpy to avoid alignment issues. */ if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { - if (src->typePtr != &tclDoubleType) { - return TCL_ERROR; - } - dvalue = src->internalRep.doubleValue; + return TCL_ERROR; } + if (type == 'd') { + /* + * Can't just memcpy() here. [Bug 1116542] + */ - /* - * 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) { - fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; + CopyNumber(&dvalue, *cursorPtr, sizeof(double)); + *cursorPtr += sizeof(double); } else { - fvalue = (float) dvalue; + float fvalue; + + /* + * 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) { + fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; + } else { + fvalue = (float) dvalue; + } + memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float)); + *cursorPtr += sizeof(float); } - CopyNumber(&fvalue, *cursorPtr, sizeof(float), type); - *cursorPtr += sizeof(float); return TCL_OK; /* - * 64-bit integer values. + * Next cases separate from other integer cases because we + * need a different API to get a wide. */ case 'w': case 'W': - case 'm': if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) { return TCL_ERROR; } - if (NeedReversing(type)) { + if (type == 'w') { *(*cursorPtr)++ = (unsigned char) wvalue; *(*cursorPtr)++ = (unsigned char) (wvalue >> 8); *(*cursorPtr)++ = (unsigned char) (wvalue >> 16); @@ -1733,221 +1525,170 @@ FormatNumber( *(*cursorPtr)++ = (unsigned char) wvalue; } return TCL_OK; - - /* - * 32-bit integer values. - */ - case 'i': - case 'I': - case 'n': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { + default: + if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) { return TCL_ERROR; } - if (NeedReversing(type)) { + if (type == 'c') { + *(*cursorPtr)++ = (unsigned char) value; + } else if (type == 's') { *(*cursorPtr)++ = (unsigned char) value; *(*cursorPtr)++ = (unsigned char) (value >> 8); - *(*cursorPtr)++ = (unsigned char) (value >> 16); - *(*cursorPtr)++ = (unsigned char) (value >> 24); - } else { - *(*cursorPtr)++ = (unsigned char) (value >> 24); - *(*cursorPtr)++ = (unsigned char) (value >> 16); + } else if (type == 'S') { *(*cursorPtr)++ = (unsigned char) (value >> 8); *(*cursorPtr)++ = (unsigned char) value; - } - return TCL_OK; - - /* - * 16-bit integer values. - */ - case 's': - case 'S': - case 't': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { - return TCL_ERROR; - } - if (NeedReversing(type)) { + } else if (type == 'i') { *(*cursorPtr)++ = (unsigned char) value; *(*cursorPtr)++ = (unsigned char) (value >> 8); - } else { + *(*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; - - /* - * 8-bit integer values. - */ - case 'c': - if (TclGetLongFromObj(interp, src, &value) != TCL_OK) { - return TCL_ERROR; - } - *(*cursorPtr)++ = (unsigned char) value; - return TCL_OK; - - default: - Tcl_Panic("unexpected fallthrough"); - return TCL_ERROR; } } +/* Ugly workaround for old and broken compiler! */ +static void +CopyNumber(from, to, length) + CONST VOID *from; + VOID *to; + unsigned int length; +{ + memcpy(to, from, length); +} + /* *---------------------------------------------------------------------- * * ScanNumber -- * - * This routine is called by Tcl_BinaryObjCmd to scan a number out of a - * buffer. + * This routine is called by Tcl_BinaryObjCmd to scan a number + * out of a buffer. * * Results: - * Returns a newly created object containing the scanned number. This - * object has a ref count of zero. + * Returns a newly created object containing the scanned number. + * This object has a ref count of zero. * * Side effects: - * Might reuse an object in the number cache, place a new object in the - * cache, or delete the cache and set the reference to it (itself passed - * in by reference) to NULL. + * Might reuse an object in the number cache, place a new object + * in the cache, or delete the cache and set the reference to + * it (itself passed in by reference) to NULL. * *---------------------------------------------------------------------- */ static Tcl_Obj * -ScanNumber( - unsigned char *buffer, /* Buffer to scan number from. */ - int type, /* Format character from "binary scan" */ - int flags, /* Format field flags */ - Tcl_HashTable **numberCachePtrPtr) +ScanNumber(buffer, type, numberCachePtrPtr) + unsigned char *buffer; /* Buffer to scan number from. */ + int type; /* Format character from "binary scan" */ + Tcl_HashTable **numberCachePtrPtr; /* Place to look for cache of scanned * value objects, or NULL if too many * different numbers have been scanned. */ { long value; - float fvalue; - double dvalue; Tcl_WideUInt uwvalue; /* * We cannot rely on the compiler to properly sign extend integer values * when we cast from smaller values to larger values because we don't know - * the exact size of the integer types. So, we have to handle sign + * the exact size of the integer types. So, we have to handle sign * extension explicitly by checking the high bit and padding with 1's as - * needed. This practice is disabled if the BINARY_UNSIGNED flag is set. + * needed. */ 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. - */ + 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 (!(flags & BINARY_UNSIGNED)) { + value = buffer[0]; if (value & 0x80) { value |= -0x100; } - } - goto returnNumericObject; - - /* - * 16-bit numeric values. We need the sign extension trick (see above) - * here as well. - */ + goto returnNumericObject; - case 's': - case 'S': - case 't': - if (NeedReversing(type)) { + case 's': value = (long) (buffer[0] + (buffer[1] << 8)); - } else { + goto shortValue; + case 'S': value = (long) (buffer[1] + (buffer[0] << 8)); - } - if (!(flags & BINARY_UNSIGNED)) { + shortValue: if (value & 0x8000) { value |= -0x10000; } - } - goto returnNumericObject; + goto returnNumericObject; - /* - * 32-bit numeric values. - */ - - case 'i': - case 'I': - case 'n': - if (NeedReversing(type)) { - value = (long) (buffer[0] + case 'i': + value = (long) (buffer[0] + (buffer[1] << 8) + (buffer[2] << 16) - + (((long)buffer[3]) << 24)); - } else { + + (buffer[3] << 24)); + goto intValue; + case 'I': value = (long) (buffer[3] + (buffer[2] << 8) + (buffer[1] << 16) - + (((long)buffer[0]) << 24)); - } - - /* - * Check to see if the value was sign extended properly on systems - * where an int is more than 32-bits. - * We avoid caching unsigned integers as we cannot distinguish between - * 32bit signed and unsigned in the hash (short and char are ok). - */ - - if (flags & BINARY_UNSIGNED) { - return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); - } - if ((value & (((unsigned int)1)<<31)) && (value > 0)) { - value -= (((unsigned int)1)<<31); - value -= (((unsigned int)1)<<31); - } - - returnNumericObject: - if (*numberCachePtrPtr == NULL) { - return Tcl_NewLongObj(value); - } else { - register Tcl_HashTable *tablePtr = *numberCachePtrPtr; - register Tcl_HashEntry *hPtr; - int isNew; + + (buffer[0] << 24)); + intValue: + /* + * Check to see if the value was sign extended properly on + * systems where an int is more than 32-bits. + */ - hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew); - if (!isNew) { - return (Tcl_Obj *) Tcl_GetHashValue(hPtr); + if ((value & (((unsigned int)1)<<31)) && (value > 0)) { + value -= (((unsigned int)1)<<31); + value -= (((unsigned int)1)<<31); } - if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) { - register Tcl_Obj *objPtr = Tcl_NewLongObj(value); + returnNumericObject: + if (*numberCachePtrPtr == NULL) { + return Tcl_NewLongObj(value); + } else { + register Tcl_HashTable *tablePtr = *numberCachePtrPtr; + register Tcl_HashEntry *hPtr; + int isNew; + + hPtr = Tcl_CreateHashEntry(tablePtr, (char *)value, &isNew); + if (!isNew) { + return (Tcl_Obj *) Tcl_GetHashValue(hPtr); + } + 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. + * + * Note that anyone just using the 'c' conversion + * (for bytes) cannot trigger this. + */ + DeleteScanNumberCache(tablePtr); + *numberCachePtrPtr = NULL; + return Tcl_NewLongObj(value); + } else { + register Tcl_Obj *objPtr = Tcl_NewLongObj(value); - Tcl_IncrRefCount(objPtr); - Tcl_SetHashValue(hPtr, (ClientData) objPtr); - return objPtr; + Tcl_IncrRefCount(objPtr); + Tcl_SetHashValue(hPtr, (ClientData) objPtr); + return objPtr; + } } /* - * 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. + * Do not cache wide values; they are already too large to + * use as keys. */ - - DeleteScanNumberCache(tablePtr); - *numberCachePtrPtr = NULL; - return Tcl_NewLongObj(value); - } - - /* - * Do not cache wide (64-bit) values; they are already too large to - * use as keys. - */ - - case 'w': - case 'W': - case 'm': - if (NeedReversing(type)) { - uwvalue = ((Tcl_WideUInt) buffer[0]) + case 'w': + uwvalue = ((Tcl_WideUInt) buffer[0]) | (((Tcl_WideUInt) buffer[1]) << 8) | (((Tcl_WideUInt) buffer[2]) << 16) | (((Tcl_WideUInt) buffer[3]) << 24) @@ -1955,8 +1696,9 @@ ScanNumber( | (((Tcl_WideUInt) buffer[5]) << 40) | (((Tcl_WideUInt) buffer[6]) << 48) | (((Tcl_WideUInt) buffer[7]) << 56); - } else { - uwvalue = ((Tcl_WideUInt) buffer[7]) + return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); + case 'W': + uwvalue = ((Tcl_WideUInt) buffer[7]) | (((Tcl_WideUInt) buffer[6]) << 8) | (((Tcl_WideUInt) buffer[5]) << 16) | (((Tcl_WideUInt) buffer[4]) << 24) @@ -1964,42 +1706,23 @@ ScanNumber( | (((Tcl_WideUInt) buffer[2]) << 40) | (((Tcl_WideUInt) buffer[1]) << 48) | (((Tcl_WideUInt) buffer[0]) << 56); - } - if (flags & BINARY_UNSIGNED) { - Tcl_Obj *bigObj = NULL; - mp_int big; + return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue); - TclBNInitBignumFromWideUInt(&big, uwvalue); - bigObj = Tcl_NewBignumObj(&big); - return bigObj; + /* + * Do not cache double values; they are already too large + * to use as keys and the values stored are utterly + * incompatible too. + */ + case 'f': { + float fvalue; + memcpy((VOID *) &fvalue, (VOID *) buffer, sizeof(float)); + return Tcl_NewDoubleObj(fvalue); + } + case 'd': { + double dvalue; + memcpy((VOID *) &dvalue, (VOID *) buffer, sizeof(double)); + return Tcl_NewDoubleObj(dvalue); } - 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. - */ - - /* - * 32-bit IEEE single-precision floating point. - */ - - case 'f': - case 'R': - case 'r': - CopyNumber(buffer, &fvalue, sizeof(float), type); - return Tcl_NewDoubleObj(fvalue); - - /* - * 64-bit IEEE double-precision floating point. - */ - - case 'd': - case 'Q': - case 'q': - CopyNumber(buffer, &dvalue, sizeof(double), type); - return Tcl_NewDoubleObj(dvalue); } return NULL; } @@ -2008,7 +1731,7 @@ ScanNumber( *---------------------------------------------------------------------- * * DeleteScanNumberCache -- - * + * * Deletes the hash table acting as a scan number cache. * * Results: @@ -2021,11 +1744,10 @@ ScanNumber( */ static void -DeleteScanNumberCache( - Tcl_HashTable *numberCachePtr) - /* Pointer to the hash table, or NULL (when - * the cache has already been deleted due to - * overflow.) */ +DeleteScanNumberCache(numberCachePtr) + 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; @@ -2036,7 +1758,7 @@ DeleteScanNumberCache( hEntry = Tcl_FirstHashEntry(numberCachePtr, &search); while (hEntry != NULL) { - register Tcl_Obj *value = Tcl_GetHashValue(hEntry); + register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry); if (value != NULL) { Tcl_DecrRefCount(value); @@ -2045,11 +1767,3 @@ DeleteScanNumberCache( } Tcl_DeleteHashTable(numberCachePtr); } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |