diff options
Diffstat (limited to 'generic/tclStringObj.c')
| -rw-r--r-- | generic/tclStringObj.c | 3207 |
1 files changed, 2235 insertions, 972 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 5925451..dffa38c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,117 +1,149 @@ -/* +/* * tclStringObj.c -- * - * This file contains procedures that implement string operations on Tcl - * objects. Some string operations work with UTF strings and others - * require Unicode format. Functions that require knowledge of the width + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF strings and others + * require Unicode format. Functions that require knowledge of the width * of each character, such as indexing, operate on Unicode data. * - * A Unicode string is an internationalized string. Conceptually, a - * Unicode string is an array of 16-bit quantities organized as a sequence - * of properly formed UTF-8 characters. There is a one-to-one map between - * Unicode and UTF characters. Because Unicode characters have a fixed - * width, operations such as indexing operate on Unicode data. The String - * object is optimized for the case where each UTF char in a string is - * only one byte. In this case, we store the value of numChars, but we - * don't store the Unicode data (unless Tcl_GetUnicode is explicitly - * called). - * - * The String object type stores one or both formats. The default - * behavior is to store UTF. Once Unicode is calculated by a function, it + * A Unicode string is an internationalized string. Conceptually, a + * Unicode string is an array of 16-bit quantities organized as a + * sequence of properly formed UTF-8 characters. There is a one-to-one + * map between Unicode and UTF characters. Because Unicode characters + * have a fixed width, operations such as indexing operate on Unicode + * data. The String object is optimized for the case where each UTF char + * in a string is only one byte. In this case, we store the value of + * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode + * is explicitly called). + * + * The String object type stores one or both formats. The default + * behavior is to store UTF. Once Unicode is calculated by a function, it * is stored in the internal rep for future access (without an additional * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating the space for the string or Unicode representation, we * allocate double the space for the string or Unicode and use the - * internal representation to keep track of how much space is used - * vs. allocated. + * internal representation to keep track of how much space is used vs. + * allocated. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 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. - * - * RCS: @(#) $Id: tclStringObj.c,v 1.32 2003/02/19 16:43:28 das Exp $ */ + * 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" + +/* + * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5. + * This is an escape hatch in case the changes have some unexpected unwelcome + * impact on performance. If things go well, this mechanism can go away when + * post-8.6 development begins. + */ + +#define COMPAT 0 /* - * Prototypes for procedures defined later in this file: + * Prototypes for functions defined later in this file: */ -static void AppendUnicodeToUnicodeRep _ANSI_ARGS_(( - Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, - int appendNumChars)); -static void AppendUnicodeToUtfRep _ANSI_ARGS_(( - Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, - int numChars)); -static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr, - CONST char *bytes, int numBytes)); -static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr, - CONST char *bytes, int numBytes)); - -static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr)); - -static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); -static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr, - Tcl_Obj *copyPtr)); -static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); -static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void AppendPrintfToObjVA(Tcl_Obj *objPtr, + const char *format, va_list argList); +static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int appendNumChars); +static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int numChars); +static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, + const char *bytes, int numBytes); +static void AppendUtfToUtfRep(Tcl_Obj *objPtr, + const char *bytes, int numBytes); +static void DupStringInternalRep(Tcl_Obj *objPtr, + Tcl_Obj *copyPtr); +static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int numChars); +static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, + const char *bytes, int numBytes, + int numAppendChars); +static void FillUnicodeRep(Tcl_Obj *objPtr); +static void FreeStringInternalRep(Tcl_Obj *objPtr); +static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); +static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); +static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void SetUnicodeObj(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, int numChars); +static int UnicodeLength(const Tcl_UniChar *unicode); +static void UpdateStringOfString(Tcl_Obj *objPtr); /* * The structure below defines the string Tcl object type by means of - * procedures that can be invoked by generic object code. + * functions that can be invoked by generic object code. */ -Tcl_ObjType tclStringType = { - "string", /* name */ - FreeStringInternalRep, /* freeIntRepPro */ - DupStringInternalRep, /* dupIntRepProc */ - UpdateStringOfString, /* updateStringProc */ - SetStringFromAny /* setFromAnyProc */ +const Tcl_ObjType tclStringType = { + "string", /* name */ + FreeStringInternalRep, /* freeIntRepPro */ + DupStringInternalRep, /* dupIntRepProc */ + UpdateStringOfString, /* updateStringProc */ + SetStringFromAny /* setFromAnyProc */ }; /* - * The following structure is the internal rep for a String object. - * It keeps track of how much memory has been used and how much has been - * allocated for the Unicode and UTF string to enable growing and - * shrinking of the UTF and Unicode reps of the String object with fewer - * mallocs. To optimize string length and indexing operations, this - * structure also stores the number of characters (same of UTF and Unicode!) - * once that value has been computed. + * The following structure is the internal rep for a String object. It keeps + * track of how much memory has been used and how much has been allocated for + * the Unicode and UTF string to enable growing and shrinking of the UTF and + * Unicode reps of the String object with fewer mallocs. To optimize string + * length and indexing operations, this structure also stores the number of + * characters (same of UTF and Unicode!) once that value has been computed. + * + * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16 + * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This + * can be officially modified by altering the definition of Tcl_UniChar in + * tcl.h, but do not do that unless you are sure what you're doing! */ typedef struct String { - int numChars; /* The number of chars in the string. - * -1 means this value has not been - * calculated. >= 0 means that there is a - * valid Unicode rep, or that the number - * of UTF bytes == the number of chars. */ - size_t allocated; /* The amount of space actually allocated - * for the UTF string (minus 1 byte for - * the termination char). */ - size_t uallocated; /* The amount of space actually allocated - * for the Unicode string (minus 2 bytes for - * the termination char). */ - int hasUnicode; /* Boolean determining whether the string - * has a Unicode representation. */ - Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual - * size of this field depends on the - * 'uallocated' field above. */ + int numChars; /* The number of chars in the string. -1 means + * this value has not been calculated. >= 0 + * means that there is a valid Unicode rep, or + * that the number of UTF bytes == the number + * of chars. */ + int allocated; /* The amount of space actually allocated for + * the UTF string (minus 1 byte for the + * termination char). */ + int maxChars; /* Max number of chars that can fit in the + * space allocated for the unicode array. */ + int hasUnicode; /* Boolean determining whether the string has + * a Unicode representation. */ + Tcl_UniChar unicode[1]; /* The array of Unicode chars. The actual size + * of this field depends on the 'maxChars' + * field above. */ } String; -#define STRING_UALLOC(numChars) \ - (numChars * sizeof(Tcl_UniChar)) -#define STRING_SIZE(ualloc) \ - ((unsigned) (sizeof(String) - sizeof(Tcl_UniChar) + ualloc)) +#define STRING_MAXCHARS \ + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)) +#define STRING_SIZE(numChars) \ + (sizeof(String) + ((numChars) * sizeof(Tcl_UniChar))) +#define stringCheckLimits(numChars) \ + if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ + Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \ + STRING_MAXCHARS); \ + } +#define stringAttemptAlloc(numChars) \ + (String *) attemptckalloc((unsigned) STRING_SIZE(numChars) ) +#define stringAlloc(numChars) \ + (String *) ckalloc((unsigned) STRING_SIZE(numChars) ) +#define stringRealloc(ptr, numChars) \ + (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) ) +#define stringAttemptRealloc(ptr, numChars) \ + (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) ) #define GET_STRING(objPtr) \ - ((String *) (objPtr)->internalRep.otherValuePtr) + ((String *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_STRING(objPtr, stringPtr) \ - (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr) - + ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) + /* * TCL STRING GROWTH ALGORITHM * @@ -120,96 +152,192 @@ typedef struct String { * * Attempt to allocate 2 * (originalLength + appendLength) * On failure: - * attempt to allocate originalLength + 2*appendLength + - * TCL_GROWTH_MIN_ALLOC + * attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH * * This algorithm allows very good performance, as it rapidly increases the * memory allocated for a given string, which minimizes the number of - * reallocations that must be performed. However, using only the doubling - * algorithm can lead to a significant waste of memory. In particular, it - * may fail even when there is sufficient memory available to complete the - * append request (but there is not 2 * totalLength memory available). So when - * the doubling fails (because there is not enough memory available), the + * reallocations that must be performed. However, using only the doubling + * algorithm can lead to a significant waste of memory. In particular, it may + * fail even when there is sufficient memory available to complete the append + * request (but there is not 2*totalLength memory available). So when the + * doubling fails (because there is not enough memory available), the * algorithm requests a smaller amount of memory, which is still enough to - * cover the request, but which hopefully will be less than the total available - * memory. - * - * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling - * of very small appends. Without this extra slush factor, a sequence - * of several small appends would cause several memory allocations. - * As long as TCL_GROWTH_MIN_ALLOC is a reasonable size, we can - * avoid that behavior. + * cover the request, but which hopefully will be less than the total + * available memory. + * + * The addition of TCL_MIN_GROWTH allows for efficient handling of very + * small appends. Without this extra slush factor, a sequence of several small + * appends would cause several memory allocations. As long as + * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior. * * The growth algorithm can be tuned by adjusting the following parameters: * - * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when - * the double allocation has failed. - * Default is 1024 (1 kilobyte). + * TCL_MIN_GROWTH Additional space, in bytes, to allocate when + * the double allocation has failed. Default is + * 1024 (1 kilobyte). See tclInt.h. */ -#ifndef TCL_GROWTH_MIN_ALLOC -#define TCL_GROWTH_MIN_ALLOC 1024 + +#ifndef TCL_MIN_UNICHAR_GROWTH +#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar) #endif +static void +GrowStringBuffer( + Tcl_Obj *objPtr, + int needed, + int flag) +{ + /* + * Pre-conditions: + * objPtr->typePtr == &tclStringType + * needed > stringPtr->allocated + * flag || objPtr->bytes != NULL + */ + + String *stringPtr = GET_STRING(objPtr); + char *ptr = NULL; + int attempt; + + if (objPtr->bytes == tclEmptyStringRep) { + objPtr->bytes = NULL; + } + if (flag == 0 || stringPtr->allocated > 0) { + attempt = 2 * needed; + if (attempt >= 0) { + ptr = attemptckrealloc(objPtr->bytes, attempt + 1); + } + if (ptr == NULL) { + /* + * Take care computing the amount of modest growth to avoid + * overflow into invalid argument values for attempt. + */ + + unsigned int limit = INT_MAX - needed; + unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; + int growth = (int) ((extra > limit) ? limit : extra); + + attempt = needed + growth; + ptr = attemptckrealloc(objPtr->bytes, attempt + 1); + } + } + if (ptr == NULL) { + /* + * First allocation - just big enough; or last chance fallback. + */ + + attempt = needed; + ptr = ckrealloc(objPtr->bytes, attempt + 1); + } + objPtr->bytes = ptr; + stringPtr->allocated = attempt; +} + +static void +GrowUnicodeBuffer( + Tcl_Obj *objPtr, + int needed) +{ + /* + * Pre-conditions: + * objPtr->typePtr == &tclStringType + * needed > stringPtr->maxChars + * needed < STRING_MAXCHARS + */ + + String *ptr = NULL, *stringPtr = GET_STRING(objPtr); + int attempt; + + if (stringPtr->maxChars > 0) { + /* + * Subsequent appends - apply the growth algorithm. + */ + + attempt = 2 * needed; + if (attempt >= 0 && attempt <= STRING_MAXCHARS) { + ptr = stringAttemptRealloc(stringPtr, attempt); + } + if (ptr == NULL) { + /* + * Take care computing the amount of modest growth to avoid + * overflow into invalid argument values for attempt. + */ + + unsigned int limit = STRING_MAXCHARS - needed; + unsigned int extra = needed - stringPtr->numChars + + TCL_MIN_UNICHAR_GROWTH; + int growth = (int) ((extra > limit) ? limit : extra); + + attempt = needed + growth; + ptr = stringAttemptRealloc(stringPtr, attempt); + } + } + if (ptr == NULL) { + /* + * First allocation - just big enough; or last chance fallback. + */ + + attempt = needed; + ptr = stringRealloc(stringPtr, attempt); + } + stringPtr = ptr; + stringPtr->maxChars = attempt; + SET_STRING(objPtr, stringPtr); +} /* *---------------------------------------------------------------------- * * Tcl_NewStringObj -- * - * This procedure is normally called when not debugging: i.e., when + * This function is normally called when not debugging: i.e., when * TCL_MEM_DEBUG is not defined. It creates a new string object and * initializes it from the byte pointer and length arguments. * - * When TCL_MEM_DEBUG is defined, this procedure just returns the - * result of calling the debugging version Tcl_DbNewStringObj. + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewStringObj. * * Results: * A newly created string object is returned that has ref count zero. * * Side effects: - * The new object's internal string representation will be set to a - * copy of the length bytes starting at "bytes". If "length" is - * negative, use bytes up to the first NULL byte; i.e., assume "bytes" - * points to a C-style NULL-terminated string. The object's type is set - * to NULL. An extra NULL is added to the end of the new object's byte - * array. + * The new object's internal string representation will be set to a copy + * of the length bytes starting at "bytes". If "length" is negative, use + * bytes up to the first NUL byte; i.e., assume "bytes" points to a + * C-style NUL-terminated string. The object's type is set to NULL. An + * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG #undef Tcl_NewStringObj - Tcl_Obj * -Tcl_NewStringObj(bytes, length) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_NewStringObj( + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first - * NULL byte. */ + int length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ { return Tcl_DbNewStringObj(bytes, length, "unknown", 0); } - #else /* if not TCL_MEM_DEBUG */ - Tcl_Obj * -Tcl_NewStringObj(bytes, length) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_NewStringObj( + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first - * NULL byte. */ + int length) /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); } - TclNewObj(objPtr); - TclInitStringRep(objPtr, bytes, length); + TclNewStringObj(objPtr, bytes, length); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -219,47 +347,45 @@ Tcl_NewStringObj(bytes, length) * * Tcl_DbNewStringObj -- * - * This procedure is normally called when debugging: i.e., when + * This function is normally called when debugging: i.e., when * TCL_MEM_DEBUG is defined. It creates new string objects. It is the - * same as the Tcl_NewStringObj procedure above except that it calls + * same as the Tcl_NewStringObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when + * command will report the correct file name and line number when * reporting objects that haven't been freed. * - * When TCL_MEM_DEBUG is not defined, this procedure just returns the + * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewStringObj. * * Results: * A newly created string object is returned that has ref count zero. * * Side effects: - * The new object's internal string representation will be set to a - * copy of the length bytes starting at "bytes". If "length" is - * negative, use bytes up to the first NULL byte; i.e., assume "bytes" - * points to a C-style NULL-terminated string. The object's type is set - * to NULL. An extra NULL is added to the end of the new object's byte - * array. + * The new object's internal string representation will be set to a copy + * of the length bytes starting at "bytes". If "length" is negative, use + * bytes up to the first NUL byte; i.e., assume "bytes" points to a + * C-style NUL-terminated string. The object's type is set to NULL. An + * extra NUL is added to the end of the new object's byte array. * *---------------------------------------------------------------------- */ #ifdef TCL_MEM_DEBUG - Tcl_Obj * -Tcl_DbNewStringObj(bytes, length, file, line) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_DbNewStringObj( + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - int length; /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first - * NULL byte. */ - 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 length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ { - register Tcl_Obj *objPtr; + Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); @@ -268,21 +394,19 @@ Tcl_DbNewStringObj(bytes, length, file, line) TclInitStringRep(objPtr, bytes, length); return objPtr; } - #else /* if not TCL_MEM_DEBUG */ - Tcl_Obj * -Tcl_DbNewStringObj(bytes, length, file, line) - CONST char *bytes; /* Points to the first of the length bytes +Tcl_DbNewStringObj( + const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - register int length; /* The number of bytes to copy from "bytes" - * when initializing the new object. If - * negative, use bytes up to the first - * NULL byte. */ - 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 length, /* The number of bytes to copy from "bytes" + * when initializing the new object. If + * negative, use bytes up to the first NUL + * byte. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ { return Tcl_NewStringObj(bytes, length); } @@ -293,14 +417,13 @@ Tcl_DbNewStringObj(bytes, length, file, line) * * Tcl_NewUnicodeObj -- * - * This procedure is creates a new String object and initializes - * it from the given Unicode String. If the Utf String is the same size - * as the Unicode string, don't duplicate the data. + * This function is creates a new String object and initializes it from + * the given Unicode String. If the Utf String is the same size as the + * Unicode string, don't duplicate the data. * * Results: - * The newly created object is returned. This object will have no - * initial string representation. The returned object has a ref count - * of 0. + * The newly created 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 Unicode argument. @@ -309,40 +432,16 @@ Tcl_DbNewStringObj(bytes, length, file, line) */ Tcl_Obj * -Tcl_NewUnicodeObj(unicode, numChars) - CONST Tcl_UniChar *unicode; /* The unicode string used to initialize - * the new object. */ - int numChars; /* Number of characters in the unicode +Tcl_NewUnicodeObj( + const Tcl_UniChar *unicode, /* The unicode string used to initialize the + * new object. */ + int numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; - String *stringPtr; - size_t uallocated; - - if (numChars < 0) { - numChars = 0; - if (unicode) { - while (unicode[numChars] != 0) { numChars++; } - } - } - uallocated = STRING_UALLOC(numChars); - - /* - * Create a new obj with an invalid string rep. - */ TclNewObj(objPtr); - Tcl_InvalidateStringRep(objPtr); - objPtr->typePtr = &tclStringType; - - stringPtr = (String *) ckalloc(STRING_SIZE(uallocated)); - stringPtr->numChars = numChars; - stringPtr->uallocated = uallocated; - stringPtr->hasUnicode = (numChars > 0); - stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); - stringPtr->unicode[numChars] = 0; - SET_STRING(objPtr, stringPtr); + SetUnicodeObj(objPtr, unicode, numChars); return objPtr; } @@ -357,73 +456,62 @@ Tcl_NewUnicodeObj(unicode, numChars) * Pointer to unicode string representing the unicode object. * * Side effects: - * Frees old internal rep. Allocates memory for new "String" - * internal rep. + * Frees old internal rep. Allocates memory for new "String" internal + * rep. * *---------------------------------------------------------------------- */ int -Tcl_GetCharLength(objPtr) - Tcl_Obj *objPtr; /* The String object to get the num chars of. */ +Tcl_GetCharLength( + Tcl_Obj *objPtr) /* The String object to get the num chars + * of. */ { String *stringPtr; - - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); + int numChars; /* - * If numChars is unknown, then calculate the number of characaters - * while populating the Unicode string. + * Optimize the case where we're really dealing with a bytearray object + * without string representation; we don't need to convert to a string to + * perform the get-length operation. */ - - if (stringPtr->numChars == -1) { - register int i = objPtr->length; - register unsigned char *str = (unsigned char *) objPtr->bytes; - /* - * This is a speed sensitive function, so run specially over the - * string to count continuous ascii characters before resorting - * to the Tcl_NumUtfChars call. This is a long form of: - stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length); - */ - - while (i && (*str < 0xC0)) { i--; str++; } - stringPtr->numChars = objPtr->length - i; - if (i) { - stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes - + (objPtr->length - i), i); - } + if (TclIsPureByteArray(objPtr)) { + int length; - if (stringPtr->numChars == objPtr->length) { + (void) Tcl_GetByteArrayFromObj(objPtr, &length); + return length; + } - /* - * Since we've just calculated the number of chars, and all - * UTF chars are 1-byte long, we don't need to store the - * unicode string. - */ + /* + * OK, need to work with the object as a string. + */ - stringPtr->hasUnicode = 0; + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + numChars = stringPtr->numChars; - } else { - - /* - * Since we've just calucalated the number of chars, and not - * all UTF chars are 1-byte long, go ahead and populate the - * unicode string. - */ + /* + * If numChars is unknown, compute it. + */ - FillUnicodeRep(objPtr); + if (numChars == -1) { + TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); + stringPtr->numChars = numChars; +#if COMPAT + if (numChars < objPtr->length) { /* - * We need to fetch the pointer again because we have just - * reallocated the structure to make room for the Unicode data. + * Since we've just computed the number of chars, and not all UTF + * chars are 1-byte long, go ahead and populate the unicode + * string. */ - - stringPtr = GET_STRING(objPtr); + + FillUnicodeRep(objPtr); } +#endif } - return stringPtr->numChars; + return numChars; } /* @@ -431,8 +519,8 @@ Tcl_GetCharLength(objPtr) * * Tcl_GetUniChar -- * - * Get the index'th Unicode character from the String object. The - * index is assumed to be in the appropriate range. + * Get the index'th Unicode character from the String object. The index + * is assumed to be in the appropriate range. * * Results: * Returns the index'th Unicode character in the Object. @@ -444,46 +532,47 @@ Tcl_GetCharLength(objPtr) */ Tcl_UniChar -Tcl_GetUniChar(objPtr, index) - Tcl_Obj *objPtr; /* The object to get the Unicode charater from. */ - int index; /* Get the index'th Unicode character. */ +Tcl_GetUniChar( + Tcl_Obj *objPtr, /* The object to get the Unicode charater + * from. */ + int index) /* Get the index'th Unicode character. */ { - Tcl_UniChar unichar; String *stringPtr; - - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - - if (stringPtr->numChars == -1) { - /* - * We haven't yet calculated the length, so we don't have the - * Unicode str. We need to know the number of chars before we - * can do indexing. - */ + /* + * Optimize the case where we're really dealing with a bytearray object + * without string representation; we don't need to convert to a string to + * perform the indexing operation. + */ - Tcl_GetCharLength(objPtr); + if (TclIsPureByteArray(objPtr)) { + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); - /* - * We need to fetch the pointer again because we may have just - * reallocated the structure. - */ - - stringPtr = GET_STRING(objPtr); + return (Tcl_UniChar) bytes[index]; } - if (stringPtr->hasUnicode == 0) { + /* + * OK, need to work with the object as a string. + */ + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + + if (stringPtr->hasUnicode == 0) { /* - * All of the characters in the Utf string are 1 byte chars, - * so we don't store the unicode char. We get the Utf string - * and convert the index'th byte to a Unicode character. + * If numChars is unknown, compute it. */ - unichar = (Tcl_UniChar) objPtr->bytes[index]; - } else { - unichar = stringPtr->unicode[index]; + if (stringPtr->numChars == -1) { + TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); + } + if (stringPtr->numChars == objPtr->length) { + return (Tcl_UniChar) objPtr->bytes[index]; + } + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); } - return unichar; + return stringPtr->unicode[index]; } /* @@ -491,10 +580,10 @@ Tcl_GetUniChar(objPtr, index) * * Tcl_GetUnicode -- * - * Get the Unicode form of the String object. If - * the object is not already a String object, it will be converted - * to one. If the String object does not have a Unicode rep, then - * one is create from the UTF string format. + * Get the Unicode form of the String object. If the object is not + * already a String object, it will be converted to one. If the String + * object does not have a Unicode rep, then one is create from the UTF + * string format. * * Results: * Returns a pointer to the object's internal Unicode string. @@ -506,34 +595,11 @@ Tcl_GetUniChar(objPtr, index) */ Tcl_UniChar * -Tcl_GetUnicode(objPtr) - Tcl_Obj *objPtr; /* The object to find the unicode string for. */ +Tcl_GetUnicode( + Tcl_Obj *objPtr) /* The object to find the unicode string + * for. */ { - String *stringPtr; - - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - - if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) { - - /* - * We haven't yet calculated the length, or all of the characters - * in the Utf string are 1 byte chars (so we didn't store the - * unicode str). Since this function must return a unicode string, - * and one has not yet been stored, force the Unicode to be - * calculated and stored now. - */ - - FillUnicodeRep(objPtr); - - /* - * We need to fetch the pointer again because we have just - * reallocated the structure to make room for the Unicode data. - */ - - stringPtr = GET_STRING(objPtr); - } - return stringPtr->unicode; + return Tcl_GetUnicodeFromObj(objPtr, NULL); } /* @@ -541,10 +607,10 @@ Tcl_GetUnicode(objPtr) * * Tcl_GetUnicodeFromObj -- * - * Get the Unicode form of the String object with length. If - * the object is not already a String object, it will be converted - * to one. If the String object does not have a Unicode rep, then - * one is create from the UTF string format. + * Get the Unicode form of the String object with length. If the object + * is not already a String object, it will be converted to one. If the + * String object does not have a Unicode rep, then one is create from the + * UTF string format. * * Results: * Returns a pointer to the object's internal Unicode string. @@ -556,34 +622,20 @@ Tcl_GetUnicode(objPtr) */ Tcl_UniChar * -Tcl_GetUnicodeFromObj(objPtr, lengthPtr) - Tcl_Obj *objPtr; /* The object to find the unicode string for. */ - int *lengthPtr; /* If non-NULL, the location where the - * string rep's unichar length should be - * stored. If NULL, no length is stored. */ +Tcl_GetUnicodeFromObj( + Tcl_Obj *objPtr, /* The object to find the unicode string + * for. */ + int *lengthPtr) /* If non-NULL, the location where the string + * rep's unichar length should be stored. If + * NULL, no length is stored. */ { String *stringPtr; - + SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - - if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) { - - /* - * We haven't yet calculated the length, or all of the characters - * in the Utf string are 1 byte chars (so we didn't store the - * unicode str). Since this function must return a unicode string, - * and one has not yet been stored, force the Unicode to be - * calculated and stored now. - */ + if (stringPtr->hasUnicode == 0) { FillUnicodeRep(objPtr); - - /* - * We need to fetch the pointer again because we have just - * reallocated the structure to make room for the Unicode data. - */ - stringPtr = GET_STRING(objPtr); } @@ -598,10 +650,10 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr) * * Tcl_GetRange -- * - * Create a Tcl Object that contains the chars between first and last - * of the object indicated by "objPtr". If the object is not already - * a String object, convert it to one. The first and last indices - * are assumed to be in the appropriate range. + * Create a Tcl Object that contains the chars between first and last of + * the object indicated by "objPtr". If the object is not already a + * String object, convert it to one. The first and last indices are + * assumed to be in the appropriate range. * * Results: * Returns a new Tcl Object of the String type. @@ -613,59 +665,58 @@ Tcl_GetUnicodeFromObj(objPtr, lengthPtr) */ Tcl_Obj * -Tcl_GetRange(objPtr, first, last) - Tcl_Obj *objPtr; /* The Tcl object to find the range of. */ - int first; /* First index of the range. */ - int last; /* Last index of the range. */ +Tcl_GetRange( + Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ + int first, /* First index of the range. */ + int last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; - - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - if (stringPtr->numChars == -1) { - - /* - * We haven't yet calculated the length, so we don't have the - * Unicode str. We need to know the number of chars before we - * can do indexing. - */ + /* + * Optimize the case where we're really dealing with a bytearray object + * without string representation; we don't need to convert to a string to + * perform the substring operation. + */ - Tcl_GetCharLength(objPtr); + if (TclIsPureByteArray(objPtr)) { + unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); - /* - * We need to fetch the pointer again because we may have just - * reallocated the structure. - */ - - stringPtr = GET_STRING(objPtr); + return Tcl_NewByteArrayObj(bytes+first, last-first+1); } - if (stringPtr->numChars == objPtr->length) { - char *str = Tcl_GetString(objPtr); + /* + * OK, need to work with the object as a string. + */ - /* - * All of the characters in the Utf string are 1 byte chars, - * so we don't store the unicode char. Create a new string - * object containing the specified range of chars. - */ - - newObjPtr = Tcl_NewStringObj(&str[first], last-first+1); + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode == 0) { /* - * Since we know the new string only has 1-byte chars, we - * can set it's numChars field. + * If numChars is unknown, compute it. */ - - SetStringFromAny(NULL, newObjPtr); - stringPtr = GET_STRING(newObjPtr); - stringPtr->numChars = last-first+1; - } else { - newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first, - last-first+1); + + if (stringPtr->numChars == -1) { + TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); + } + if (stringPtr->numChars == objPtr->length) { + newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1); + + /* + * Since we know the char length of the result, store it. + */ + + SetStringFromAny(NULL, newObjPtr); + stringPtr = GET_STRING(newObjPtr); + stringPtr->numChars = newObjPtr->length; + return newObjPtr; + } + FillUnicodeRep(objPtr); + stringPtr = GET_STRING(objPtr); } - return newObjPtr; + + return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); } /* @@ -674,52 +725,46 @@ Tcl_GetRange(objPtr, first, last) * Tcl_SetStringObj -- * * Modify an object to hold a string that is a copy of the bytes - * indicated by the byte pointer and length arguments. + * indicated by the byte pointer and length arguments. * * Results: * None. * * Side effects: - * The object's string representation will be set to a copy of - * the "length" bytes starting at "bytes". If "length" is negative, use - * bytes up to the first NULL byte; i.e., assume "bytes" points to a - * C-style NULL-terminated string. The object's old string and internal + * The object's string representation will be set to a copy of the + * "length" bytes starting at "bytes". If "length" is negative, use bytes + * up to the first NUL byte; i.e., assume "bytes" points to a C-style + * NUL-terminated string. The object's old string and internal * representations are freed and the object's type is set NULL. * *---------------------------------------------------------------------- */ void -Tcl_SetStringObj(objPtr, bytes, length) - register Tcl_Obj *objPtr; /* Object whose internal rep to init. */ - CONST char *bytes; /* Points to the first of the length bytes +Tcl_SetStringObj( + Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - register int length; /* The number of bytes to copy from "bytes" - * when initializing the object. If - * negative, use bytes up to the first - * NULL byte.*/ + int length) /* The number of bytes to copy from "bytes" + * when initializing the object. If negative, + * use bytes up to the first NUL byte.*/ { - register Tcl_ObjType *oldTypePtr = objPtr->typePtr; - - /* - * Free any old string rep, then set the string rep to a copy of - * the length bytes starting at "bytes". - */ - if (Tcl_IsShared(objPtr)) { - panic("Tcl_SetStringObj called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_SetStringObj"); } /* * Set the type to NULL and free any internal rep for the old type. */ - if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { - oldTypePtr->freeIntRepProc(objPtr); - } - objPtr->typePtr = NULL; + TclFreeIntRep(objPtr); + + /* + * Free any old string rep, then set the string rep to a copy of the + * length bytes starting at "bytes". + */ - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); if (length < 0) { length = (bytes? strlen(bytes) : 0); } @@ -731,93 +776,103 @@ Tcl_SetStringObj(objPtr, bytes, length) * * Tcl_SetObjLength -- * - * This procedure changes the length of the string representation - * of an object. + * This function changes the length of the string representation of an + * object. * * Results: * None. * * Side effects: - * If the size of objPtr's string representation is greater than - * length, then it is reduced to length and a new terminating null - * byte is stored in the strength. If the length of the string - * representation is greater than length, the storage space is - * reallocated to the given length; a null byte is stored at the - * end, but other bytes past the end of the original string - * representation are undefined. The object's internal + * If the size of objPtr's string representation is greater than length, + * then it is reduced to length and a new terminating null byte is stored + * in the strength. If the length of the string representation is greater + * than length, the storage space is reallocated to the given length; a + * null byte is stored at the end, but other bytes past the end of the + * original string representation are undefined. The object's internal * representation is changed to "expendable string". * *---------------------------------------------------------------------- */ void -Tcl_SetObjLength(objPtr, length) - register Tcl_Obj *objPtr; /* Pointer to object. This object must - * not currently be shared. */ - register int length; /* Number of bytes desired for string +Tcl_SetObjLength( + Tcl_Obj *objPtr, /* Pointer to object. This object must not + * currently be shared. */ + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + /* + * Setting to a negative length is nonsense. This is probably the + * result of overflowing the signed integer range. + */ + + Tcl_Panic("Tcl_SetObjLength: negative length requested: " + "%d (integer overflow?)", length); + } if (Tcl_IsShared(objPtr)) { - panic("Tcl_SetObjLength called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } + + if (objPtr->bytes && objPtr->length == length) { + return; + } + SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - - /* Check that we're not extending a pure unicode string */ - - if (length > (int) stringPtr->allocated && - (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { - char *new; + if (objPtr->bytes != NULL) { /* - * Not enough space in current string. Reallocate the string - * space and free the old string. + * Change length of an existing string rep. */ - if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) { - new = (char *) ckrealloc((char *)objPtr->bytes, - (unsigned)(length+1)); - } else { - new = (char *) ckalloc((unsigned) (length+1)); - if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((VOID *) new, (VOID *) objPtr->bytes, - (size_t) objPtr->length); - Tcl_InvalidateStringRep(objPtr); + if (length > stringPtr->allocated) { + /* + * Need to enlarge the buffer. + */ + if (objPtr->bytes == tclEmptyStringRep) { + objPtr->bytes = ckalloc(length + 1); + } else { + objPtr->bytes = ckrealloc(objPtr->bytes, length + 1); } + stringPtr->allocated = length; } - objPtr->bytes = new; - stringPtr->allocated = length; - /* Invalidate the unicode data. */ + + objPtr->length = length; + objPtr->bytes[length] = 0; + + /* + * Invalidate the unicode data. + */ + + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; - } - - if (objPtr->bytes != NULL) { - objPtr->length = length; - if (objPtr->bytes != tclEmptyStringRep) { - /* Ensure the string is NULL-terminated */ - objPtr->bytes[length] = 0; - } - /* Invalidate the unicode data. */ - stringPtr->numChars = -1; - stringPtr->hasUnicode = 0; } else { - /* Changing length of pure unicode string */ - size_t uallocated = STRING_UALLOC(length); - if (uallocated > stringPtr->uallocated) { - stringPtr = (String *) ckrealloc((char*) stringPtr, - STRING_SIZE(uallocated)); - SET_STRING(objPtr, stringPtr); - stringPtr->uallocated = uallocated; - } - stringPtr->numChars = length; - stringPtr->hasUnicode = (length > 0); - /* Ensure the string is NULL-terminated */ - stringPtr->unicode[length] = 0; - stringPtr->allocated = 0; - objPtr->length = 0; + /* + * Changing length of pure unicode string. + */ + + stringCheckLimits(length); + if (length > stringPtr->maxChars) { + stringPtr = stringRealloc(stringPtr, length); + SET_STRING(objPtr, stringPtr); + stringPtr->maxChars = length; + } + + /* + * Mark the new end of the unicode string + */ + + stringPtr->numChars = length; + stringPtr->unicode[length] = 0; + stringPtr->hasUnicode = 1; + + /* + * Can only get here when objPtr->bytes == NULL. No need to invalidate + * the string rep. + */ } } @@ -826,102 +881,113 @@ Tcl_SetObjLength(objPtr, length) * * Tcl_AttemptSetObjLength -- * - * This procedure changes the length of the string representation - * of an object. It uses the attempt* (non-panic'ing) memory allocators. + * This function changes the length of the string representation of an + * object. It uses the attempt* (non-panic'ing) memory allocators. * * Results: * 1 if the requested memory was allocated, 0 otherwise. * * Side effects: - * If the size of objPtr's string representation is greater than - * length, then it is reduced to length and a new terminating null - * byte is stored in the strength. If the length of the string - * representation is greater than length, the storage space is - * reallocated to the given length; a null byte is stored at the - * end, but other bytes past the end of the original string - * representation are undefined. The object's internal + * If the size of objPtr's string representation is greater than length, + * then it is reduced to length and a new terminating null byte is stored + * in the strength. If the length of the string representation is greater + * than length, the storage space is reallocated to the given length; a + * null byte is stored at the end, but other bytes past the end of the + * original string representation are undefined. The object's internal * representation is changed to "expendable string". * *---------------------------------------------------------------------- */ int -Tcl_AttemptSetObjLength(objPtr, length) - register Tcl_Obj *objPtr; /* Pointer to object. This object must - * not currently be shared. */ - register int length; /* Number of bytes desired for string +Tcl_AttemptSetObjLength( + Tcl_Obj *objPtr, /* Pointer to object. This object must not + * currently be shared. */ + int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + /* + * Setting to a negative length is nonsense. This is probably the + * result of overflowing the signed integer range. + */ + + return 0; + } if (Tcl_IsShared(objPtr)) { - panic("Tcl_AttemptSetObjLength called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } + if (objPtr->bytes && objPtr->length == length) { + return 1; + } + SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - /* Check that we're not extending a pure unicode string */ - - if (length > (int) stringPtr->allocated && - (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { - char *new; - + if (objPtr->bytes != NULL) { /* - * Not enough space in current string. Reallocate the string - * space and free the old string. + * Change length of an existing string rep. */ - if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) { - new = (char *) attemptckrealloc((char *)objPtr->bytes, - (unsigned)(length+1)); - if (new == NULL) { - return 0; + if (length > stringPtr->allocated) { + /* + * Need to enlarge the buffer. + */ + + char *newBytes; + + if (objPtr->bytes == tclEmptyStringRep) { + newBytes = attemptckalloc(length + 1); + } else { + newBytes = attemptckrealloc(objPtr->bytes, length + 1); } - } else { - new = (char *) attemptckalloc((unsigned) (length+1)); - if (new == NULL) { + if (newBytes == NULL) { return 0; } - if (objPtr->bytes != NULL && objPtr->length != 0) { - memcpy((VOID *) new, (VOID *) objPtr->bytes, - (size_t) objPtr->length); - Tcl_InvalidateStringRep(objPtr); - } + objPtr->bytes = newBytes; + stringPtr->allocated = length; } - objPtr->bytes = new; - stringPtr->allocated = length; - /* Invalidate the unicode data. */ - stringPtr->hasUnicode = 0; - } - - if (objPtr->bytes != NULL) { + objPtr->length = length; - if (objPtr->bytes != tclEmptyStringRep) { - /* Ensure the string is NULL-terminated */ - objPtr->bytes[length] = 0; - } - /* Invalidate the unicode data. */ + objPtr->bytes[length] = 0; + + /* + * Invalidate the unicode data. + */ + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; } else { - /* Changing length of pure unicode string */ - size_t uallocated = STRING_UALLOC(length); - if (uallocated > stringPtr->uallocated) { - stringPtr = (String *) attemptckrealloc((char*) stringPtr, - STRING_SIZE(uallocated)); + /* + * Changing length of pure unicode string. + */ + + if (length > STRING_MAXCHARS) { + return 0; + } + if (length > stringPtr->maxChars) { + stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { - return 0; + return 0; } SET_STRING(objPtr, stringPtr); - stringPtr->uallocated = uallocated; + stringPtr->maxChars = length; } - stringPtr->numChars = length; - stringPtr->hasUnicode = (length > 0); - /* Ensure the string is NULL-terminated */ + + /* + * Mark the new end of the unicode string. + */ + stringPtr->unicode[length] = 0; - stringPtr->allocated = 0; - objPtr->length = 0; + stringPtr->numChars = length; + stringPtr->hasUnicode = 1; + + /* + * Can only get here when objPtr->bytes == NULL. No need to invalidate + * the string rep. + */ } return 1; } @@ -929,7 +995,7 @@ Tcl_AttemptSetObjLength(objPtr, length) /* *--------------------------------------------------------------------------- * - * TclSetUnicodeObj -- + * Tcl_SetUnicodeObj -- * * Modify an object to hold the Unicode string indicated by "unicode". * @@ -943,84 +1009,106 @@ Tcl_AttemptSetObjLength(objPtr, length) */ void -Tcl_SetUnicodeObj(objPtr, unicode, numChars) - Tcl_Obj *objPtr; /* The object to set the string of. */ - CONST Tcl_UniChar *unicode; /* The unicode string used to initialize - * the object. */ - int numChars; /* Number of characters in the unicode +Tcl_SetUnicodeObj( + Tcl_Obj *objPtr, /* The object to set the string of. */ + const Tcl_UniChar *unicode, /* The unicode string used to initialize the + * object. */ + int numChars) /* Number of characters in the unicode * string. */ { - Tcl_ObjType *typePtr; - String *stringPtr; - size_t uallocated; + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); + } + TclFreeIntRep(objPtr); + SetUnicodeObj(objPtr, unicode, numChars); +} - if (numChars < 0) { - numChars = 0; - if (unicode) { - while (unicode[numChars] != 0) { numChars++; } +static int +UnicodeLength( + const Tcl_UniChar *unicode) +{ + int numChars = 0; + + if (unicode) { + while (numChars >= 0 && unicode[numChars] != 0) { + numChars++; } } - uallocated = STRING_UALLOC(numChars); + stringCheckLimits(numChars); + return numChars; +} - /* - * Free the internal rep if one exists, and invalidate the string rep. - */ +static void +SetUnicodeObj( + Tcl_Obj *objPtr, /* The object to set the string of. */ + const Tcl_UniChar *unicode, /* The unicode string used to initialize the + * object. */ + int numChars) /* Number of characters in the unicode + * string. */ +{ + String *stringPtr; - typePtr = objPtr->typePtr; - if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) { - (*typePtr->freeIntRepProc)(objPtr); + if (numChars < 0) { + numChars = UnicodeLength(unicode); } - objPtr->typePtr = &tclStringType; /* * Allocate enough space for the String structure + Unicode string. */ - - stringPtr = (String *) ckalloc(STRING_SIZE(uallocated)); + + stringCheckLimits(numChars); + stringPtr = stringAlloc(numChars); + SET_STRING(objPtr, stringPtr); + objPtr->typePtr = &tclStringType; + + stringPtr->maxChars = numChars; + memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar)); + stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; - stringPtr->uallocated = uallocated; - stringPtr->hasUnicode = (numChars > 0); + stringPtr->hasUnicode = 1; + + TclInvalidateStringRep(objPtr); stringPtr->allocated = 0; - memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated); - stringPtr->unicode[numChars] = 0; - SET_STRING(objPtr, stringPtr); - Tcl_InvalidateStringRep(objPtr); - return; } /* *---------------------------------------------------------------------- * - * Tcl_AppendToObj -- + * Tcl_AppendLimitedToObj -- * - * This procedure appends a sequence of bytes to an object. + * This function appends a limited number of bytes from a sequence of + * bytes to an object, marking any limitation with an ellipsis. * * Results: * None. * * Side effects: - * The bytes at *bytes are appended to the string representation - * of objPtr. + * The bytes at *bytes are appended to the string representation of + * objPtr. * *---------------------------------------------------------------------- */ void -Tcl_AppendToObj(objPtr, bytes, length) - register Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* Points to the bytes to append to the +Tcl_AppendLimitedToObj( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const char *bytes, /* Points to the bytes to append to the * object. */ - register int length; /* The number of bytes to append from - * "bytes". If < 0, then append all bytes - * up to NULL byte. */ + int length, /* The number of bytes available to be + * appended from "bytes". If < 0, then all + * bytes up to a NUL byte are available. */ + int limit, /* The maximum number of bytes to append to + * the object. */ + const char *ellipsis) /* Ellipsis marker string, appended to the + * object to indicate not all available bytes + * at "bytes" were appended. */ { String *stringPtr; + int toCopy = 0; if (Tcl_IsShared(objPtr)) { - panic("Tcl_AppendToObj called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); } - - SetStringFromAny(NULL, objPtr); if (length < 0) { length = (bytes ? strlen(bytes) : 0); @@ -1029,29 +1117,78 @@ Tcl_AppendToObj(objPtr, bytes, length) return; } + if (length <= limit) { + toCopy = length; + } else { + if (ellipsis == NULL) { + ellipsis = "..."; + } + toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes; + } + /* - * If objPtr has a valid Unicode rep, then append the Unicode - * conversion of "bytes" to the objPtr's Unicode rep, otherwise - * append "bytes" to objPtr's string rep. + * If objPtr has a valid Unicode rep, then append the Unicode conversion + * of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to + * objPtr's string rep. */ + SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode != 0) { - AppendUtfToUnicodeRep(objPtr, bytes, length); - stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { - AppendUtfToUtfRep(objPtr, bytes, length); + AppendUtfToUtfRep(objPtr, bytes, toCopy); + } + + if (length <= limit) { + return; + } + + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis)); + } else { + AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis)); } } /* *---------------------------------------------------------------------- * + * Tcl_AppendToObj -- + * + * This function appends a sequence of bytes to an object. + * + * Results: + * None. + * + * Side effects: + * The bytes at *bytes are appended to the string representation of + * objPtr. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AppendToObj( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const char *bytes, /* Points to the bytes to append to the + * object. */ + int length) /* The number of bytes to append from "bytes". + * If < 0, then append all bytes up to NUL + * byte. */ +{ + Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_AppendUnicodeToObj -- * - * This procedure appends a Unicode string to an object in the - * most efficient manner possible. Length must be >= 0. + * This function appends a Unicode string to an object in the most + * efficient manner possible. Length must be >= 0. * * Results: * None. @@ -1063,16 +1200,16 @@ Tcl_AppendToObj(objPtr, bytes, length) */ void -Tcl_AppendUnicodeToObj(objPtr, unicode, length) - register Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* The unicode string to append to the - * object. */ - int length; /* Number of chars in "unicode". */ +Tcl_AppendUnicodeToObj( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const Tcl_UniChar *unicode, /* The unicode string to append to the + * object. */ + int length) /* Number of chars in "unicode". */ { String *stringPtr; if (Tcl_IsShared(objPtr)) { - panic("Tcl_AppendUnicodeToObj called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj"); } if (length == 0) { @@ -1083,12 +1220,16 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length) stringPtr = GET_STRING(objPtr); /* - * If objPtr has a valid Unicode rep, then append the "unicode" - * to the objPtr's Unicode rep, otherwise the UTF conversion of - * "unicode" to objPtr's string rep. + * If objPtr has a valid Unicode rep, then append the "unicode" to the + * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to + * objPtr's string rep. */ - if (stringPtr->hasUnicode != 0) { + if (stringPtr->hasUnicode +#if COMPAT + && stringPtr->numChars > 0 +#endif + ) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); @@ -1100,87 +1241,141 @@ Tcl_AppendUnicodeToObj(objPtr, unicode, length) * * Tcl_AppendObjToObj -- * - * This procedure appends the string rep of one object to another. + * This function appends the string rep of one object to another. * "objPtr" cannot be a shared object. * * Results: * None. * * Side effects: - * The string rep of appendObjPtr is appended to the string + * The string rep of appendObjPtr is appended to the string * representation of objPtr. * *---------------------------------------------------------------------- */ void -Tcl_AppendObjToObj(objPtr, appendObjPtr) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - Tcl_Obj *appendObjPtr; /* Object to append. */ +Tcl_AppendObjToObj( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - int length, numChars, allOneByteChars; - char *bytes; + int length, numChars, appendNumChars = -1; + const char *bytes; - SetStringFromAny(NULL, objPtr); + /* + * Special case: second object is standard-empty is fast case. We know + * that appending nothing to anything leaves that starting anything... + */ + + if (appendObjPtr->bytes == tclEmptyStringRep) { + return; + } /* - * If objPtr has a valid Unicode rep, then get a Unicode string - * from appendObjPtr and append it. + * Handle append of one bytearray object to another as a special case. + * Note that we only do this when the objects don't have string reps; if + * it did, then appending the byte arrays together could well lose + * information; this is a special-case optimization only. */ + if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep) + && TclIsPureByteArray(appendObjPtr)) { + + /* + * You might expect the code here to be + * + * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); + * TclAppendBytesToByteArray(objPtr, bytes, length); + * + * and essentially all of the time that would be fine. However, + * it would run into trouble in the case where objPtr and + * appendObjPtr point to the same thing. That may never be a + * good idea. It seems to violate Copy On Write, and we don't + * have any tests for the situation, since making any Tcl commands + * that call Tcl_AppendObjToObj() do that appears impossible + * (They honor Copy On Write!). For the sake of extensions that + * go off into that realm, though, here's a more complex approach + * that can handle all the cases. + */ + + /* Get lengths */ + int lengthSrc; + + (void) Tcl_GetByteArrayFromObj(objPtr, &length); + (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); + + /* Grow buffer enough for the append */ + TclAppendBytesToByteArray(objPtr, NULL, lengthSrc); + + /* Reset objPtr back to the original value */ + Tcl_SetByteArrayLength(objPtr, length); + + /* + * Now do the append knowing that buffer growth cannot cause + * any trouble. + */ + + TclAppendBytesToByteArray(objPtr, + Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); + return; + } + + /* + * Must append as strings. + */ + + SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode != 0) { - + + /* + * If objPtr has a valid Unicode rep, then get a Unicode string from + * appendObjPtr and append it. + */ + + if (stringPtr->hasUnicode +#if COMPAT + && stringPtr->numChars > 0 +#endif + ) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ if (appendObjPtr->typePtr == &tclStringType) { - stringPtr = GET_STRING(appendObjPtr); - if ((stringPtr->numChars == -1) - || (stringPtr->hasUnicode == 0)) { - - /* - * If appendObjPtr is a string obj with no valid Unicode - * rep, then fill its unicode rep. - */ + Tcl_UniChar *unicode = + Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); - FillUnicodeRep(appendObjPtr); - stringPtr = GET_STRING(appendObjPtr); - } - AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode, - stringPtr->numChars); + AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); } else { - bytes = Tcl_GetStringFromObj(appendObjPtr, &length); + bytes = TclGetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); } return; } /* - * Append to objPtr's UTF string rep. If we know the number of - * characters in both objects before appending, then set the combined - * number of characters in the final (appended-to) object. + * Append to objPtr's UTF string rep. If we know the number of characters + * in both objects before appending, then set the combined number of + * characters in the final (appended-to) object. */ - bytes = Tcl_GetStringFromObj(appendObjPtr, &length); + bytes = TclGetStringFromObj(appendObjPtr, &length); - allOneByteChars = 0; numChars = stringPtr->numChars; if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) { - stringPtr = GET_STRING(appendObjPtr); - if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) { - numChars += stringPtr->numChars; - allOneByteChars = 1; - } + String *appendStringPtr = GET_STRING(appendObjPtr); + appendNumChars = appendStringPtr->numChars; } AppendUtfToUtfRep(objPtr, bytes, length); - if (allOneByteChars) { - stringPtr = GET_STRING(objPtr); - stringPtr->numChars = numChars; + if (numChars >= 0 && appendNumChars >= 0 +#if COMPAT + && appendNumChars == length +#endif + ) { + stringPtr->numChars = numChars + appendNumChars; } } @@ -1189,8 +1384,8 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr) * * AppendUnicodeToUnicodeRep -- * - * This procedure appends the contents of "unicode" to the Unicode - * rep of "objPtr". objPtr must already have a valid Unicode rep. + * This function appends the contents of "unicode" to the Unicode rep of + * "objPtr". objPtr must already have a valid Unicode rep. * * Results: * None. @@ -1202,19 +1397,16 @@ Tcl_AppendObjToObj(objPtr, appendObjPtr) */ static void -AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* String to append. */ - int appendNumChars; /* Number of chars of "unicode" to append. */ +AppendUnicodeToUnicodeRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const Tcl_UniChar *unicode, /* String to append. */ + int appendNumChars) /* Number of chars of "unicode" to append. */ { - String *stringPtr, *tmpString; - size_t numChars; + String *stringPtr; + int numChars; if (appendNumChars < 0) { - appendNumChars = 0; - if (unicode) { - while (unicode[appendNumChars] != 0) { appendNumChars++; } - } + appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { return; @@ -1224,28 +1416,40 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) stringPtr = GET_STRING(objPtr); /* - * If not enough space has been allocated for the unicode rep, - * reallocate the internal rep object with additional space. First - * try to double the required allocation; if that fails, try a more - * modest increase. See the "TCL STRING GROWTH ALGORITHM" comment at - * the top of this file for an explanation of this growth algorithm. + * If not enough space has been allocated for the unicode rep, reallocate + * the internal rep object with additional space. First try to double the + * required allocation; if that fails, try a more modest increase. See the + * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an + * explanation of this growth algorithm. */ numChars = stringPtr->numChars + appendNumChars; + stringCheckLimits(numChars); - if (STRING_UALLOC(numChars) >= stringPtr->uallocated) { - stringPtr->uallocated = STRING_UALLOC(2 * numChars); - tmpString = (String *) attemptckrealloc((char *)stringPtr, - STRING_SIZE(stringPtr->uallocated)); - if (tmpString == NULL) { - stringPtr->uallocated = - STRING_UALLOC(numChars + appendNumChars) - + TCL_GROWTH_MIN_ALLOC; - tmpString = (String *) ckrealloc((char *)stringPtr, - STRING_SIZE(stringPtr->uallocated)); + if (numChars > stringPtr->maxChars) { + int offset = -1; + + /* + * Protect against case where unicode points into the existing + * stringPtr->unicode array. Force it to follow any relocations due to + * the reallocs below. + */ + + if (unicode >= stringPtr->unicode + && unicode <= stringPtr->unicode + stringPtr->maxChars) { + offset = unicode - stringPtr->unicode; + } + + GrowUnicodeBuffer(objPtr, numChars); + stringPtr = GET_STRING(objPtr); + + /* + * Relocate unicode if needed; see above. + */ + + if (offset >= 0) { + unicode = stringPtr->unicode + offset; } - stringPtr = tmpString; - SET_STRING(objPtr, stringPtr); } /* @@ -1253,12 +1457,13 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) * trailing null. */ - memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode, + memmove(stringPtr->unicode + stringPtr->numChars, unicode, appendNumChars * sizeof(Tcl_UniChar)); stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; + stringPtr->allocated = 0; - Tcl_InvalidateStringRep(objPtr); + TclInvalidateStringRep(objPtr); } /* @@ -1266,8 +1471,8 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) * * AppendUnicodeToUtfRep -- * - * This procedure converts the contents of "unicode" to UTF and - * appends the UTF to the string rep of "objPtr". + * This function converts the contents of "unicode" to UTF and appends + * the UTF to the string rep of "objPtr". * * Results: * None. @@ -1279,28 +1484,26 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars) */ static void -AppendUnicodeToUtfRep(objPtr, unicode, numChars) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST Tcl_UniChar *unicode; /* String to convert to UTF. */ - int numChars; /* Number of chars of "unicode" to convert. */ +AppendUnicodeToUtfRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const Tcl_UniChar *unicode, /* String to convert to UTF. */ + int numChars) /* Number of chars of "unicode" to convert. */ { - Tcl_DString dsPtr; - CONST char *bytes; - - if (numChars < 0) { - numChars = 0; - if (unicode) { - while (unicode[numChars] != 0) { numChars++; } - } - } - if (numChars == 0) { - return; + String *stringPtr = GET_STRING(objPtr); + + numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); + + if (stringPtr->numChars != -1) { + stringPtr->numChars += numChars; } - Tcl_DStringInit(&dsPtr); - bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr); - AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr)); - Tcl_DStringFree(&dsPtr); +#if COMPAT + /* + * Invalidate the unicode rep. + */ + + stringPtr->hasUnicode = 0; +#endif } /* @@ -1308,9 +1511,9 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars) * * AppendUtfToUnicodeRep -- * - * This procedure converts the contents of "bytes" to Unicode and - * appends the Unicode to the Unicode rep of "objPtr". objPtr must - * already have a valid Unicode rep. + * This function converts the contents of "bytes" to Unicode and appends + * the Unicode to the Unicode rep of "objPtr". objPtr must already have a + * valid Unicode rep. numBytes must be non-negative. * * Results: * None. @@ -1322,27 +1525,21 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars) */ static void -AppendUtfToUnicodeRep(objPtr, bytes, numBytes) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* String to convert to Unicode. */ - int numBytes; /* Number of bytes of "bytes" to convert. */ +AppendUtfToUnicodeRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const char *bytes, /* String to convert to Unicode. */ + int numBytes) /* Number of bytes of "bytes" to convert. */ { - Tcl_DString dsPtr; - int numChars; - Tcl_UniChar *unicode; + String *stringPtr; - if (numBytes < 0) { - numBytes = (bytes ? strlen(bytes) : 0); - } if (numBytes == 0) { return; } - - Tcl_DStringInit(&dsPtr); - numChars = Tcl_NumUtfChars(bytes, numBytes); - unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr); - AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); - Tcl_DStringFree(&dsPtr); + + ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1); + TclInvalidateStringRep(objPtr); + stringPtr = GET_STRING(objPtr); + stringPtr->allocated = 0; } /* @@ -1350,8 +1547,9 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes) * * AppendUtfToUtfRep -- * - * This procedure appends "numBytes" bytes of "bytes" to the UTF string - * rep of "objPtr". objPtr must already have a valid String rep. + * This function appends "numBytes" bytes of "bytes" to the UTF string + * rep of "objPtr". objPtr must already have a valid String rep. + * numBytes must be non-negative. * * Results: * None. @@ -1363,17 +1561,14 @@ AppendUtfToUnicodeRep(objPtr, bytes, numBytes) */ static void -AppendUtfToUtfRep(objPtr, bytes, numBytes) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - CONST char *bytes; /* String to append. */ - int numBytes; /* Number of bytes of "bytes" to append. */ +AppendUtfToUtfRep( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + const char *bytes, /* String to append. */ + int numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; int newLength, oldLength; - if (numBytes < 0) { - numBytes = (bytes ? strlen(bytes) : 0); - } if (numBytes == 0) { return; } @@ -1383,35 +1578,54 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes) * trailing null. */ + if (objPtr->bytes == NULL) { + objPtr->length = 0; + } oldLength = objPtr->length; newLength = numBytes + oldLength; + if (newLength < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } stringPtr = GET_STRING(objPtr); - if (newLength > (int) stringPtr->allocated) { + if (newLength > stringPtr->allocated) { + int offset = -1; + + /* + * Protect against case where unicode points into the existing + * stringPtr->unicode array. Force it to follow any relocations due to + * the reallocs below. + */ + + if (bytes >= objPtr->bytes + && bytes <= objPtr->bytes + objPtr->length) { + offset = bytes - objPtr->bytes; + } + + /* + * TODO: consider passing flag=1: no overalloc on first append. This + * would make test stringObj-8.1 fail. + */ + + GrowStringBuffer(objPtr, newLength, 0); /* - * There isn't currently enough space in the string representation - * so allocate additional space. First, try to double the length - * required. If that fails, try a more modest allocation. See the - * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an - * explanation of this growth algorithm. + * Relocate bytes if needed; see above. */ - if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { - Tcl_SetObjLength(objPtr, - newLength + numBytes + TCL_GROWTH_MIN_ALLOC); + if (offset >= 0) { + bytes = objPtr->bytes + offset; } } /* * Invalidate the unicode data. */ - + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; - - memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes, - (size_t) numBytes); + + memmove(objPtr->bytes + oldLength, bytes, numBytes); objPtr->bytes[newLength] = 0; objPtr->length = newLength; } @@ -1421,242 +1635,1224 @@ AppendUtfToUtfRep(objPtr, bytes, numBytes) * * Tcl_AppendStringsToObjVA -- * - * This procedure appends one or more null-terminated strings - * to an object. + * This function appends one or more null-terminated strings to an + * object. * * Results: * None. * * Side effects: - * The contents of all the string arguments are appended to the - * string representation of objPtr. + * The contents of all the string arguments are appended to the string + * representation of objPtr. * *---------------------------------------------------------------------- */ void -Tcl_AppendStringsToObjVA (objPtr, argList) - Tcl_Obj *objPtr; /* Points to the object to append to. */ - va_list argList; /* Variable argument list. */ +Tcl_AppendStringsToObjVA( + Tcl_Obj *objPtr, /* Points to the object to append to. */ + va_list argList) /* Variable argument list. */ { -#define STATIC_LIST_SIZE 16 - String *stringPtr; - int newLength, oldLength, attemptLength; - register char *string, *dst; - char *static_list[STATIC_LIST_SIZE]; - char **args = static_list; - int nargs_space = STATIC_LIST_SIZE; - int nargs, i; - if (Tcl_IsShared(objPtr)) { - panic("Tcl_AppendStringsToObj called with shared object"); + Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj"); } - SetStringFromAny(NULL, objPtr); + while (1) { + const char *bytes = va_arg(argList, char *); + + if (bytes == NULL) { + break; + } + Tcl_AppendToObj(objPtr, bytes, -1); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendStringsToObj -- + * + * This function appends one or more null-terminated strings to an + * object. + * + * Results: + * None. + * + * Side effects: + * The contents of all the string arguments are appended to the string + * representation of objPtr. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AppendStringsToObj( + Tcl_Obj *objPtr, + ...) +{ + va_list argList; + + va_start(argList, objPtr); + Tcl_AppendStringsToObjVA(objPtr, argList); + va_end(argList); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendFormatToObj -- + * + * This function appends a list of Tcl_Obj's to a Tcl_Obj according to + * the formatting instructions embedded in the format string. The + * formatting instructions are inspired by sprintf(). Returns TCL_OK when + * successful. If there's an error in the arguments, TCL_ERROR is + * returned, and an error message is written to the interp, if non-NULL. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_AppendFormatToObj( + Tcl_Interp *interp, + Tcl_Obj *appendObj, + const char *format, + int objc, + Tcl_Obj *const objv[]) +{ + const char *span = format, *msg, *errCode; + int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; + int originalLength, limit; + static const char *mixedXPG = + "cannot mix \"%\" and \"%n$\" conversion specifiers"; + static const char *const badIndex[2] = { + "not enough arguments for all format specifiers", + "\"%n$\" argument index out of range" + }; + static const char *overflow = "max size for a Tcl value exceeded"; + + if (Tcl_IsShared(appendObj)) { + Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); + } + TclGetStringFromObj(appendObj, &originalLength); + limit = INT_MAX - originalLength; /* - * Figure out how much space is needed for all the strings, and - * expand the string representation if it isn't big enough. If no - * bytes would be appended, just return. Note that on some platforms - * (notably OS/390) the argList is an array so we need to use memcpy. + * Format string is NUL-terminated. */ - nargs = 0; - newLength = 0; - oldLength = objPtr->length; - while (1) { - string = va_arg(argList, char *); - if (string == NULL) { - break; + while (*format != '\0') { + char *end; + int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag; + int width, gotPrecision, precision, useShort, useWide, useBig; + int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; + Tcl_Obj *segment; + Tcl_UniChar ch; + int step = Tcl_UtfToUniChar(format, &ch); + + format += step; + if (ch != '%') { + numBytes += step; + continue; + } + if (numBytes) { + if (numBytes > limit) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + Tcl_AppendToObj(appendObj, span, numBytes); + limit -= numBytes; + numBytes = 0; } - if (nargs >= nargs_space) { - /* - * Expand the args buffer - */ - nargs_space += STATIC_LIST_SIZE; - if (args == static_list) { - args = (void *)ckalloc(nargs_space * sizeof(char *)); - for (i = 0; i < nargs; ++i) { - args[i] = static_list[i]; - } - } else { - args = (void *)ckrealloc((void *)args, - nargs_space * sizeof(char *)); - } - } - newLength += strlen(string); - args[nargs++] = string; - } - if (newLength == 0) { - goto done; - } - stringPtr = GET_STRING(objPtr); - if (oldLength + newLength > (int) stringPtr->allocated) { + /* + * Saw a % : process the format specifier. + * + * Step 0. Handle special case of escaped format marker (i.e., %%). + */ + + step = Tcl_UtfToUniChar(format, &ch); + if (ch == '%') { + span = format; + numBytes = step; + format += step; + continue; + } /* - * There isn't currently enough space in the string - * representation, so allocate additional space. If the current - * string representation isn't empty (i.e. it looks like we're - * doing a series of appends) then try to allocate extra space to - * accomodate future growth: first try to double the required memory; - * if that fails, try a more modest allocation. See the "TCL STRING - * GROWTH ALGORITHM" comment at the top of this file for an explanation - * of this growth algorithm. Otherwise, if the current string - * representation is empty, exactly enough memory is allocated. + * Step 1. XPG3 position specifier */ - if (oldLength == 0) { - Tcl_SetObjLength(objPtr, newLength); + newXpg = 0; + if (isdigit(UCHAR(ch))) { + int position = strtoul(format, &end, 10); + + if (*end == '$') { + newXpg = 1; + objIndex = position - 1; + format = end + 1; + step = Tcl_UtfToUniChar(format, &ch); + } + } + if (newXpg) { + if (gotSequential) { + msg = mixedXPG; + errCode = "MIXEDSPECTYPES"; + goto errorMsg; + } + gotXpg = 1; } else { - attemptLength = 2 * (oldLength + newLength); - if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) { - attemptLength = oldLength + (2 * newLength) + - TCL_GROWTH_MIN_ALLOC; - Tcl_SetObjLength(objPtr, attemptLength); + if (gotXpg) { + msg = mixedXPG; + errCode = "MIXEDSPECTYPES"; + goto errorMsg; } + gotSequential = 1; + } + if ((objIndex < 0) || (objIndex >= objc)) { + msg = badIndex[gotXpg]; + errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; + goto errorMsg; } - } - /* - * Make a second pass through the arguments, appending all the - * strings to the object. - */ + /* + * Step 2. Set of flags. + */ + + gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0; + sawFlag = 1; + do { + switch (ch) { + case '-': + gotMinus = 1; + break; + case '#': + gotHash = 1; + break; + case '0': + gotZero = 1; + break; + case ' ': + gotSpace = 1; + break; + case '+': + gotPlus = 1; + break; + default: + sawFlag = 0; + } + if (sawFlag) { + format += step; + step = Tcl_UtfToUniChar(format, &ch); + } + } while (sawFlag); + + /* + * Step 3. Minimum field width. + */ + + width = 0; + if (isdigit(UCHAR(ch))) { + width = strtoul(format, &end, 10); + format = end; + step = Tcl_UtfToUniChar(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; + goto errorMsg; + } + if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { + goto error; + } + if (width < 0) { + width = -width; + gotMinus = 1; + } + objIndex++; + format += step; + step = Tcl_UtfToUniChar(format, &ch); + } + if (width > limit) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + + /* + * Step 4. Precision. + */ + + gotPrecision = precision = 0; + if (ch == '.') { + gotPrecision = 1; + format += step; + step = Tcl_UtfToUniChar(format, &ch); + } + if (isdigit(UCHAR(ch))) { + precision = strtoul(format, &end, 10); + format = end; + step = Tcl_UtfToUniChar(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; + goto errorMsg; + } + if (TclGetIntFromObj(interp, objv[objIndex], &precision) + != TCL_OK) { + goto error; + } + + /* + * TODO: Check this truncation logic. + */ + + if (precision < 0) { + precision = 0; + } + objIndex++; + format += step; + step = Tcl_UtfToUniChar(format, &ch); + } + + /* + * Step 5. Length modifier. + */ + + useShort = useWide = useBig = 0; + if (ch == 'h') { + useShort = 1; + format += step; + step = Tcl_UtfToUniChar(format, &ch); + } else if (ch == 'l') { + format += step; + step = Tcl_UtfToUniChar(format, &ch); + if (ch == 'l') { + useBig = 1; + format += step; + step = Tcl_UtfToUniChar(format, &ch); +#ifndef TCL_WIDE_INT_IS_LONG + } else { + useWide = 1; +#endif + } + } + + format += step; + span = format; + + /* + * Step 6. The actual conversion character. + */ + + segment = objv[objIndex]; + numChars = -1; + if (ch == 'i') { + ch = 'd'; + } + switch (ch) { + case '\0': + msg = "format string ended in middle of field specifier"; + errCode = "INCOMPLETE"; + goto errorMsg; + case 's': + if (gotPrecision) { + numChars = Tcl_GetCharLength(segment); + if (precision < numChars) { + segment = Tcl_GetRange(segment, 0, precision - 1); + numChars = precision; + Tcl_IncrRefCount(segment); + allocSegment = 1; + } + } + break; + case 'c': { + char buf[TCL_UTF_MAX]; + int code, length; + + if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) { + goto error; + } + length = Tcl_UniCharToUtf(code, buf); + segment = Tcl_NewStringObj(buf, length); + Tcl_IncrRefCount(segment); + allocSegment = 1; + break; + } + + case 'u': + if (useBig) { + msg = "unsigned bignum format is invalid"; + errCode = "BADUNSIGNED"; + goto errorMsg; + } + case 'd': + case 'o': + case 'x': + case 'X': + case 'b': { + short s = 0; /* Silence compiler warning; only defined and + * used when useShort is true. */ + long l; + Tcl_WideInt w; + mp_int big; + int toAppend, isNegative = 0; + + if (useBig) { + if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) { + goto error; + } + isNegative = (mp_cmp_d(&big, 0) == MP_LT); + } else if (useWide) { + if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { + Tcl_Obj *objPtr; + + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { + goto error; + } + mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big); + objPtr = Tcl_NewBignumObj(&big); + Tcl_IncrRefCount(objPtr); + Tcl_GetWideIntFromObj(NULL, objPtr, &w); + Tcl_DecrRefCount(objPtr); + } + isNegative = (w < (Tcl_WideInt) 0); + } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { + if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { + Tcl_Obj *objPtr; + + if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) { + goto error; + } + mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big); + objPtr = Tcl_NewBignumObj(&big); + Tcl_IncrRefCount(objPtr); + TclGetLongFromObj(NULL, objPtr, &l); + Tcl_DecrRefCount(objPtr); + } else { + l = Tcl_WideAsLong(w); + } + if (useShort) { + s = (short) l; + isNegative = (s < (short) 0); + } else { + isNegative = (l < (long) 0); + } + } else if (useShort) { + s = (short) l; + isNegative = (s < (short) 0); + } else { + isNegative = (l < (long) 0); + } + + segment = Tcl_NewObj(); + allocSegment = 1; + segmentLimit = INT_MAX; + Tcl_IncrRefCount(segment); + + if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) { + Tcl_AppendToObj(segment, + (isNegative ? "-" : gotPlus ? "+" : " "), 1); + segmentLimit -= 1; + } + + if (gotHash) { + switch (ch) { + case 'o': + Tcl_AppendToObj(segment, "0", 1); + segmentLimit -= 1; + precision--; + break; + case 'x': + case 'X': + Tcl_AppendToObj(segment, "0x", 2); + segmentLimit -= 2; + break; + case 'b': + Tcl_AppendToObj(segment, "0b", 2); + segmentLimit -= 2; + break; + } + } + + switch (ch) { + case 'd': { + int length; + Tcl_Obj *pure; + const char *bytes; + + if (useShort) { + pure = Tcl_NewIntObj((int) s); + } else if (useWide) { + pure = Tcl_NewWideIntObj(w); + } else if (useBig) { + pure = Tcl_NewBignumObj(&big); + } else { + pure = Tcl_NewLongObj(l); + } + Tcl_IncrRefCount(pure); + bytes = TclGetStringFromObj(pure, &length); + + /* + * Already did the sign above. + */ + + if (*bytes == '-') { + length--; + bytes++; + } + toAppend = length; + + /* + * Canonical decimal string reps for integers are composed + * entirely of one-byte encoded characters, so "length" is the + * number of chars. + */ + + if (gotPrecision) { + if (length < precision) { + segmentLimit -= precision - length; + } + while (length < precision) { + Tcl_AppendToObj(segment, "0", 1); + length++; + } + gotZero = 0; + } + if (gotZero) { + length += Tcl_GetCharLength(segment); + if (length < width) { + segmentLimit -= width - length; + } + while (length < width) { + Tcl_AppendToObj(segment, "0", 1); + length++; + } + } + if (toAppend > segmentLimit) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + Tcl_AppendToObj(segment, bytes, toAppend); + Tcl_DecrRefCount(pure); + break; + } + + case 'u': + case 'o': + case 'x': + case 'X': + case 'b': { + Tcl_WideUInt bits = (Tcl_WideUInt) 0; + Tcl_WideInt numDigits = (Tcl_WideInt) 0; + int length, numBits = 4, base = 16, index = 0, shift = 0; + Tcl_Obj *pure; + char *bytes; + + if (ch == 'u') { + base = 10; + } else if (ch == 'o') { + base = 8; + numBits = 3; + } else if (ch == 'b') { + base = 2; + numBits = 1; + } + if (useShort) { + unsigned short us = (unsigned short) s; + + bits = (Tcl_WideUInt) us; + while (us) { + numDigits++; + us /= base; + } + } else if (useWide) { + Tcl_WideUInt uw = (Tcl_WideUInt) w; + + bits = uw; + while (uw) { + numDigits++; + uw /= base; + } + } else if (useBig && big.used) { + int leftover = (big.used * DIGIT_BIT) % numBits; + mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); + + numDigits = 1 + + (((Tcl_WideInt) big.used * DIGIT_BIT) / numBits); + while ((mask & big.dp[big.used-1]) == 0) { + numDigits--; + mask >>= numBits; + } + if (numDigits > INT_MAX) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + } else if (!useBig) { + unsigned long ul = (unsigned long) l; + + bits = (Tcl_WideUInt) ul; + while (ul) { + numDigits++; + ul /= base; + } + } + + /* + * Need to be sure zero becomes "0", not "". + */ + + if ((numDigits == 0) && !((ch == 'o') && gotHash)) { + numDigits = 1; + } + pure = Tcl_NewObj(); + Tcl_SetObjLength(pure, (int) numDigits); + bytes = TclGetString(pure); + toAppend = length = (int) numDigits; + while (numDigits--) { + int digitOffset; + + if (useBig && big.used) { + if (index < big.used && (size_t) shift < + CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) { + bits |= ((Tcl_WideUInt) big.dp[index++]) << shift; + shift += DIGIT_BIT; + } + shift -= numBits; + } + digitOffset = (int) (bits % base); + if (digitOffset > 9) { + bytes[numDigits] = 'a' + digitOffset - 10; + } else { + bytes[numDigits] = '0' + digitOffset; + } + bits /= base; + } + if (useBig) { + mp_clear(&big); + } + if (gotPrecision) { + if (length < precision) { + segmentLimit -= precision - length; + } + while (length < precision) { + Tcl_AppendToObj(segment, "0", 1); + length++; + } + gotZero = 0; + } + if (gotZero) { + length += Tcl_GetCharLength(segment); + if (length < width) { + segmentLimit -= width - length; + } + while (length < width) { + Tcl_AppendToObj(segment, "0", 1); + length++; + } + } + if (toAppend > segmentLimit) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + Tcl_AppendObjToObj(segment, pure); + Tcl_DecrRefCount(pure); + break; + } + + } + break; + } + + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': { +#define MAX_FLOAT_SIZE 320 + char spec[2*TCL_INTEGER_SPACE + 9], *p = spec; + double d; + int length = MAX_FLOAT_SIZE; + char *bytes; + + if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) { + /* TODO: Figure out ACCEPT_NAN here */ + goto error; + } + *p++ = '%'; + if (gotMinus) { + *p++ = '-'; + } + if (gotHash) { + *p++ = '#'; + } + if (gotZero) { + *p++ = '0'; + } + if (gotSpace) { + *p++ = ' '; + } + if (gotPlus) { + *p++ = '+'; + } + if (width) { + p += sprintf(p, "%d", width); + if (width > length) { + length = width; + } + } + if (gotPrecision) { + *p++ = '.'; + p += sprintf(p, "%d", precision); + if (precision > INT_MAX - length) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + length += precision; + } + + /* + * Don't pass length modifiers! + */ + + *p++ = (char) ch; + *p = '\0'; - dst = objPtr->bytes + oldLength; - for (i = 0; i < nargs; ++i) { - string = args[i]; - if (string == NULL) { + segment = Tcl_NewObj(); + allocSegment = 1; + if (!Tcl_AttemptSetObjLength(segment, length)) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + bytes = TclGetString(segment); + if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } break; } - while (*string != 0) { - *dst = *string; - dst++; - string++; + default: + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); + } + goto error; + } + + switch (ch) { + case 'E': + case 'G': + case 'X': { + Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment))); + } + } + + if (width>0 && numChars<0) { + numChars = Tcl_GetCharLength(segment); + } + if (!gotMinus && width>0) { + if (numChars < width) { + limit -= width - numChars; + } + while (numChars < width) { + Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); + numChars++; + } + } + + Tcl_GetStringFromObj(segment, &segmentNumBytes); + if (segmentNumBytes > limit) { + if (allocSegment) { + Tcl_DecrRefCount(segment); + } + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; } + Tcl_AppendObjToObj(appendObj, segment); + limit -= segmentNumBytes; + if (allocSegment) { + Tcl_DecrRefCount(segment); + } + if (width > 0) { + if (numChars < width) { + limit -= width-numChars; + } + while (numChars < width) { + Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); + numChars++; + } + } + + objIndex += gotSequential; + } + if (numBytes) { + if (numBytes > limit) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + Tcl_AppendToObj(appendObj, span, numBytes); + limit -= numBytes; + numBytes = 0; } - /* - * Add a null byte to terminate the string. However, be careful: - * it's possible that the object is totally empty (if it was empty - * originally and there was nothing to append). In this case dst is - * NULL; just leave everything alone. - */ + return TCL_OK; - if (dst != NULL) { - *dst = 0; + errorMsg: + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL); } - objPtr->length = oldLength + newLength; + error: + Tcl_SetObjLength(appendObj, originalLength); + return TCL_ERROR; +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_Format-- + * + * Results: + * A refcount zero Tcl_Obj. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ - done: - /* - * If we had to allocate a buffer from the heap, - * free it now. - */ - - if (args != static_list) { - ckfree((void *)args); +Tcl_Obj * +Tcl_Format( + Tcl_Interp *interp, + const char *format, + int objc, + Tcl_Obj *const objv[]) +{ + int result; + Tcl_Obj *objPtr = Tcl_NewObj(); + + result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv); + if (result != TCL_OK) { + Tcl_DecrRefCount(objPtr); + return NULL; } -#undef STATIC_LIST_SIZE + return objPtr; } /* - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- * - * Tcl_AppendStringsToObj -- + * AppendPrintfToObjVA -- * - * This procedure appends one or more null-terminated strings - * to an object. + * Results: + * + * Side effects: + * + *--------------------------------------------------------------------------- + */ + +static void +AppendPrintfToObjVA( + Tcl_Obj *objPtr, + const char *format, + va_list argList) +{ + int code, objc; + Tcl_Obj **objv, *list = Tcl_NewObj(); + const char *p; + + p = format; + Tcl_IncrRefCount(list); + while (*p != '\0') { + int size = 0, seekingConversion = 1, gotPrecision = 0; + int lastNum = -1; + + if (*p++ != '%') { + continue; + } + if (*p == '%') { + p++; + continue; + } + do { + switch (*p) { + case '\0': + seekingConversion = 0; + break; + case 's': { + const char *q, *end, *bytes = va_arg(argList, char *); + seekingConversion = 0; + + /* + * The buffer to copy characters from starts at bytes and ends + * at either the first NUL byte, or after lastNum bytes, when + * caller has indicated a limit. + */ + + end = bytes; + while ((!gotPrecision || lastNum--) && (*end != '\0')) { + end++; + } + + /* + * Within that buffer, we trim both ends if needed so that we + * copy only whole characters, and avoid copying any partial + * multi-byte characters. + */ + + q = Tcl_UtfPrev(end, bytes); + if (!Tcl_UtfCharComplete(q, (int)(end - q))) { + end = q; + } + + q = bytes + TCL_UTF_MAX; + while ((bytes < end) && (bytes < q) + && ((*bytes & 0xC0) == 0x80)) { + bytes++; + } + + Tcl_ListObjAppendElement(NULL, list, + Tcl_NewStringObj(bytes , (int)(end - bytes))); + + break; + } + case 'c': + case 'i': + case 'u': + case 'd': + case 'o': + case 'x': + case 'X': + seekingConversion = 0; + switch (size) { + case -1: + case 0: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( + (long) va_arg(argList, int))); + break; + case 1: + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( + va_arg(argList, long))); + break; + } + break; + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj( + va_arg(argList, double))); + seekingConversion = 0; + break; + case '*': + lastNum = (int) va_arg(argList, int); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); + p++; + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': { + char *end; + + lastNum = (int) strtoul(p, &end, 10); + p = end; + break; + } + case '.': + gotPrecision = 1; + p++; + break; + /* TODO: support for wide (and bignum?) arguments */ + case 'l': + size = 1; + p++; + break; + case 'h': + size = -1; + default: + p++; + } + } while (seekingConversion); + } + TclListObjGetElements(NULL, list, &objc, &objv); + code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); + if (code != TCL_OK) { + Tcl_AppendPrintfToObj(objPtr, + "Unable to format \"%s\" with supplied arguments: %s", + format, Tcl_GetString(list)); + } + Tcl_DecrRefCount(list); +} + +/* + *--------------------------------------------------------------------------- + * + * Tcl_AppendPrintfToObj -- * * Results: - * None. + * A standard Tcl result. * * Side effects: - * The contents of all the string arguments are appended to the - * string representation of objPtr. + * None. * - *---------------------------------------------------------------------- + *--------------------------------------------------------------------------- */ void -Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1) +Tcl_AppendPrintfToObj( + Tcl_Obj *objPtr, + const char *format, + ...) { - register Tcl_Obj *objPtr; va_list argList; - objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList); - Tcl_AppendStringsToObjVA(objPtr, argList); + va_start(argList, format); + AppendPrintfToObjVA(objPtr, format, argList); va_end(argList); } /* *--------------------------------------------------------------------------- * - * FillUnicodeRep -- - * - * Populate the Unicode internal rep with the Unicode form of its string - * rep. The object must alread have a "String" internal rep. + * Tcl_ObjPrintf -- * * Results: + * A refcount zero Tcl_Obj. + * + * Side effects: * None. * + *--------------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_ObjPrintf( + const char *format, + ...) +{ + va_list argList; + Tcl_Obj *objPtr = Tcl_NewObj(); + + va_start(argList, format); + AppendPrintfToObjVA(objPtr, format, argList); + va_end(argList); + return objPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * TclStringObjReverse -- + * + * Implements the [string reverse] operation. + * + * Results: + * An unshared Tcl value which is the [string reverse] of the argument + * supplied. When sharing rules permit, the returned value might be the + * argument with modifications done in place. + * * Side effects: - * Reallocates the String internal rep. + * May allocate a new Tcl_Obj. * *--------------------------------------------------------------------------- */ static void -FillUnicodeRep(objPtr) - Tcl_Obj *objPtr; /* The object in which to fill the unicode rep. */ +ReverseBytes( + unsigned char *to, /* Copy bytes into here... */ + unsigned char *from, /* ...from here... */ + int count) /* Until this many are copied, */ + /* reversing as you go. */ +{ + unsigned char *src = from + count; + if (to == from) { + /* Reversing in place */ + while (--src > to) { + unsigned char c = *src; + *src = *to; + *to++ = c; + } + } else { + while (--src >= from) { + *to++ = *src; + } + } +} + +Tcl_Obj * +TclStringObjReverse( + Tcl_Obj *objPtr) { String *stringPtr; - size_t uallocated; - char *src, *srcEnd; - Tcl_UniChar *dst; - src = objPtr->bytes; - + Tcl_UniChar ch; + + if (TclIsPureByteArray(objPtr)) { + int numBytes; + unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_NewByteArrayObj(NULL, numBytes); + } + ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes); + return objPtr; + } + + SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->numChars == -1) { - stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length); + + if (stringPtr->hasUnicode) { + Tcl_UniChar *from = Tcl_GetUnicode(objPtr); + Tcl_UniChar *src = from + stringPtr->numChars; + + if (Tcl_IsShared(objPtr)) { + Tcl_UniChar *to; + + /* + * Create a non-empty, pure unicode value, so we can coax + * Tcl_SetObjLength into growing the unicode rep buffer. + */ + + ch = 0; + objPtr = Tcl_NewUnicodeObj(&ch, 1); + Tcl_SetObjLength(objPtr, stringPtr->numChars); + to = Tcl_GetUnicode(objPtr); + while (--src >= from) { + *to++ = *src; + } + } else { + /* Reversing in place */ + while (--src > from) { + ch = *src; + *src = *from; + *from++ = ch; + } + } } - stringPtr->hasUnicode = (stringPtr->numChars > 0); - uallocated = STRING_UALLOC(stringPtr->numChars); - if (uallocated > stringPtr->uallocated) { - - /* - * If not enough space has been allocated for the unicode rep, - * reallocate the internal rep object. - */ + if (objPtr->bytes) { + int numChars = stringPtr->numChars; + int numBytes = objPtr->length; + char *to, *from = objPtr->bytes; - /* - * There isn't currently enough space in the Unicode - * representation so allocate additional space. If the current - * Unicode representation isn't empty (i.e. it looks like we've - * done some appends) then overallocate the space so - * that we won't have to do as much reallocation in the future. - */ + if (Tcl_IsShared(objPtr)) { + objPtr = Tcl_NewObj(); + Tcl_SetObjLength(objPtr, numBytes); + } + to = objPtr->bytes; + + if (numChars < numBytes) { + /* + * Either numChars == -1 and we don't know how many chars are + * represented by objPtr->bytes and we need Pass 1 just in case, + * or numChars >= 0 and we know we have fewer chars than bytes, + * so we know there's a multibyte character needing Pass 1. + * + * Pass 1. Reverse the bytes of each multi-byte character. + */ + int charCount = 0; + int bytesLeft = numBytes; + + while (bytesLeft) { + /* + * NOTE: We know that the from buffer is NUL-terminated. + * It's part of the contract for objPtr->bytes values. + * Thus, we can skip calling Tcl_UtfCharComplete() here. + */ + int bytesInChar = Tcl_UtfToUniChar(from, &ch); + + ReverseBytes((unsigned char *)to, (unsigned char *)from, + bytesInChar); + to += bytesInChar; + from += bytesInChar; + bytesLeft -= bytesInChar; + charCount++; + } - if (stringPtr->uallocated > 0) { - uallocated *= 2; + from = to = objPtr->bytes; + stringPtr->numChars = charCount; } - stringPtr = (String *) ckrealloc((char*) stringPtr, - STRING_SIZE(uallocated)); - stringPtr->uallocated = uallocated; + /* Pass 2. Reverse all the bytes. */ + ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes); } - /* - * Convert src to Unicode and store the coverted data in "unicode". - */ - - srcEnd = src + objPtr->length; - for (dst = stringPtr->unicode; src < srcEnd; dst++) { - src += TclUtfToUniChar(src, dst); + return objPtr; +} + +/* + *--------------------------------------------------------------------------- + * + * FillUnicodeRep -- + * + * Populate the Unicode internal rep with the Unicode form of its string + * rep. The object must alread have a "String" internal rep. + * + * Results: + * None. + * + * Side effects: + * Reallocates the String internal rep. + * + *--------------------------------------------------------------------------- + */ + +static void +FillUnicodeRep( + Tcl_Obj *objPtr) /* The object in which to fill the unicode + * rep. */ +{ + String *stringPtr = GET_STRING(objPtr); + + ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length, + stringPtr->numChars); +} + +static void +ExtendUnicodeRepWithString( + Tcl_Obj *objPtr, + const char *bytes, + int numBytes, + int numAppendChars) +{ + String *stringPtr = GET_STRING(objPtr); + int needed, numOrigChars = 0; + Tcl_UniChar *dst; + + if (stringPtr->hasUnicode) { + numOrigChars = stringPtr->numChars; + } + if (numAppendChars == -1) { + TclNumUtfChars(numAppendChars, bytes, numBytes); + } + needed = numOrigChars + numAppendChars; + stringCheckLimits(needed); + + if (needed > stringPtr->maxChars) { + GrowUnicodeBuffer(objPtr, needed); + stringPtr = GET_STRING(objPtr); + } + + stringPtr->hasUnicode = 1; + stringPtr->numChars = needed; + for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { + bytes += TclUtfToUniChar(bytes, dst); } *dst = 0; - - SET_STRING(objPtr, stringPtr); } /* @@ -1664,8 +2860,8 @@ FillUnicodeRep(objPtr) * * DupStringInternalRep -- * - * Initialize the internal representation of a new Tcl_Obj to a - * copy of the internal representation of an existing string object. + * Initialize the internal representation of a new Tcl_Obj to a copy of + * the internal representation of an existing string object. * * Results: * None. @@ -1678,46 +2874,93 @@ FillUnicodeRep(objPtr) */ static void -DupStringInternalRep(srcPtr, copyPtr) - register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must - * have an internal rep of type "String". */ - register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must - * not currently have an internal rep.*/ +DupStringInternalRep( + Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + * an internal rep of type "String". */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + * currently have an internal rep.*/ { String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; - /* - * If the src obj is a string of 1-byte Utf chars, then copy the - * string rep of the source object and create an "empty" Unicode - * internal rep for the new object. Otherwise, copy Unicode - * internal rep, and invalidate the string rep of the new object. - */ - - if (srcStringPtr->hasUnicode == 0) { - copyStringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0))); - copyStringPtr->uallocated = STRING_UALLOC(0); - } else { - copyStringPtr = (String *) ckalloc( - STRING_SIZE(srcStringPtr->uallocated)); - copyStringPtr->uallocated = srcStringPtr->uallocated; +#if COMPAT==0 + if (srcStringPtr->numChars == -1) { + /* + * The String struct in the source value holds zero useful data. Don't + * bother copying it. Don't even bother allocating space in which to + * copy it. Just let the copy be untyped. + */ + + return; + } - memcpy((VOID *) copyStringPtr->unicode, - (VOID *) srcStringPtr->unicode, - (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); + if (srcStringPtr->hasUnicode) { + int copyMaxChars; + + if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) { + copyMaxChars = 2 * srcStringPtr->numChars; + } else { + copyMaxChars = srcStringPtr->maxChars; + } + copyStringPtr = stringAttemptAlloc(copyMaxChars); + if (copyStringPtr == NULL) { + copyMaxChars = srcStringPtr->numChars; + copyStringPtr = stringAlloc(copyMaxChars); + } + copyStringPtr->maxChars = copyMaxChars; + memcpy(copyStringPtr->unicode, srcStringPtr->unicode, + srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; + } else { + copyStringPtr = stringAlloc(0); + copyStringPtr->maxChars = 0; + copyStringPtr->unicode[0] = 0; } - copyStringPtr->numChars = srcStringPtr->numChars; copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; - copyStringPtr->allocated = srcStringPtr->allocated; + copyStringPtr->numChars = srcStringPtr->numChars; /* - * Tricky point: the string value was copied by generic object - * management code, so it doesn't contain any extra bytes that - * might exist in the source object. + * Tricky point: the string value was copied by generic object management + * code, so it doesn't contain any extra bytes that might exist in the + * source object. */ - copyStringPtr->allocated = copyPtr->length; + copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; +#else /* COMPAT!=0 */ + /* + * If the src obj is a string of 1-byte Utf chars, then copy the string + * rep of the source object and create an "empty" Unicode internal rep for + * the new object. Otherwise, copy Unicode internal rep, and invalidate + * the string rep of the new object. + */ + + if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) { + /* + * Copy the full allocation for the Unicode buffer. + */ + + copyStringPtr = stringAlloc(srcStringPtr->maxChars); + copyStringPtr->maxChars = srcStringPtr->maxChars; + memcpy(copyStringPtr->unicode, srcStringPtr->unicode, + srcStringPtr->numChars * sizeof(Tcl_UniChar)); + copyStringPtr->unicode[srcStringPtr->numChars] = 0; + copyStringPtr->allocated = 0; + } else { + copyStringPtr = stringAlloc(0); + copyStringPtr->unicode[0] = 0; + copyStringPtr->maxChars = 0; + + /* + * Tricky point: the string value was copied by generic object + * management code, so it doesn't contain any extra bytes that might + * exist in the source object. + */ + + copyStringPtr->allocated = copyPtr->length; + } + copyStringPtr->numChars = srcStringPtr->numChars; + copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; +#endif /* COMPAT==0 */ SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; @@ -1734,52 +2977,38 @@ DupStringInternalRep(srcPtr, copyPtr) * This operation always succeeds and returns TCL_OK. * * Side effects: - * Any old internal reputation for objPtr is freed and the - * internal representation is set to "String". + * Any old internal reputation for objPtr is freed and the internal + * representation is set to "String". * *---------------------------------------------------------------------- */ static int -SetStringFromAny(interp, objPtr) - Tcl_Interp *interp; /* Used for error reporting if not NULL. */ - register Tcl_Obj *objPtr; /* The object to convert. */ +SetStringFromAny( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr) /* The object to convert. */ { - /* - * The Unicode object is optimized for the case where each UTF char - * in a string is only one byte. In this case, we store the value of - * numChars, but we don't copy the bytes to the unicodeObj->unicode. - */ - if (objPtr->typePtr != &tclStringType) { - String *stringPtr; + String *stringPtr = stringAlloc(0); - if (objPtr->typePtr != NULL) { - if (objPtr->bytes == NULL) { - objPtr->typePtr->updateStringProc(objPtr); - } - if ((objPtr->typePtr->freeIntRepProc) != NULL) { - (*objPtr->typePtr->freeIntRepProc)(objPtr); - } - } - objPtr->typePtr = &tclStringType; + /* + * Convert whatever we have into an untyped value. Just A String. + */ + + (void) TclGetString(objPtr); + TclFreeIntRep(objPtr); /* - * Allocate enough space for the basic String structure. + * Create a basic String intrep that just points to the UTF-8 string + * already in place at objPtr->bytes. */ - stringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0))); stringPtr->numChars = -1; - stringPtr->uallocated = STRING_UALLOC(0); + stringPtr->allocated = objPtr->length; + stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; - - if (objPtr->bytes != NULL) { - stringPtr->allocated = objPtr->length; - objPtr->bytes[objPtr->length] = 0; - } else { - objPtr->length = 0; - } SET_STRING(objPtr, stringPtr); + objPtr->typePtr = &tclStringType; } return TCL_OK; } @@ -1796,60 +3025,85 @@ SetStringFromAny(interp, objPtr) * None. * * Side effects: - * The object's string may be set by converting its Unicode - * represention to UTF format. + * The object's string may be set by converting its Unicode represention + * to UTF format. * *---------------------------------------------------------------------- */ static void -UpdateStringOfString(objPtr) - Tcl_Obj *objPtr; /* Object with string rep to update. */ +UpdateStringOfString( + Tcl_Obj *objPtr) /* Object with string rep to update. */ { - int i, size; - Tcl_UniChar *unicode; - char dummy[TCL_UTF_MAX]; - char *dst; - String *stringPtr; + String *stringPtr = GET_STRING(objPtr); - stringPtr = GET_STRING(objPtr); - if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) { + if (stringPtr->numChars == 0) { + TclInitStringRep(objPtr, tclEmptyStringRep, 0); + } else { + (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, + stringPtr->numChars); + } +} - if (stringPtr->numChars <= 0) { +static int +ExtendStringRepWithUnicode( + Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, + int numChars) +{ + /* + * Pre-condition: this is the "string" Tcl_ObjType. + */ - /* - * If there is no Unicode rep, or the string has 0 chars, - * then set the string rep to an empty string. - */ + int i, origLength, size = 0; + char *dst, buf[TCL_UTF_MAX]; + String *stringPtr = GET_STRING(objPtr); - objPtr->bytes = tclEmptyStringRep; - objPtr->length = 0; - return; - } + if (numChars < 0) { + numChars = UnicodeLength(unicode); + } - unicode = stringPtr->unicode; + if (numChars == 0) { + return 0; + } - /* - * Translate the Unicode string to UTF. "size" will hold the - * amount of space the UTF string needs. - */ + if (objPtr->bytes == NULL) { + objPtr->length = 0; + } + size = origLength = objPtr->length; + + /* + * Quick cheap check in case we have more than enough room. + */ - size = 0; - for (i = 0; i < stringPtr->numChars; i++) { - size += Tcl_UniCharToUtf((int) unicode[i], dummy); - } - - dst = (char *) ckalloc((unsigned) (size + 1)); - objPtr->bytes = dst; - objPtr->length = size; - stringPtr->allocated = size; + if (numChars <= (INT_MAX - size)/TCL_UTF_MAX + && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) { + goto copyBytes; + } - for (i = 0; i < stringPtr->numChars; i++) { - dst += Tcl_UniCharToUtf(unicode[i], dst); - } - *dst = '\0'; + for (i = 0; i < numChars && size >= 0; i++) { + size += Tcl_UniCharToUtf((int) unicode[i], buf); } - return; + if (size < 0) { + Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); + } + + /* + * Grow space if needed. + */ + + if (size > stringPtr->allocated) { + GrowStringBuffer(objPtr, size, 1); + } + + copyBytes: + dst = objPtr->bytes + origLength; + for (i = 0; i < numChars; i++) { + dst += Tcl_UniCharToUtf((int) unicode[i], dst); + } + *dst = '\0'; + objPtr->length = dst - objPtr->bytes; + return numChars; } /* @@ -1857,21 +3111,30 @@ UpdateStringOfString(objPtr) * * FreeStringInternalRep -- * - * Deallocate the storage associated with a String data object's - * internal representation. + * Deallocate the storage associated with a String data object's internal + * representation. * * Results: * None. * * Side effects: - * Frees memory. + * Frees memory. * *---------------------------------------------------------------------- */ static void -FreeStringInternalRep(objPtr) - Tcl_Obj *objPtr; /* Object with internal rep to free. */ +FreeStringInternalRep( + Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree((char *) GET_STRING(objPtr)); + ckfree(GET_STRING(objPtr)); + objPtr->typePtr = NULL; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |