diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStringObj.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStringObj.c Fri Jun 15 03:10:57 2012 +0200 @@ -0,0 +1,1880 @@ +/* + * 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 + * 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 + * 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. + * + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright (c) 1999 by Scriptics Corporation. + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. + * + * 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.2.2 2006/09/24 21:15:11 msofer Exp $ */ + +#include "tclInt.h" + +/* + * Prototypes for procedures 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)); + +/* + * The structure below defines the string Tcl object type by means of + * procedures that can be invoked by generic object code. + */ + +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. + */ + +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. */ +} String; + +#define STRING_UALLOC(numChars) \ + (numChars * sizeof(Tcl_UniChar)) +#define STRING_SIZE(ualloc) \ + ((unsigned) ((ualloc) \ + ? sizeof(String) - sizeof(Tcl_UniChar) + (ualloc) \ + : sizeof(String))) +#define GET_STRING(objPtr) \ + ((String *) (objPtr)->internalRep.otherValuePtr) +#define SET_STRING(objPtr, stringPtr) \ + (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr) + +/* + * TCL STRING GROWTH ALGORITHM + * + * When growing strings (during an append, for example), the following growth + * algorithm is used: + * + * Attempt to allocate 2 * (originalLength + appendLength) + * On failure: + * attempt to allocate originalLength + 2*appendLength + + * TCL_GROWTH_MIN_ALLOC + * + * 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 + * 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. + * + * 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). + */ +#ifndef TCL_GROWTH_MIN_ALLOC +#define TCL_GROWTH_MIN_ALLOC 1024 +#endif + + +/* + *---------------------------------------------------------------------- + * + * Tcl_NewStringObj -- + * + * This procedure 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_MEM_DEBUG +#undef Tcl_NewStringObj + +EXPORT_C Tcl_Obj * +Tcl_NewStringObj(bytes, length) + 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. */ +{ + return Tcl_DbNewStringObj(bytes, length, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ + +EXPORT_C Tcl_Obj * +Tcl_NewStringObj(bytes, length) + 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. */ +{ + register Tcl_Obj *objPtr; + + if (length < 0) { + length = (bytes? strlen(bytes) : 0); + } + TclNewObj(objPtr); + TclInitStringRep(objPtr, bytes, length); + return objPtr; +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DbNewStringObj -- + * + * This procedure 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 + * 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 + * reporting objects that haven't been freed. + * + * When TCL_MEM_DEBUG is not defined, this procedure 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. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_MEM_DEBUG + +EXPORT_C Tcl_Obj * +Tcl_DbNewStringObj(bytes, length, file, line) + 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. */ +{ + register Tcl_Obj *objPtr; + + if (length < 0) { + length = (bytes? strlen(bytes) : 0); + } + TclDbNewObj(objPtr, file, line); + TclInitStringRep(objPtr, bytes, length); + return objPtr; +} + +#else /* if not TCL_MEM_DEBUG */ + +EXPORT_C Tcl_Obj * +Tcl_DbNewStringObj(bytes, length, file, line) + 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. */ +{ + return Tcl_NewStringObj(bytes, length); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *--------------------------------------------------------------------------- + * + * 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. + * + * Results: + * 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. + * + *--------------------------------------------------------------------------- + */ + +EXPORT_C 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 + * 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); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetCharLength -- + * + * Get the length of the Unicode string from the Tcl object. + * + * Results: + * Pointer to unicode string representing the unicode object. + * + * Side effects: + * Frees old internal rep. Allocates memory for new "String" + * internal rep. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C int +Tcl_GetCharLength(objPtr) + Tcl_Obj *objPtr; /* The String object to get the num chars of. */ +{ + String *stringPtr; + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); + + /* + * If numChars is unknown, then calculate the number of characaters + * while populating the Unicode string. + */ + + 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 (stringPtr->numChars == objPtr->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. + */ + + stringPtr->hasUnicode = 0; + + } 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. + */ + + 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->numChars; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetUniChar -- + * + * 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. + * + * Side effects: + * Fills unichar with the index'th Unicode character. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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_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. + */ + + Tcl_GetCharLength(objPtr); + + /* + * We need to fetch the pointer again because we may have just + * reallocated the structure. + */ + + 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. + */ + + unichar = (Tcl_UniChar) objPtr->bytes[index]; + } else { + unichar = stringPtr->unicode[index]; + } + return unichar; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * Returns a pointer to the object's internal Unicode string. + * + * Side effects: + * Converts the object to have the String internal rep. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C Tcl_UniChar * +Tcl_GetUnicode(objPtr) + 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; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * Returns a pointer to the object's internal Unicode string. + * + * Side effects: + * Converts the object to have the String internal rep. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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. */ +{ + 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); + } + + if (lengthPtr != NULL) { + *lengthPtr = stringPtr->numChars; + } + return stringPtr->unicode; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * Returns a new Tcl Object of the String type. + * + * Side effects: + * Changes the internal rep of "objPtr" to the String type. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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_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. + */ + + Tcl_GetCharLength(objPtr); + + /* + * We need to fetch the pointer again because we may have just + * reallocated the structure. + */ + + stringPtr = GET_STRING(objPtr); + } + + if (objPtr->bytes && stringPtr->numChars == objPtr->length) { + char *str = Tcl_GetString(objPtr); + + /* + * 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); + + /* + * Since we know the new string only has 1-byte chars, we + * can set it's numChars field. + */ + + SetStringFromAny(NULL, newObjPtr); + stringPtr = GET_STRING(newObjPtr); + stringPtr->numChars = last-first+1; + } else { + newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first, + last-first+1); + } + return newObjPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetStringObj -- + * + * Modify an object to hold a string that is a copy of the bytes + * 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 + * representations are freed and the object's type is set NULL. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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 + * 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.*/ +{ + 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"); + } + + /* + * 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; + + Tcl_InvalidateStringRep(objPtr); + if (length < 0) { + length = (bytes? strlen(bytes) : 0); + } + TclInitStringRep(objPtr, bytes, length); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetObjLength -- + * + * This procedure 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 + * representation is changed to "expendable string". + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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 + * representation of object, not including + * terminating null byte. */ +{ + String *stringPtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_SetObjLength called with shared object"); + } + 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; + + /* + * Not enough space in current string. Reallocate the string + * space and free the old string. + */ + 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); + } + } + 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. */ + 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; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AttemptSetObjLength -- + * + * This procedure 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 + * representation is changed to "expendable string". + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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 + * representation of object, not including + * terminating null byte. */ +{ + String *stringPtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_AttemptSetObjLength called with shared object"); + } + 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; + + /* + * Not enough space in current string. Reallocate the string + * space and free the old string. + */ + if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) { + new = (char *) attemptckrealloc((char *)objPtr->bytes, + (unsigned)(length+1)); + if (new == NULL) { + return 0; + } + } else { + new = (char *) attemptckalloc((unsigned) (length+1)); + if (new == 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 = 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. */ + 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)); + if (stringPtr == NULL) { + return 0; + } + 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; + } + return 1; +} + +/* + *--------------------------------------------------------------------------- + * + * TclSetUnicodeObj -- + * + * Modify an object to hold the Unicode string indicated by "unicode". + * + * Results: + * None. + * + * Side effects: + * Memory allocated for new "String" internal rep. + * + *--------------------------------------------------------------------------- + */ + +EXPORT_C 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 + * string. */ +{ + Tcl_ObjType *typePtr; + String *stringPtr; + size_t uallocated; + + if (numChars < 0) { + numChars = 0; + if (unicode) { + while (unicode[numChars] != 0) { numChars++; } + } + } + uallocated = STRING_UALLOC(numChars); + + /* + * Free the internal rep if one exists, and invalidate the string rep. + */ + + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &tclStringType; + + /* + * Allocate enough space for the String structure + Unicode string. + */ + + 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); + Tcl_InvalidateStringRep(objPtr); + return; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendToObj -- + * + * This procedure appends a sequence of bytes to an object. + * + * Results: + * None. + * + * Side effects: + * The bytes at *bytes are appended to the string representation + * of objPtr. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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 + * object. */ + register int length; /* The number of bytes to append from + * "bytes". If < 0, then append all bytes + * up to NULL byte. */ +{ + String *stringPtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_AppendToObj called with shared object"); + } + + SetStringFromAny(NULL, objPtr); + + if (length < 0) { + length = (bytes ? strlen(bytes) : 0); + } + if (length == 0) { + return; + } + + /* + * 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. + */ + + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode != 0) { + AppendUtfToUnicodeRep(objPtr, bytes, length); + + stringPtr = GET_STRING(objPtr); + } else { + AppendUtfToUtfRep(objPtr, bytes, length); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendUnicodeToObj -- + * + * This procedure appends a Unicode string to an object in the + * most efficient manner possible. Length must be >= 0. + * + * Results: + * None. + * + * Side effects: + * Invalidates the string rep and creates a new Unicode string. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C 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". */ +{ + String *stringPtr; + + if (Tcl_IsShared(objPtr)) { + panic("Tcl_AppendUnicodeToObj called with shared object"); + } + + if (length == 0) { + return; + } + + SetStringFromAny(NULL, objPtr); + 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 (stringPtr->hasUnicode != 0) { + AppendUnicodeToUnicodeRep(objPtr, unicode, length); + } else { + AppendUnicodeToUtfRep(objPtr, unicode, length); + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendObjToObj -- + * + * This procedure 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 + * representation of objPtr. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C void +Tcl_AppendObjToObj(objPtr, appendObjPtr) + Tcl_Obj *objPtr; /* Points to the object to append to. */ + Tcl_Obj *appendObjPtr; /* Object to append. */ +{ + String *stringPtr; + int length, numChars, allOneByteChars; + char *bytes; + + SetStringFromAny(NULL, objPtr); + + /* + * If objPtr has a valid Unicode rep, then get a Unicode string + * from appendObjPtr and append it. + */ + + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode != 0) { + + /* + * 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. + */ + + FillUnicodeRep(appendObjPtr); + stringPtr = GET_STRING(appendObjPtr); + } + AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode, + stringPtr->numChars); + } else { + bytes = Tcl_GetStringFromObj(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. + */ + + bytes = Tcl_GetStringFromObj(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; + } + } + + AppendUtfToUtfRep(objPtr, bytes, length); + + if (allOneByteChars) { + stringPtr = GET_STRING(objPtr); + stringPtr->numChars = numChars; + } +} + +/* + *---------------------------------------------------------------------- + * + * AppendUnicodeToUnicodeRep -- + * + * This procedure appends the contents of "unicode" to the Unicode + * rep of "objPtr". objPtr must already have a valid Unicode rep. + * + * Results: + * None. + * + * Side effects: + * objPtr's internal rep is reallocated. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + String *stringPtr, *tmpString; + size_t numChars; + + if (appendNumChars < 0) { + appendNumChars = 0; + if (unicode) { + while (unicode[appendNumChars] != 0) { appendNumChars++; } + } + } + if (appendNumChars == 0) { + return; + } + + SetStringFromAny(NULL, objPtr); + 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. + */ + + numChars = stringPtr->numChars + appendNumChars; + + 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)); + } + stringPtr = tmpString; + SET_STRING(objPtr, stringPtr); + } + + /* + * Copy the new string onto the end of the old string, then add the + * trailing null. + */ + + memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode, + appendNumChars * sizeof(Tcl_UniChar)); + stringPtr->unicode[numChars] = 0; + stringPtr->numChars = numChars; + + Tcl_InvalidateStringRep(objPtr); +} + +/* + *---------------------------------------------------------------------- + * + * AppendUnicodeToUtfRep -- + * + * This procedure converts the contents of "unicode" to UTF and + * appends the UTF to the string rep of "objPtr". + * + * Results: + * None. + * + * Side effects: + * objPtr's internal rep is reallocated. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + Tcl_DString dsPtr; + CONST char *bytes; + + if (numChars < 0) { + numChars = 0; + if (unicode) { + while (unicode[numChars] != 0) { numChars++; } + } + } + if (numChars == 0) { + return; + } + + Tcl_DStringInit(&dsPtr); + bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr); + AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr)); + Tcl_DStringFree(&dsPtr); +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * None. + * + * Side effects: + * objPtr's internal rep is reallocated. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + Tcl_DString dsPtr; + int numChars; + Tcl_UniChar *unicode; + + 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); +} + +/* + *---------------------------------------------------------------------- + * + * AppendUtfToUtfRep -- + * + * This procedure appends "numBytes" bytes of "bytes" to the UTF string + * rep of "objPtr". objPtr must already have a valid String rep. + * + * Results: + * None. + * + * Side effects: + * objPtr's internal rep is reallocated. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + String *stringPtr; + int newLength, oldLength; + + if (numBytes < 0) { + numBytes = (bytes ? strlen(bytes) : 0); + } + if (numBytes == 0) { + return; + } + + /* + * Copy the new string onto the end of the old string, then add the + * trailing null. + */ + + oldLength = objPtr->length; + newLength = numBytes + oldLength; + + stringPtr = GET_STRING(objPtr); + if (newLength > (int) stringPtr->allocated) { + + /* + * 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. + */ + + if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) { + Tcl_SetObjLength(objPtr, + newLength + numBytes + TCL_GROWTH_MIN_ALLOC); + } + } + + /* + * Invalidate the unicode data. + */ + + stringPtr->numChars = -1; + stringPtr->hasUnicode = 0; + + memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes, + (size_t) numBytes); + objPtr->bytes[newLength] = 0; + objPtr->length = newLength; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendStringsToObjVA -- + * + * This procedure 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. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C void +Tcl_AppendStringsToObjVA (objPtr, argList) + 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"); + } + + SetStringFromAny(NULL, objPtr); + + /* + * 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. + */ + + nargs = 0; + newLength = 0; + oldLength = objPtr->length; + while (1) { + string = va_arg(argList, char *); + if (string == NULL) { + break; + } + 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) { + + /* + * 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. + */ + + if (oldLength == 0) { + Tcl_SetObjLength(objPtr, newLength); + } else { + attemptLength = 2 * (oldLength + newLength); + if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) { + attemptLength = oldLength + (2 * newLength) + + TCL_GROWTH_MIN_ALLOC; + Tcl_SetObjLength(objPtr, attemptLength); + } + } + } + + /* + * Make a second pass through the arguments, appending all the + * strings to the object. + */ + + dst = objPtr->bytes + oldLength; + for (i = 0; i < nargs; ++i) { + string = args[i]; + if (string == NULL) { + break; + } + while (*string != 0) { + *dst = *string; + dst++; + string++; + } + } + + /* + * 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. + */ + + if (dst != NULL) { + *dst = 0; + } + objPtr->length = oldLength + newLength; + + done: + /* + * If we had to allocate a buffer from the heap, + * free it now. + */ + + if (args != static_list) { + ckfree((void *)args); + } +#undef STATIC_LIST_SIZE +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendStringsToObj -- + * + * This procedure 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. + * + *---------------------------------------------------------------------- + */ + +EXPORT_C void +Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1) +{ + register Tcl_Obj *objPtr; + va_list argList; + + objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList); + Tcl_AppendStringsToObjVA(objPtr, 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. + * + * Results: + * None. + * + * Side effects: + * Reallocates the String internal rep. + * + *--------------------------------------------------------------------------- + */ + +static void +FillUnicodeRep(objPtr) + Tcl_Obj *objPtr; /* The object in which to fill the unicode rep. */ +{ + String *stringPtr; + size_t uallocated; + char *src, *srcEnd; + Tcl_UniChar *dst; + src = objPtr->bytes; + + stringPtr = GET_STRING(objPtr); + if (stringPtr->numChars == -1) { + stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length); + } + 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. + */ + + /* + * 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 (stringPtr->uallocated > 0) { + uallocated *= 2; + } + stringPtr = (String *) ckrealloc((char*) stringPtr, + STRING_SIZE(uallocated)); + stringPtr->uallocated = uallocated; + } + + /* + * 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); + } + *dst = 0; + + SET_STRING(objPtr, stringPtr); +} + +/* + *---------------------------------------------------------------------- + * + * DupStringInternalRep -- + * + * Initialize the internal representation of a new Tcl_Obj to a + * copy of the internal representation of an existing string object. + * + * Results: + * None. + * + * Side effects: + * copyPtr's internal rep is set to a copy of srcPtr's internal + * representation. + * + *---------------------------------------------------------------------- + */ + +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.*/ +{ + 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; + + memcpy((VOID *) copyStringPtr->unicode, + (VOID *) srcStringPtr->unicode, + (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); + copyStringPtr->unicode[srcStringPtr->numChars] = 0; + } + copyStringPtr->numChars = srcStringPtr->numChars; + copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; + copyStringPtr->allocated = srcStringPtr->allocated; + + /* + * 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; + + SET_STRING(copyPtr, copyStringPtr); + copyPtr->typePtr = &tclStringType; +} + +/* + *---------------------------------------------------------------------- + * + * SetStringFromAny -- + * + * Create an internal representation of type "String" for an object. + * + * Results: + * 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". + * + *---------------------------------------------------------------------- + */ + +static int +SetStringFromAny(interp, objPtr) + Tcl_Interp *interp; /* Used for error reporting if not NULL. */ + register 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; + + if (objPtr->typePtr != NULL) { + if (objPtr->bytes == NULL) { + objPtr->typePtr->updateStringProc(objPtr); + } + if ((objPtr->typePtr->freeIntRepProc) != NULL) { + (*objPtr->typePtr->freeIntRepProc)(objPtr); + } + } + objPtr->typePtr = &tclStringType; + + /* + * Allocate enough space for the basic String structure. + */ + + stringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0))); + stringPtr->numChars = -1; + stringPtr->uallocated = STRING_UALLOC(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); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * UpdateStringOfString -- + * + * Update the string representation for an object whose internal + * representation is "String". + * + * Results: + * None. + * + * Side effects: + * 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. */ +{ + int i, size; + Tcl_UniChar *unicode; + char dummy[TCL_UTF_MAX]; + char *dst; + String *stringPtr; + + stringPtr = GET_STRING(objPtr); + if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) { + + if (stringPtr->numChars <= 0) { + + /* + * If there is no Unicode rep, or the string has 0 chars, + * then set the string rep to an empty string. + */ + + objPtr->bytes = tclEmptyStringRep; + objPtr->length = 0; + return; + } + + unicode = stringPtr->unicode; + + /* + * Translate the Unicode string to UTF. "size" will hold the + * amount of space the UTF string needs. + */ + + 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; + + for (i = 0; i < stringPtr->numChars; i++) { + dst += Tcl_UniCharToUtf(unicode[i], dst); + } + *dst = '\0'; + } + return; +} + +/* + *---------------------------------------------------------------------- + * + * FreeStringInternalRep -- + * + * Deallocate the storage associated with a String data object's + * internal representation. + * + * Results: + * None. + * + * Side effects: + * Frees memory. + * + *---------------------------------------------------------------------- + */ + +static void +FreeStringInternalRep(objPtr) + Tcl_Obj *objPtr; /* Object with internal rep to free. */ +{ + ckfree((char *) GET_STRING(objPtr)); +}