tcl.git - Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.

diff options

author	jan.nijtmans <nijtmans@users.sourceforge.net>	2023-03-15 16:23:22 (GMT)
committer	jan.nijtmans <nijtmans@users.sourceforge.net>	2023-03-15 16:23:22 (GMT)
commit	7543a1313fb968cef7dfd21bc22a780022bad34c (patch)
tree	ea58f3dacc8242f44bbf12c298222925e095eb3e
parent	6d3b66ad23ee9a05eecea6ecb0cd5f1d4054bdfa (diff)
parent	e0e09638fece9ca63daad3b3675dc7bfb1ede7d3 (diff)
download	tcl-7543a1313fb968cef7dfd21bc22a780022bad34c.zip tcl-7543a1313fb968cef7dfd21bc22a780022bad34c.tar.gz tcl-7543a1313fb968cef7dfd21bc22a780022bad34c.tar.bz2

Merge 8.6

Diffstat

-rwxr-xr-x

unix/configure

-rw-r--r--

unix/tcl.m4

-rw-r--r--

unix/tclConfig.h.in

3 files changed, 0 insertions, 56 deletions

/* * 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. * * 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.37 2005/05/10 18:34:49 kennykb 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) (sizeof(String) - sizeof(Tcl_UniChar) + ualloc)) #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 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 */ 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); } TclNewStringObj(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 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 */ 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. * *--------------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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 (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. * *---------------------------------------------------------------------- */ 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.*/ { /* * Free any old string rep, then set the string rep to a copy of * the length bytes starting at "bytes". */ if (Tcl_IsShared(objPtr)) { Tcl_Panic("Tcl_SetStringObj called with shared object"); } /* * Set the type to NULL and free any internal rep for the old type. */ TclFreeIntRep(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". * *---------------------------------------------------------------------- */ 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)) { Tcl_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". * *---------------------------------------------------------------------- */ 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)) { Tcl_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. * *--------------------------------------------------------------------------- */ 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. */ { 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. */ TclFreeIntRep(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; } /* *---------------------------------------------------------------------- * * TclAppendLimitedToObj -- * * This procedure 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. * *---------------------------------------------------------------------- */ void TclAppendLimitedToObj(objPtr, bytes, length, limit, ellipsis) 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 available to be * appended from "bytes". If < 0, then * all bytes up to a NULL byte are available. */ register 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)) { Tcl_Panic("TclAppendLimitedToObj called with shared object"); } SetStringFromAny(NULL, objPtr); if (length < 0) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { 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. */ stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode != 0) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); } if (length <= limit) { return; } stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode != 0) { AppendUtfToUnicodeRep(objPtr, ellipsis, -1); } else { AppendUtfToUtfRep(objPtr, ellipsis, -1); } } /* *---------------------------------------------------------------------- * * 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. * *---------------------------------------------------------------------- */ 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. */ { TclAppendLimitedToObj(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. * * Results: * None. * * Side effects: * Invalidates the string rep and creates a new Unicode string. * *---------------------------------------------------------------------- */ 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)) { Tcl_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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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)) { Tcl_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. * *---------------------------------------------------------------------- */ 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); } TclFreeIntRep(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)); }


context:
space:
mode: