/* 

  * 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));

 }