Logo Search packages:      
Sourcecode: tcl8.4 version File versions  Download package

tclStringObj.c

/* 
 * 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.32 2003/02/19 16:43:28 das 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);
    }
    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

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.*/
{
    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".
 *
 *----------------------------------------------------------------------
 */

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".
 *
 *----------------------------------------------------------------------
 */

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.
 *
 *---------------------------------------------------------------------------
 */

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.
 *
 *----------------------------------------------------------------------
 */

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.
 *
 *----------------------------------------------------------------------
 */

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.
 *
 *----------------------------------------------------------------------
 */

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)) {
      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);
          }
          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));
}

Generated by  Doxygen 1.6.0   Back to index