/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstringobj.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstringobj.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sf_code/esrgpcpj/shared/tcl_base/tclstringobj.c revision 25 by dashley, Sat Oct 8 06:43:03 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclstringobj.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclstringobj.c,v 1.1.1.1 2001/06/13 04:46:18 dtashley Exp $ */  
   
 /*  
  * 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  
  *      ojbect is opitmized 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.1.1.1 2001/06/13 04:46:18 dtashley Exp $ */  
   
 #include "tclInt.h"  
   
 /*  
  * Prototypes for procedures defined later in this file:  
  */  
   
 static void             AppendUnicodeToUnicodeRep _ANSI_ARGS_((  
                             Tcl_Obj *objPtr, Tcl_UniChar *unicode,  
                             int appendNumChars));  
 static void             AppendUnicodeToUtfRep _ANSI_ARGS_((  
                             Tcl_Obj *objPtr, Tcl_UniChar *unicode,  
                             int numChars));  
 static void             AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,  
                             char *bytes, int numBytes));  
 static void             AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,  
                             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. 0 means the  
                                  * Unicode string rep is invalid. */  
     Tcl_UniChar unicode[2];     /* The array of Unicode chars.  The actual  
                                  * size of this field depends on the  
                                  * 'uallocated' field above. */  
 } String;  
   
 #define STRING_SIZE(len)        \  
                 ((unsigned) (sizeof(String) + ((len-1) * sizeof(Tcl_UniChar))))  
 #define GET_STRING(objPtr) \  
                 ((String *) (objPtr)->internalRep.otherValuePtr)  
 #define SET_STRING(objPtr, stringPtr) \  
                 (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * 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 checkmem 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. */  
     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. */  
     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 */  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * TclNewUnicodeObj --  
  *  
  *      This procedure is creates a new String object and initializes  
  *      it from the given Utf 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)  
     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 = (numChars + 1) * sizeof(Tcl_UniChar);  
   
     /*  
      * 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->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) {  
   
         stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);  
   
         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->uallocated = 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->uallocated == 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.  
          */  
           
         Tcl_UtfToUniChar(&objPtr->bytes[index], &unichar);        
     } 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->uallocated == 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_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. */  
     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. */  
 {  
     char *new;  
     String *stringPtr;  
   
     if (Tcl_IsShared(objPtr)) {  
         panic("Tcl_SetObjLength called with shared object");  
     }  
     SetStringFromAny(NULL, objPtr);  
           
     /*  
      * Invalidate the unicode data.  
      */  
   
     stringPtr = GET_STRING(objPtr);  
     stringPtr->numChars = -1;  
     stringPtr->uallocated = 0;  
   
     if (length > (int) stringPtr->allocated) {  
   
         /*  
          * Not enough space in current string. Reallocate the string  
          * space and free the old string.  
          */  
   
         new = (char *) ckalloc((unsigned) (length+1));  
         if (objPtr->bytes != NULL) {  
             memcpy((VOID *) new, (VOID *) objPtr->bytes,  
                     (size_t) objPtr->length);  
             Tcl_InvalidateStringRep(objPtr);  
         }  
         objPtr->bytes = new;  
         stringPtr->allocated = length;  
     }  
       
     objPtr->length = length;  
     if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {  
         objPtr->bytes[length] = 0;  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * 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. */  
     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 = (numChars + 1) * sizeof(Tcl_UniChar);  
   
     /*  
      * 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->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. */  
     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->uallocated > 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. */  
     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);  
   
     /*  
      * TEMPORARY!!!  This is terribly inefficient, but it works, and Don  
      * needs for me to check this stuff in ASAP.  -Melissa  
      */  
       
 /*     UpdateStringOfString(objPtr); */  
 /*     AppendUnicodeToUtfRep(objPtr, unicode, length); */  
 /*     return; */  
   
     /*  
      * 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.  
      */  
   
     stringPtr = GET_STRING(objPtr);  
     if (stringPtr->uallocated > 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->uallocated > 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->uallocated == 0)) {  
                   
                 /*  
                  * If appendObjPtr is a string obj with no valide 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. */  
     Tcl_UniChar *unicode;     /* String to append. */  
     int appendNumChars;       /* Number of chars of "unicode" to append. */  
 {  
     String *stringPtr;  
     int numChars;  
     size_t newSize;  
   
     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 double the amount of  
      * space needed, so the unicode string can grow without being  
      * reallocated.  
      */  
   
     numChars = stringPtr->numChars + appendNumChars;  
     newSize = (numChars + 1) * sizeof(Tcl_UniChar);  
   
     if (newSize > stringPtr->uallocated) {  
         stringPtr->uallocated = newSize * 2;  
         stringPtr = (String *) ckrealloc((char*)stringPtr,  
                 STRING_SIZE(stringPtr->uallocated));  
         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;  
   
     SET_STRING(objPtr, stringPtr);  
     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. */  
     Tcl_UniChar *unicode;     /* String to convert to UTF. */  
     int numChars;             /* Number of chars of "unicode" to convert. */  
 {  
     Tcl_DString dsPtr;  
     char *bytes;  
       
     if (numChars < 0) {  
         numChars = 0;  
         if (unicode) {  
             while (unicode[numChars] != 0) { numChars++; }  
         }  
     }  
     if (numChars == 0) {  
         return;  
     }  
   
     Tcl_DStringInit(&dsPtr);  
     bytes = (char *)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. */  
     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. */  
     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.  Overallocate the  
          * space by doubling it so that we won't have to do as much  
          * reallocation in the future.  
          */  
   
         Tcl_SetObjLength(objPtr, 2*newLength);  
     } else {  
   
         /*  
          * Invalidate the unicode data.  
          */  
           
         stringPtr->numChars = -1;  
         stringPtr->uallocated = 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;  
     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 = 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 == oldLength) {  
         goto done;  
     }  
   
     stringPtr = GET_STRING(objPtr);  
     if (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 overallocate the space so  
          * that we won't have to do as much reallocation in the future.  
          */  
   
         Tcl_SetObjLength(objPtr,  
                 (objPtr->length == 0) ? newLength : 2*newLength);  
     }  
   
     /*  
      * 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 = 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);  
     }  
   
     uallocated = stringPtr->numChars * sizeof(Tcl_UniChar);  
     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 += Tcl_UtfToUniChar(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->uallocated == 0) {  
         copyStringPtr = (String *) ckalloc(sizeof(String));  
         copyStringPtr->uallocated = 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->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. */  
     Tcl_Obj *objPtr;            /* The object to convert. */  
 {  
     String *stringPtr;  
   
     /*  
      * The Unicode object is opitmized 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) {  
   
         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(sizeof(String));  
         stringPtr->numChars = -1;  
         stringPtr->uallocated = 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, length, 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;  
         length = stringPtr->numChars * sizeof(Tcl_UniChar);  
   
         /*  
          * 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));  
 }  
   
   
 /* $History: tclstringobj.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:03a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLSTRINGOBJ.C */  
1    /* $Header$ */
2    /*
3     * tclStringObj.c --
4     *
5     *      This file contains procedures that implement string operations on Tcl
6     *      objects.  Some string operations work with UTF strings and others
7     *      require Unicode format.  Functions that require knowledge of the width
8     *      of each character, such as indexing, operate on Unicode data.
9     *
10     *      A Unicode string is an internationalized string.  Conceptually, a
11     *      Unicode string is an array of 16-bit quantities organized as a sequence
12     *      of properly formed UTF-8 characters.  There is a one-to-one map between
13     *      Unicode and UTF characters.  Because Unicode characters have a fixed
14     *      width, operations such as indexing operate on Unicode data.  The String
15     *      ojbect is opitmized for the case where each UTF char in a string is
16     *      only one byte.  In this case, we store the value of numChars, but we
17     *      don't store the Unicode data (unless Tcl_GetUnicode is explicitly
18     *      called).
19     *
20     *      The String object type stores one or both formats.  The default
21     *      behavior is to store UTF.  Once Unicode is calculated by a function, it
22     *      is stored in the internal rep for future access (without an additional
23     *      O(n) cost).
24     *
25     *      To allow many appends to be done to an object without constantly
26     *      reallocating the space for the string or Unicode representation, we
27     *      allocate double the space for the string or Unicode and use the
28     *      internal representation to keep track of how much space is used
29     *      vs. allocated.
30     *
31     * Copyright (c) 1995-1997 Sun Microsystems, Inc.
32     * Copyright (c) 1999 by Scriptics Corporation.
33     *
34     * See the file "license.terms" for information on usage and redistribution
35     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
36     *
37     * RCS: @(#) $Id: tclstringobj.c,v 1.1.1.1 2001/06/13 04:46:18 dtashley Exp $ */
38    
39    #include "tclInt.h"
40    
41    /*
42     * Prototypes for procedures defined later in this file:
43     */
44    
45    static void             AppendUnicodeToUnicodeRep _ANSI_ARGS_((
46                                Tcl_Obj *objPtr, Tcl_UniChar *unicode,
47                                int appendNumChars));
48    static void             AppendUnicodeToUtfRep _ANSI_ARGS_((
49                                Tcl_Obj *objPtr, Tcl_UniChar *unicode,
50                                int numChars));
51    static void             AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
52                                char *bytes, int numBytes));
53    static void             AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
54                                char *bytes, int numBytes));
55    
56    static void             FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
57    
58    static void             FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
59    static void             DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
60                                Tcl_Obj *copyPtr));
61    static int              SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
62                                Tcl_Obj *objPtr));
63    static void             UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
64    
65    /*
66     * The structure below defines the string Tcl object type by means of
67     * procedures that can be invoked by generic object code.
68     */
69    
70    Tcl_ObjType tclStringType = {
71        "string",                           /* name */
72        FreeStringInternalRep,              /* freeIntRepPro */
73        DupStringInternalRep,               /* dupIntRepProc */
74        UpdateStringOfString,               /* updateStringProc */
75        SetStringFromAny                    /* setFromAnyProc */
76    };
77    
78    /*
79     * The following structure is the internal rep for a String object.
80     * It keeps track of how much memory has been used and how much has been
81     * allocated for the Unicode and UTF string to enable growing and
82     * shrinking of the UTF and Unicode reps of the String object with fewer
83     * mallocs.  To optimize string length and indexing operations, this
84     * structure also stores the number of characters (same of UTF and Unicode!)
85     * once that value has been computed.
86     */
87    
88    typedef struct String {
89        int numChars;               /* The number of chars in the string.
90                                     * -1 means this value has not been
91                                     * calculated. >= 0 means that there is a
92                                     * valid Unicode rep, or that the number
93                                     * of UTF bytes == the number of chars. */
94        size_t allocated;           /* The amount of space actually allocated
95                                     * for the UTF string (minus 1 byte for
96                                     * the termination char). */
97        size_t uallocated;          /* The amount of space actually allocated
98                                     * for the Unicode string. 0 means the
99                                     * Unicode string rep is invalid. */
100        Tcl_UniChar unicode[2];     /* The array of Unicode chars.  The actual
101                                     * size of this field depends on the
102                                     * 'uallocated' field above. */
103    } String;
104    
105    #define STRING_SIZE(len)        \
106                    ((unsigned) (sizeof(String) + ((len-1) * sizeof(Tcl_UniChar))))
107    #define GET_STRING(objPtr) \
108                    ((String *) (objPtr)->internalRep.otherValuePtr)
109    #define SET_STRING(objPtr, stringPtr) \
110                    (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
111    
112    
113    /*
114     *----------------------------------------------------------------------
115     *
116     * Tcl_NewStringObj --
117     *
118     *      This procedure is normally called when not debugging: i.e., when
119     *      TCL_MEM_DEBUG is not defined. It creates a new string object and
120     *      initializes it from the byte pointer and length arguments.
121     *
122     *      When TCL_MEM_DEBUG is defined, this procedure just returns the
123     *      result of calling the debugging version Tcl_DbNewStringObj.
124     *
125     * Results:
126     *      A newly created string object is returned that has ref count zero.
127     *
128     * Side effects:
129     *      The new object's internal string representation will be set to a
130     *      copy of the length bytes starting at "bytes". If "length" is
131     *      negative, use bytes up to the first NULL byte; i.e., assume "bytes"
132     *      points to a C-style NULL-terminated string. The object's type is set
133     *      to NULL. An extra NULL is added to the end of the new object's byte
134     *      array.
135     *
136     *----------------------------------------------------------------------
137     */
138    
139    #ifdef TCL_MEM_DEBUG
140    #undef Tcl_NewStringObj
141    
142    Tcl_Obj *
143    Tcl_NewStringObj(bytes, length)
144        CONST char *bytes;          /* Points to the first of the length bytes
145                                     * used to initialize the new object. */
146        int length;                 /* The number of bytes to copy from "bytes"
147                                     * when initializing the new object. If
148                                     * negative, use bytes up to the first
149                                     * NULL byte. */
150    {
151        return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
152    }
153    
154    #else /* if not TCL_MEM_DEBUG */
155    
156    Tcl_Obj *
157    Tcl_NewStringObj(bytes, length)
158        CONST char *bytes;          /* Points to the first of the length bytes
159                                     * used to initialize the new object. */
160        int length;                 /* The number of bytes to copy from "bytes"
161                                     * when initializing the new object. If
162                                     * negative, use bytes up to the first
163                                     * NULL byte. */
164    {
165        register Tcl_Obj *objPtr;
166    
167        if (length < 0) {
168            length = (bytes? strlen(bytes) : 0);
169        }
170        TclNewObj(objPtr);
171        TclInitStringRep(objPtr, bytes, length);
172        return objPtr;
173    }
174    #endif /* TCL_MEM_DEBUG */
175    
176    /*
177     *----------------------------------------------------------------------
178     *
179     * Tcl_DbNewStringObj --
180     *
181     *      This procedure is normally called when debugging: i.e., when
182     *      TCL_MEM_DEBUG is defined. It creates new string objects. It is the
183     *      same as the Tcl_NewStringObj procedure above except that it calls
184     *      Tcl_DbCkalloc directly with the file name and line number from its
185     *      caller. This simplifies debugging since then the checkmem command
186     *      will report the correct file name and line number when reporting
187     *      objects that haven't been freed.
188     *
189     *      When TCL_MEM_DEBUG is not defined, this procedure just returns the
190     *      result of calling Tcl_NewStringObj.
191     *
192     * Results:
193     *      A newly created string object is returned that has ref count zero.
194     *
195     * Side effects:
196     *      The new object's internal string representation will be set to a
197     *      copy of the length bytes starting at "bytes". If "length" is
198     *      negative, use bytes up to the first NULL byte; i.e., assume "bytes"
199     *      points to a C-style NULL-terminated string. The object's type is set
200     *      to NULL. An extra NULL is added to the end of the new object's byte
201     *      array.
202     *
203     *----------------------------------------------------------------------
204     */
205    
206    #ifdef TCL_MEM_DEBUG
207    
208    Tcl_Obj *
209    Tcl_DbNewStringObj(bytes, length, file, line)
210        CONST char *bytes;          /* Points to the first of the length bytes
211                                     * used to initialize the new object. */
212        int length;                 /* The number of bytes to copy from "bytes"
213                                     * when initializing the new object. If
214                                     * negative, use bytes up to the first
215                                     * NULL byte. */
216        char *file;                 /* The name of the source file calling this
217                                     * procedure; used for debugging. */
218        int line;                   /* Line number in the source file; used
219                                     * for debugging. */
220    {
221        register Tcl_Obj *objPtr;
222    
223        if (length < 0) {
224            length = (bytes? strlen(bytes) : 0);
225        }
226        TclDbNewObj(objPtr, file, line);
227        TclInitStringRep(objPtr, bytes, length);
228        return objPtr;
229    }
230    
231    #else /* if not TCL_MEM_DEBUG */
232    
233    Tcl_Obj *
234    Tcl_DbNewStringObj(bytes, length, file, line)
235        CONST char *bytes;          /* Points to the first of the length bytes
236                                     * used to initialize the new object. */
237        register int length;        /* The number of bytes to copy from "bytes"
238                                     * when initializing the new object. If
239                                     * negative, use bytes up to the first
240                                     * NULL byte. */
241        char *file;                 /* The name of the source file calling this
242                                     * procedure; used for debugging. */
243        int line;                   /* Line number in the source file; used
244                                     * for debugging. */
245    {
246        return Tcl_NewStringObj(bytes, length);
247    }
248    #endif /* TCL_MEM_DEBUG */
249    
250    /*
251     *---------------------------------------------------------------------------
252     *
253     * TclNewUnicodeObj --
254     *
255     *      This procedure is creates a new String object and initializes
256     *      it from the given Utf String.  If the Utf String is the same size
257     *      as the Unicode string, don't duplicate the data.
258     *
259     * Results:
260     *      The newly created object is returned.  This object will have no
261     *      initial string representation.  The returned object has a ref count
262     *      of 0.
263     *
264     * Side effects:
265     *      Memory allocated for new object and copy of Unicode argument.
266     *
267     *---------------------------------------------------------------------------
268     */
269    
270    Tcl_Obj *
271    Tcl_NewUnicodeObj(unicode, numChars)
272        Tcl_UniChar *unicode;       /* The unicode string used to initialize
273                                     * the new object. */
274        int numChars;               /* Number of characters in the unicode
275                                     * string. */
276    {
277        Tcl_Obj *objPtr;
278        String *stringPtr;
279        size_t uallocated;
280    
281        if (numChars < 0) {
282            numChars = 0;
283            if (unicode) {
284                while (unicode[numChars] != 0) { numChars++; }
285            }
286        }
287        uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
288    
289        /*
290         * Create a new obj with an invalid string rep.
291         */
292    
293        TclNewObj(objPtr);
294        Tcl_InvalidateStringRep(objPtr);
295        objPtr->typePtr = &tclStringType;
296    
297        stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
298        stringPtr->numChars = numChars;
299        stringPtr->uallocated = uallocated;
300        stringPtr->allocated = 0;
301        memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
302        stringPtr->unicode[numChars] = 0;
303        SET_STRING(objPtr, stringPtr);
304        return objPtr;
305    }
306    
307    /*
308     *----------------------------------------------------------------------
309     *
310     * Tcl_GetCharLength --
311     *
312     *      Get the length of the Unicode string from the Tcl object.
313     *
314     * Results:
315     *      Pointer to unicode string representing the unicode object.
316     *
317     * Side effects:
318     *      Frees old internal rep.  Allocates memory for new "String"
319     *      internal rep.
320     *
321     *----------------------------------------------------------------------
322     */
323    
324    int
325    Tcl_GetCharLength(objPtr)
326        Tcl_Obj *objPtr;    /* The String object to get the num chars of. */
327    {
328        String *stringPtr;
329        
330        SetStringFromAny(NULL, objPtr);
331        stringPtr = GET_STRING(objPtr);
332    
333        /*
334         * If numChars is unknown, then calculate the number of characaters
335         * while populating the Unicode string.
336         */
337        
338        if (stringPtr->numChars == -1) {
339    
340            stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
341    
342            if (stringPtr->numChars == objPtr->length) {
343    
344                /*
345                 * Since we've just calculated the number of chars, and all
346                 * UTF chars are 1-byte long, we don't need to store the
347                 * unicode string.
348                 */
349    
350                stringPtr->uallocated = 0;
351    
352            } else {
353        
354                /*
355                 * Since we've just calucalated the number of chars, and not
356                 * all UTF chars are 1-byte long, go ahead and populate the
357                 * unicode string.
358                 */
359    
360                FillUnicodeRep(objPtr);
361    
362                /*
363                 * We need to fetch the pointer again because we have just
364                 * reallocated the structure to make room for the Unicode data.
365                 */
366                
367                stringPtr = GET_STRING(objPtr);
368            }
369        }
370        return stringPtr->numChars;
371    }
372    
373    /*
374     *----------------------------------------------------------------------
375     *
376     * Tcl_GetUniChar --
377     *
378     *      Get the index'th Unicode character from the String object.  The
379     *      index is assumed to be in the appropriate range.
380     *
381     * Results:
382     *      Returns the index'th Unicode character in the Object.
383     *
384     * Side effects:
385     *      Fills unichar with the index'th Unicode character.
386     *
387     *----------------------------------------------------------------------
388     */
389    
390    Tcl_UniChar
391    Tcl_GetUniChar(objPtr, index)
392        Tcl_Obj *objPtr;    /* The object to get the Unicode charater from. */
393        int index;          /* Get the index'th Unicode character. */
394    {
395        Tcl_UniChar unichar;
396        String *stringPtr;
397        
398        SetStringFromAny(NULL, objPtr);
399        stringPtr = GET_STRING(objPtr);
400    
401        if (stringPtr->numChars == -1) {
402    
403            /*
404             * We haven't yet calculated the length, so we don't have the
405             * Unicode str.  We need to know the number of chars before we
406             * can do indexing.
407             */
408    
409            Tcl_GetCharLength(objPtr);
410    
411            /*
412             * We need to fetch the pointer again because we may have just
413             * reallocated the structure.
414             */
415            
416            stringPtr = GET_STRING(objPtr);
417        }
418        if (stringPtr->uallocated == 0) {
419    
420            /*
421             * All of the characters in the Utf string are 1 byte chars,
422             * so we don't store the unicode char.  We get the Utf string
423             * and convert the index'th byte to a Unicode character.
424             */
425            
426            Tcl_UtfToUniChar(&objPtr->bytes[index], &unichar);      
427        } else {
428            unichar = stringPtr->unicode[index];
429        }
430        return unichar;
431    }
432    
433    /*
434     *----------------------------------------------------------------------
435     *
436     * Tcl_GetUnicode --
437     *
438     *      Get the Unicode form of the String object.  If
439     *      the object is not already a String object, it will be converted
440     *      to one.  If the String object does not have a Unicode rep, then
441     *      one is create from the UTF string format.
442     *
443     * Results:
444     *      Returns a pointer to the object's internal Unicode string.
445     *
446     * Side effects:
447     *      Converts the object to have the String internal rep.
448     *
449     *----------------------------------------------------------------------
450     */
451    
452    Tcl_UniChar *
453    Tcl_GetUnicode(objPtr)
454        Tcl_Obj *objPtr;    /* The object to find the unicode string for. */
455    {
456        String *stringPtr;
457        
458        SetStringFromAny(NULL, objPtr);
459        stringPtr = GET_STRING(objPtr);
460        
461        if ((stringPtr->numChars == -1) || (stringPtr->uallocated == 0)) {
462    
463            /*
464             * We haven't yet calculated the length, or all of the characters
465             * in the Utf string are 1 byte chars (so we didn't store the
466             * unicode str).  Since this function must return a unicode string,
467             * and one has not yet been stored, force the Unicode to be
468             * calculated and stored now.
469             */
470    
471            FillUnicodeRep(objPtr);
472    
473            /*
474             * We need to fetch the pointer again because we have just
475             * reallocated the structure to make room for the Unicode data.
476             */
477            
478            stringPtr = GET_STRING(objPtr);
479        }
480        return stringPtr->unicode;
481    }
482    
483    /*
484     *----------------------------------------------------------------------
485     *
486     * Tcl_GetRange --
487     *
488     *      Create a Tcl Object that contains the chars between first and last
489     *      of the object indicated by "objPtr".  If the object is not already
490     *      a String object, convert it to one.  The first and last indices
491     *      are assumed to be in the appropriate range.
492     *
493     * Results:
494     *      Returns a new Tcl Object of the String type.
495     *
496     * Side effects:
497     *      Changes the internal rep of "objPtr" to the String type.
498     *
499     *----------------------------------------------------------------------
500     */
501    
502    Tcl_Obj*
503    Tcl_GetRange(objPtr, first, last)
504      
505     Tcl_Obj *objPtr;               /* The Tcl object to find the range of. */
506        int first;                  /* First index of the range. */
507        int last;                   /* Last index of the range. */
508    {
509        Tcl_Obj *newObjPtr;         /* The Tcl object to find the range of. */
510        String *stringPtr;
511        
512        SetStringFromAny(NULL, objPtr);
513        stringPtr = GET_STRING(objPtr);
514    
515        if (stringPtr->numChars == -1) {
516        
517            /*
518             * We haven't yet calculated the length, so we don't have the
519             * Unicode str.  We need to know the number of chars before we
520             * can do indexing.
521             */
522    
523            Tcl_GetCharLength(objPtr);
524    
525            /*
526             * We need to fetch the pointer again because we may have just
527             * reallocated the structure.
528             */
529            
530            stringPtr = GET_STRING(objPtr);
531        }
532    
533        if (stringPtr->numChars == objPtr->length) {
534            char *str = Tcl_GetString(objPtr);
535    
536            /*
537             * All of the characters in the Utf string are 1 byte chars,
538             * so we don't store the unicode char.  Create a new string
539             * object containing the specified range of chars.
540             */
541            
542            newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
543    
544            /*
545             * Since we know the new string only has 1-byte chars, we
546             * can set it's numChars field.
547             */
548            
549            SetStringFromAny(NULL, newObjPtr);
550            stringPtr = GET_STRING(newObjPtr);
551            stringPtr->numChars = last-first+1;
552        } else {
553            newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
554                    last-first+1);
555        }
556        return newObjPtr;
557    }
558    
559    /*
560     *----------------------------------------------------------------------
561     *
562     * Tcl_SetStringObj --
563     *
564     *      Modify an object to hold a string that is a copy of the bytes
565     *      indicated by the byte pointer and length arguments.
566     *
567     * Results:
568     *      None.
569     *
570     * Side effects:
571     *      The object's string representation will be set to a copy of
572     *      the "length" bytes starting at "bytes". If "length" is negative, use
573     *      bytes up to the first NULL byte; i.e., assume "bytes" points to a
574     *      C-style NULL-terminated string. The object's old string and internal
575     *      representations are freed and the object's type is set NULL.
576     *
577     *----------------------------------------------------------------------
578     */
579    
580    void
581    Tcl_SetStringObj(objPtr, bytes, length)
582        register Tcl_Obj *objPtr;   /* Object whose internal rep to init. */
583        char *bytes;                /* Points to the first of the length bytes
584                                     * used to initialize the object. */
585        register int length;        /* The number of bytes to copy from "bytes"
586                                     * when initializing the object. If
587                                     * negative, use bytes up to the first
588                                     * NULL byte.*/
589    {
590        register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
591    
592        /*
593         * Free any old string rep, then set the string rep to a copy of
594         * the length bytes starting at "bytes".
595         */
596    
597        if (Tcl_IsShared(objPtr)) {
598            panic("Tcl_SetStringObj called with shared object");
599        }
600    
601        /*
602         * Set the type to NULL and free any internal rep for the old type.
603         */
604    
605        if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
606            oldTypePtr->freeIntRepProc(objPtr);
607        }
608        objPtr->typePtr = NULL;
609    
610        Tcl_InvalidateStringRep(objPtr);
611        if (length < 0) {
612            length = (bytes? strlen(bytes) : 0);
613        }
614        TclInitStringRep(objPtr, bytes, length);
615    }
616    
617    /*
618     *----------------------------------------------------------------------
619     *
620     * Tcl_SetObjLength --
621     *
622     *      This procedure changes the length of the string representation
623     *      of an object.
624     *
625     * Results:
626     *      None.
627     *
628     * Side effects:
629     *      If the size of objPtr's string representation is greater than
630     *      length, then it is reduced to length and a new terminating null
631     *      byte is stored in the strength.  If the length of the string
632     *      representation is greater than length, the storage space is
633     *      reallocated to the given length; a null byte is stored at the
634     *      end, but other bytes past the end of the original string
635     *      representation are undefined.  The object's internal
636     *      representation is changed to "expendable string".
637     *
638     *----------------------------------------------------------------------
639     */
640    
641    void
642    Tcl_SetObjLength(objPtr, length)
643        register Tcl_Obj *objPtr;   /* Pointer to object.  This object must
644                                     * not currently be shared. */
645        register int length;        /* Number of bytes desired for string
646                                     * representation of object, not including
647                                     * terminating null byte. */
648    {
649        char *new;
650        String *stringPtr;
651    
652        if (Tcl_IsShared(objPtr)) {
653            panic("Tcl_SetObjLength called with shared object");
654        }
655        SetStringFromAny(NULL, objPtr);
656            
657        /*
658         * Invalidate the unicode data.
659         */
660    
661        stringPtr = GET_STRING(objPtr);
662        stringPtr->numChars = -1;
663        stringPtr->uallocated = 0;
664    
665        if (length > (int) stringPtr->allocated) {
666    
667            /*
668             * Not enough space in current string. Reallocate the string
669             * space and free the old string.
670             */
671    
672            new = (char *) ckalloc((unsigned) (length+1));
673            if (objPtr->bytes != NULL) {
674                memcpy((VOID *) new, (VOID *) objPtr->bytes,
675                        (size_t) objPtr->length);
676                Tcl_InvalidateStringRep(objPtr);
677            }
678            objPtr->bytes = new;
679            stringPtr->allocated = length;
680        }
681        
682        objPtr->length = length;
683        if ((objPtr->bytes != NULL) && (objPtr->bytes != tclEmptyStringRep)) {
684            objPtr->bytes[length] = 0;
685        }
686    }
687    
688    /*
689     *---------------------------------------------------------------------------
690     *
691     * TclSetUnicodeObj --
692     *
693     *      Modify an object to hold the Unicode string indicated by "unicode".
694     *
695     * Results:
696     *      None.
697     *
698     * Side effects:
699     *      Memory allocated for new "String" internal rep.
700     *
701     *---------------------------------------------------------------------------
702     */
703    
704    void
705    Tcl_SetUnicodeObj(objPtr, unicode, numChars)
706        Tcl_Obj *objPtr;            /* The object to set the string of. */
707        Tcl_UniChar *unicode;       /* The unicode string used to initialize
708                                     * the object. */
709        int numChars;               /* Number of characters in the unicode
710                                     * string. */
711    {
712        Tcl_ObjType *typePtr;
713        String *stringPtr;
714        size_t uallocated;
715    
716        if (numChars < 0) {
717            numChars = 0;
718            if (unicode) {
719                while (unicode[numChars] != 0) { numChars++; }
720            }
721        }
722        uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
723    
724        /*
725         * Free the internal rep if one exists, and invalidate the string rep.
726         */
727    
728        typePtr = objPtr->typePtr;
729        if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
730            (*typePtr->freeIntRepProc)(objPtr);
731        }
732        objPtr->typePtr = &tclStringType;
733    
734        /*
735         * Allocate enough space for the String structure + Unicode string.
736         */
737            
738        stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
739        stringPtr->numChars = numChars;
740        stringPtr->uallocated = uallocated;
741        stringPtr->allocated = 0;
742        memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
743        stringPtr->unicode[numChars] = 0;
744        SET_STRING(objPtr, stringPtr);
745        Tcl_InvalidateStringRep(objPtr);
746        return;
747    }
748    
749    /*
750     *----------------------------------------------------------------------
751     *
752     * Tcl_AppendToObj --
753     *
754     *      This procedure appends a sequence of bytes to an object.
755     *
756     * Results:
757     *      None.
758     *
759     * Side effects:
760     *      The bytes at *bytes are appended to the string representation
761     *      of objPtr.
762     *
763     *----------------------------------------------------------------------
764     */
765    
766    void
767    Tcl_AppendToObj(objPtr, bytes, length)
768        register Tcl_Obj *objPtr;   /* Points to the object to append to. */
769        char *bytes;                /* Points to the bytes to append to the
770                                     * object. */
771        register int length;        /* The number of bytes to append from
772                                     * "bytes". If < 0, then append all bytes
773                                     * up to NULL byte. */
774    {
775        String *stringPtr;
776    
777        if (Tcl_IsShared(objPtr)) {
778            panic("Tcl_AppendToObj called with shared object");
779        }
780        
781        SetStringFromAny(NULL, objPtr);
782    
783        if (length < 0) {
784            length = (bytes ? strlen(bytes) : 0);
785        }
786        if (length == 0) {
787            return;
788        }
789    
790        /*
791         * If objPtr has a valid Unicode rep, then append the Unicode
792         * conversion of "bytes" to the objPtr's Unicode rep, otherwise
793         * append "bytes" to objPtr's string rep.
794         */
795    
796        stringPtr = GET_STRING(objPtr);
797        if (stringPtr->uallocated > 0) {
798            AppendUtfToUnicodeRep(objPtr, bytes, length);
799    
800            stringPtr = GET_STRING(objPtr);
801        } else {
802            AppendUtfToUtfRep(objPtr, bytes, length);
803        }
804    }
805    
806    /*
807     *----------------------------------------------------------------------
808     *
809     * Tcl_AppendUnicodeToObj --
810     *
811     *      This procedure appends a Unicode string to an object in the
812     *      most efficient manner possible.  Length must be >= 0.
813     *
814     * Results:
815     *      None.
816     *
817     * Side effects:
818     *      Invalidates the string rep and creates a new Unicode string.
819     *
820     *----------------------------------------------------------------------
821     */
822    
823    void
824    Tcl_AppendUnicodeToObj(objPtr, unicode, length)
825        register Tcl_Obj *objPtr;   /* Points to the object to append to. */
826        Tcl_UniChar *unicode;       /* The unicode string to append to the
827                                     * object. */
828        int length;                 /* Number of chars in "unicode". */
829    {
830        String *stringPtr;
831    
832        if (Tcl_IsShared(objPtr)) {
833            panic("Tcl_AppendUnicodeToObj called with shared object");
834        }
835    
836        if (length == 0) {
837            return;
838        }
839    
840        SetStringFromAny(NULL, objPtr);
841    
842        /*
843         * TEMPORARY!!!  This is terribly inefficient, but it works, and Don
844         * needs for me to check this stuff in ASAP.  -Melissa
845         */
846        
847    /*     UpdateStringOfString(objPtr); */
848    /*     AppendUnicodeToUtfRep(objPtr, unicode, length); */
849    /*     return; */
850    
851        /*
852         * If objPtr has a valid Unicode rep, then append the "unicode"
853         * to the objPtr's Unicode rep, otherwise the UTF conversion of
854         * "unicode" to objPtr's string rep.
855         */
856    
857        stringPtr = GET_STRING(objPtr);
858        if (stringPtr->uallocated > 0) {
859            AppendUnicodeToUnicodeRep(objPtr, unicode, length);
860        } else {
861            AppendUnicodeToUtfRep(objPtr, unicode, length);
862        }
863    }
864    
865    /*
866     *----------------------------------------------------------------------
867     *
868     * Tcl_AppendObjToObj --
869     *
870     *      This procedure appends the string rep of one object to another.
871     *      "objPtr" cannot be a shared object.
872     *
873     * Results:
874     *      None.
875     *
876     * Side effects:
877     *      The string rep of appendObjPtr is appended to the string
878     *      representation of objPtr.
879     *
880     *----------------------------------------------------------------------
881     */
882    
883    void
884    Tcl_AppendObjToObj(objPtr, appendObjPtr)
885        Tcl_Obj *objPtr;            /* Points to the object to append to. */
886        Tcl_Obj *appendObjPtr;      /* Object to append. */
887    {
888        String *stringPtr;
889        int length, numChars, allOneByteChars;
890        char *bytes;
891    
892        SetStringFromAny(NULL, objPtr);
893    
894        /*
895         * If objPtr has a valid Unicode rep, then get a Unicode string
896         * from appendObjPtr and append it.
897         */
898    
899        stringPtr = GET_STRING(objPtr);
900        if (stringPtr->uallocated > 0) {
901            
902            /*
903             * If appendObjPtr is not of the "String" type, don't convert it.
904             */
905    
906            if (appendObjPtr->typePtr == &tclStringType) {
907                stringPtr = GET_STRING(appendObjPtr);
908                if ((stringPtr->numChars == -1)
909                        || (stringPtr->uallocated == 0)) {
910                    
911                    /*
912                     * If appendObjPtr is a string obj with no valide Unicode
913                     * rep, then fill its unicode rep.
914                     */
915    
916                    FillUnicodeRep(appendObjPtr);
917                    stringPtr = GET_STRING(appendObjPtr);
918                }
919                AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
920                        stringPtr->numChars);
921            } else {
922                bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
923                AppendUtfToUnicodeRep(objPtr, bytes, length);
924            }
925            return;
926        }
927    
928        /*
929         * Append to objPtr's UTF string rep.  If we know the number of
930         * characters in both objects before appending, then set the combined
931         * number of characters in the final (appended-to) object.
932         */
933    
934        bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
935    
936        allOneByteChars = 0;
937        numChars = stringPtr->numChars;
938        if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
939            stringPtr = GET_STRING(appendObjPtr);
940            if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
941                numChars += stringPtr->numChars;
942                allOneByteChars = 1;
943            }
944        }
945    
946        AppendUtfToUtfRep(objPtr, bytes, length);
947    
948        if (allOneByteChars) {
949            stringPtr = GET_STRING(objPtr);
950            stringPtr->numChars = numChars;
951        }
952    }
953    
954    /*
955     *----------------------------------------------------------------------
956     *
957     * AppendUnicodeToUnicodeRep --
958     *
959     *      This procedure appends the contents of "unicode" to the Unicode
960     *      rep of "objPtr".  objPtr must already have a valid Unicode rep.
961     *
962     * Results:
963     *      None.
964     *
965     * Side effects:
966     *      objPtr's internal rep is reallocated.
967     *
968     *----------------------------------------------------------------------
969     */
970    
971    static void
972    AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
973        Tcl_Obj *objPtr;          /* Points to the object to append to. */
974        Tcl_UniChar *unicode;     /* String to append. */
975        int appendNumChars;       /* Number of chars of "unicode" to append. */
976    {
977        String *stringPtr;
978        int numChars;
979        size_t newSize;
980    
981        if (appendNumChars < 0) {
982            appendNumChars = 0;
983            if (unicode) {
984                while (unicode[appendNumChars] != 0) { appendNumChars++; }
985            }
986        }
987        if (appendNumChars == 0) {
988            return;
989        }
990    
991        SetStringFromAny(NULL, objPtr);
992        stringPtr = GET_STRING(objPtr);
993        
994        /*
995         * If not enough space has been allocated for the unicode rep,
996         * reallocate the internal rep object with double the amount of
997         * space needed, so the unicode string can grow without being
998         * reallocated.
999         */
1000    
1001        numChars = stringPtr->numChars + appendNumChars;
1002        newSize = (numChars + 1) * sizeof(Tcl_UniChar);
1003    
1004        if (newSize > stringPtr->uallocated) {
1005            stringPtr->uallocated = newSize * 2;
1006            stringPtr = (String *) ckrealloc((char*)stringPtr,
1007                    STRING_SIZE(stringPtr->uallocated));
1008            SET_STRING(objPtr, stringPtr);
1009        }
1010    
1011        /*
1012         * Copy the new string onto the end of the old string, then add the
1013         * trailing null.
1014         */
1015    
1016        memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
1017                appendNumChars * sizeof(Tcl_UniChar));
1018        stringPtr->unicode[numChars] = 0;
1019        stringPtr->numChars = numChars;
1020    
1021        SET_STRING(objPtr, stringPtr);
1022        Tcl_InvalidateStringRep(objPtr);
1023    }
1024    
1025    /*
1026     *----------------------------------------------------------------------
1027     *
1028     * AppendUnicodeToUtfRep --
1029     *
1030     *      This procedure converts the contents of "unicode" to UTF and
1031     *      appends the UTF to the string rep of "objPtr".
1032     *
1033     * Results:
1034     *      None.
1035     *
1036     * Side effects:
1037     *      objPtr's internal rep is reallocated.
1038     *
1039     *----------------------------------------------------------------------
1040     */
1041    
1042    static void
1043    AppendUnicodeToUtfRep(objPtr, unicode, numChars)
1044        Tcl_Obj *objPtr;          /* Points to the object to append to. */
1045        Tcl_UniChar *unicode;     /* String to convert to UTF. */
1046        int numChars;             /* Number of chars of "unicode" to convert. */
1047    {
1048        Tcl_DString dsPtr;
1049        char *bytes;
1050        
1051        if (numChars < 0) {
1052            numChars = 0;
1053            if (unicode) {
1054                while (unicode[numChars] != 0) { numChars++; }
1055            }
1056        }
1057        if (numChars == 0) {
1058            return;
1059        }
1060    
1061        Tcl_DStringInit(&dsPtr);
1062        bytes = (char *)Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
1063        AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
1064        Tcl_DStringFree(&dsPtr);
1065    }
1066    
1067    /*
1068     *----------------------------------------------------------------------
1069     *
1070     * AppendUtfToUnicodeRep --
1071     *
1072     *      This procedure converts the contents of "bytes" to Unicode and
1073     *      appends the Unicode to the Unicode rep of "objPtr".  objPtr must
1074     *      already have a valid Unicode rep.
1075     *
1076     * Results:
1077     *      None.
1078     *
1079     * Side effects:
1080     *      objPtr's internal rep is reallocated.
1081     *
1082     *----------------------------------------------------------------------
1083     */
1084    
1085    static void
1086    AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
1087        Tcl_Obj *objPtr;    /* Points to the object to append to. */
1088        char *bytes;                /* String to convert to Unicode. */
1089        int numBytes;       /* Number of bytes of "bytes" to convert. */
1090    {
1091        Tcl_DString dsPtr;
1092        int numChars;
1093        Tcl_UniChar *unicode;
1094    
1095        if (numBytes < 0) {
1096            numBytes = (bytes ? strlen(bytes) : 0);
1097        }
1098        if (numBytes == 0) {
1099            return;
1100        }
1101        
1102        Tcl_DStringInit(&dsPtr);
1103        numChars = Tcl_NumUtfChars(bytes, numBytes);
1104        unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
1105        AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
1106        Tcl_DStringFree(&dsPtr);
1107    }
1108    
1109    /*
1110     *----------------------------------------------------------------------
1111     *
1112     * AppendUtfToUtfRep --
1113     *
1114     *      This procedure appends "numBytes" bytes of "bytes" to the UTF string
1115     *      rep of "objPtr".  objPtr must already have a valid String rep.
1116     *
1117     * Results:
1118     *      None.
1119     *
1120     * Side effects:
1121     *      objPtr's internal rep is reallocated.
1122     *
1123     *----------------------------------------------------------------------
1124     */
1125    
1126    static void
1127    AppendUtfToUtfRep(objPtr, bytes, numBytes)
1128        Tcl_Obj *objPtr;    /* Points to the object to append to. */
1129        char *bytes;        /* String to append. */
1130        int numBytes;       /* Number of bytes of "bytes" to append. */
1131    {
1132        String *stringPtr;
1133        int newLength, oldLength;
1134    
1135        if (numBytes < 0) {
1136            numBytes = (bytes ? strlen(bytes) : 0);
1137        }
1138        if (numBytes == 0) {
1139            return;
1140        }
1141    
1142        /*
1143         * Copy the new string onto the end of the old string, then add the
1144         * trailing null.
1145         */
1146    
1147        oldLength = objPtr->length;
1148        newLength = numBytes + oldLength;
1149    
1150        stringPtr = GET_STRING(objPtr);
1151        if (newLength > (int) stringPtr->allocated) {
1152    
1153            /*
1154             * There isn't currently enough space in the string
1155             * representation so allocate additional space.  Overallocate the
1156             * space by doubling it so that we won't have to do as much
1157             * reallocation in the future.
1158             */
1159    
1160            Tcl_SetObjLength(objPtr, 2*newLength);
1161        } else {
1162    
1163            /*
1164             * Invalidate the unicode data.
1165             */
1166            
1167            stringPtr->numChars = -1;
1168            stringPtr->uallocated = 0;
1169        }
1170        
1171        memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
1172                (size_t) numBytes);
1173        objPtr->bytes[newLength] = 0;
1174        objPtr->length = newLength;
1175    }
1176    
1177    /*
1178     *----------------------------------------------------------------------
1179     *
1180     * Tcl_AppendStringsToObjVA --
1181     *
1182     *      This procedure appends one or more null-terminated strings
1183     *      to an object.
1184     *
1185     * Results:
1186     *      None.
1187     *
1188     * Side effects:
1189     *      The contents of all the string arguments are appended to the
1190     *      string representation of objPtr.
1191     *
1192     *----------------------------------------------------------------------
1193     */
1194    
1195    void
1196    Tcl_AppendStringsToObjVA (objPtr, argList)
1197        Tcl_Obj *objPtr;            /* Points to the object to append to. */
1198        va_list argList;            /* Variable argument list. */
1199    {
1200    #define STATIC_LIST_SIZE 16
1201        String *stringPtr;
1202        int newLength, oldLength;
1203        register char *string, *dst;
1204        char *static_list[STATIC_LIST_SIZE];
1205        char **args = static_list;
1206        int nargs_space = STATIC_LIST_SIZE;
1207        int nargs, i;
1208    
1209        if (Tcl_IsShared(objPtr)) {
1210            panic("Tcl_AppendStringsToObj called with shared object");
1211        }
1212    
1213        SetStringFromAny(NULL, objPtr);
1214    
1215        /*
1216         * Figure out how much space is needed for all the strings, and
1217         * expand the string representation if it isn't big enough. If no
1218         * bytes would be appended, just return.  Note that on some platforms
1219         * (notably OS/390) the argList is an array so we need to use memcpy.
1220         */
1221    
1222        nargs = 0;
1223        newLength = oldLength = objPtr->length;
1224        while (1) {
1225            string = va_arg(argList, char *);
1226            if (string == NULL) {
1227                break;
1228            }
1229            if (nargs >= nargs_space) {
1230                /*
1231                 * Expand the args buffer
1232                 */
1233                nargs_space += STATIC_LIST_SIZE;
1234                if (args == static_list) {
1235                    args = (void *)ckalloc(nargs_space * sizeof(char *));
1236                    for (i = 0; i < nargs; ++i) {
1237                        args[i] = static_list[i];
1238                    }
1239                } else {
1240                    args = (void *)ckrealloc((void *)args,
1241                            nargs_space * sizeof(char *));
1242                }
1243            }
1244            newLength += strlen(string);
1245            args[nargs++] = string;
1246        }
1247        if (newLength == oldLength) {
1248            goto done;
1249        }
1250    
1251        stringPtr = GET_STRING(objPtr);
1252        if (newLength > (int) stringPtr->allocated) {
1253    
1254            /*
1255             * There isn't currently enough space in the string
1256             * representation so allocate additional space.  If the current
1257             * string representation isn't empty (i.e. it looks like we're
1258             * doing a series of appends) then overallocate the space so
1259             * that we won't have to do as much reallocation in the future.
1260             */
1261    
1262            Tcl_SetObjLength(objPtr,
1263                    (objPtr->length == 0) ? newLength : 2*newLength);
1264        }
1265    
1266        /*
1267         * Make a second pass through the arguments, appending all the
1268         * strings to the object.
1269         */
1270    
1271        dst = objPtr->bytes + oldLength;
1272        for (i = 0; i < nargs; ++i) {
1273            string = args[i];
1274            if (string == NULL) {
1275                break;
1276            }
1277            while (*string != 0) {
1278                *dst = *string;
1279                dst++;
1280                string++;
1281            }
1282        }
1283    
1284        /*
1285         * Add a null byte to terminate the string.  However, be careful:
1286         * it's possible that the object is totally empty (if it was empty
1287         * originally and there was nothing to append).  In this case dst is
1288         * NULL; just leave everything alone.
1289         */
1290    
1291        if (dst != NULL) {
1292            *dst = 0;
1293        }
1294        objPtr->length = newLength;
1295    
1296        done:
1297        /*
1298         * If we had to allocate a buffer from the heap,
1299         * free it now.
1300         */
1301    
1302        if (args != static_list) {
1303            ckfree((void *)args);
1304        }
1305    #undef STATIC_LIST_SIZE
1306    }
1307    
1308    /*
1309     *----------------------------------------------------------------------
1310     *
1311     * Tcl_AppendStringsToObj --
1312     *
1313     *      This procedure appends one or more null-terminated strings
1314     *      to an object.
1315     *
1316     * Results:
1317     *      None.
1318     *
1319     * Side effects:
1320     *      The contents of all the string arguments are appended to the
1321     *      string representation of objPtr.
1322     *
1323     *----------------------------------------------------------------------
1324     */
1325    
1326    void
1327    Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
1328    {
1329        register Tcl_Obj *objPtr;
1330        va_list argList;
1331    
1332        objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
1333        Tcl_AppendStringsToObjVA(objPtr, argList);
1334        va_end(argList);
1335    }
1336    
1337    /*
1338     *---------------------------------------------------------------------------
1339     *
1340     * FillUnicodeRep --
1341     *
1342     *      Populate the Unicode internal rep with the Unicode form of its string
1343     *      rep.  The object must alread have a "String" internal rep.
1344     *
1345     * Results:
1346     *      None.
1347     *
1348     * Side effects:
1349     *      Reallocates the String internal rep.
1350     *
1351     *---------------------------------------------------------------------------
1352     */
1353    
1354    static void
1355    FillUnicodeRep(objPtr)
1356        Tcl_Obj *objPtr;    /* The object in which to fill the unicode rep. */
1357    {
1358        String *stringPtr;
1359        size_t uallocated;
1360        char *src, *srcEnd;
1361        Tcl_UniChar *dst;
1362        src = objPtr->bytes;
1363        
1364        stringPtr = GET_STRING(objPtr);
1365        if (stringPtr->numChars == -1) {
1366            stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
1367        }
1368    
1369        uallocated = stringPtr->numChars * sizeof(Tcl_UniChar);
1370        if (uallocated > stringPtr->uallocated) {
1371        
1372            /*
1373             * If not enough space has been allocated for the unicode rep,
1374             * reallocate the internal rep object.
1375             */
1376    
1377            /*
1378             * There isn't currently enough space in the Unicode
1379             * representation so allocate additional space.  If the current
1380             * Unicode representation isn't empty (i.e. it looks like we've
1381             * done some appends) then overallocate the space so
1382             * that we won't have to do as much reallocation in the future.
1383             */
1384    
1385            if (stringPtr->uallocated > 0) {
1386                uallocated *= 2;
1387            }
1388            stringPtr = (String *) ckrealloc((char*) stringPtr,
1389                    STRING_SIZE(uallocated));
1390            stringPtr->uallocated = uallocated;
1391        }
1392    
1393        /*
1394         * Convert src to Unicode and store the coverted data in "unicode".
1395         */
1396        
1397        srcEnd = src + objPtr->length;
1398        for (dst = stringPtr->unicode; src < srcEnd; dst++) {
1399            src += Tcl_UtfToUniChar(src, dst);
1400        }
1401        *dst = 0;
1402        
1403        SET_STRING(objPtr, stringPtr);
1404    }
1405    
1406    /*
1407     *----------------------------------------------------------------------
1408     *
1409     * DupStringInternalRep --
1410     *
1411     *      Initialize the internal representation of a new Tcl_Obj to a
1412     *      copy of the internal representation of an existing string object.
1413     *
1414     * Results:
1415     *      None.
1416     *
1417     * Side effects:
1418     *      copyPtr's internal rep is set to a copy of srcPtr's internal
1419     *      representation.
1420     *
1421     *----------------------------------------------------------------------
1422     */
1423    
1424    static void
1425    DupStringInternalRep(srcPtr, copyPtr)
1426        register Tcl_Obj *srcPtr;   /* Object with internal rep to copy.  Must
1427                                     * have an internal rep of type "String". */
1428        register Tcl_Obj *copyPtr;  /* Object with internal rep to set.  Must
1429                                     * not currently have an internal rep.*/
1430    {
1431        String *srcStringPtr = GET_STRING(srcPtr);
1432        String *copyStringPtr = NULL;
1433    
1434        /*
1435         * If the src obj is a string of 1-byte Utf chars, then copy the
1436         * string rep of the source object and create an "empty" Unicode
1437         * internal rep for the new object.  Otherwise, copy Unicode
1438         * internal rep, and invalidate the string rep of the new object.
1439         */
1440        
1441        if (srcStringPtr->uallocated == 0) {
1442            copyStringPtr = (String *) ckalloc(sizeof(String));
1443            copyStringPtr->uallocated = 0;
1444        } else {
1445            copyStringPtr = (String *) ckalloc(
1446                STRING_SIZE(srcStringPtr->uallocated));
1447            copyStringPtr->uallocated = srcStringPtr->uallocated;
1448    
1449            memcpy((VOID *) copyStringPtr->unicode,
1450                    (VOID *) srcStringPtr->unicode,
1451                    (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
1452            copyStringPtr->unicode[srcStringPtr->numChars] = 0;
1453        }
1454        copyStringPtr->numChars = srcStringPtr->numChars;
1455        copyStringPtr->allocated = srcStringPtr->allocated;
1456    
1457        /*
1458         * Tricky point: the string value was copied by generic object
1459         * management code, so it doesn't contain any extra bytes that
1460         * might exist in the source object.
1461         */
1462    
1463        copyStringPtr->allocated = copyPtr->length;
1464    
1465        SET_STRING(copyPtr, copyStringPtr);
1466        copyPtr->typePtr = &tclStringType;
1467    }
1468    
1469    /*
1470     *----------------------------------------------------------------------
1471     *
1472     * SetStringFromAny --
1473     *
1474     *      Create an internal representation of type "String" for an object.
1475     *
1476     * Results:
1477     *      This operation always succeeds and returns TCL_OK.
1478     *
1479     * Side effects:
1480     *      Any old internal reputation for objPtr is freed and the
1481     *      internal representation is set to "String".
1482     *
1483     *----------------------------------------------------------------------
1484     */
1485    
1486    static int
1487    SetStringFromAny(interp, objPtr)
1488        Tcl_Interp *interp;         /* Used for error reporting if not NULL. */
1489        Tcl_Obj *objPtr;            /* The object to convert. */
1490    {
1491        String *stringPtr;
1492    
1493        /*
1494         * The Unicode object is opitmized for the case where each UTF char
1495         * in a string is only one byte.  In this case, we store the value of
1496         * numChars, but we don't copy the bytes to the unicodeObj->unicode.
1497         */
1498    
1499        if (objPtr->typePtr != &tclStringType) {
1500    
1501            if (objPtr->typePtr != NULL) {
1502                if (objPtr->bytes == NULL) {
1503                    objPtr->typePtr->updateStringProc(objPtr);
1504                }
1505                if ((objPtr->typePtr->freeIntRepProc) != NULL) {
1506                    (*objPtr->typePtr->freeIntRepProc)(objPtr);
1507                }
1508            }
1509            objPtr->typePtr = &tclStringType;
1510    
1511            /*
1512             * Allocate enough space for the basic String structure.
1513             */
1514    
1515            stringPtr = (String *) ckalloc(sizeof(String));
1516            stringPtr->numChars = -1;
1517            stringPtr->uallocated = 0;
1518    
1519            if (objPtr->bytes != NULL) {
1520                stringPtr->allocated = objPtr->length;          
1521                objPtr->bytes[objPtr->length] = 0;
1522            } else {
1523                objPtr->length = 0;
1524            }
1525            SET_STRING(objPtr, stringPtr);
1526        }
1527        return TCL_OK;
1528    }
1529    
1530    /*
1531     *----------------------------------------------------------------------
1532     *
1533     * UpdateStringOfString --
1534     *
1535     *      Update the string representation for an object whose internal
1536     *      representation is "String".
1537     *
1538     * Results:
1539     *      None.
1540     *
1541     * Side effects:
1542     *      The object's string may be set by converting its Unicode
1543     *      represention to UTF format.
1544     *
1545     *----------------------------------------------------------------------
1546     */
1547    
1548    static void
1549    UpdateStringOfString(objPtr)
1550        Tcl_Obj *objPtr;            /* Object with string rep to update. */
1551    {
1552        int i, length, size;
1553        Tcl_UniChar *unicode;
1554        char dummy[TCL_UTF_MAX];
1555        char *dst;
1556        String *stringPtr;
1557    
1558        stringPtr = GET_STRING(objPtr);
1559        if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
1560    
1561            if (stringPtr->numChars <= 0) {
1562    
1563                /*
1564                 * If there is no Unicode rep, or the string has 0 chars,
1565                 * then set the string rep to an empty string.
1566                 */
1567    
1568                objPtr->bytes = tclEmptyStringRep;
1569                objPtr->length = 0;
1570                return;
1571            }
1572    
1573            unicode = stringPtr->unicode;
1574            length = stringPtr->numChars * sizeof(Tcl_UniChar);
1575    
1576            /*
1577             * Translate the Unicode string to UTF.  "size" will hold the
1578             * amount of space the UTF string needs.
1579             */
1580    
1581            size = 0;
1582            for (i = 0; i < stringPtr->numChars; i++) {
1583                size += Tcl_UniCharToUtf((int) unicode[i], dummy);
1584            }
1585            
1586            dst = (char *) ckalloc((unsigned) (size + 1));
1587            objPtr->bytes = dst;
1588            objPtr->length = size;
1589            stringPtr->allocated = size;
1590    
1591            for (i = 0; i < stringPtr->numChars; i++) {
1592                dst += Tcl_UniCharToUtf(unicode[i], dst);
1593            }
1594            *dst = '\0';
1595        }
1596        return;
1597    }
1598    
1599    /*
1600     *----------------------------------------------------------------------
1601     *
1602     * FreeStringInternalRep --
1603     *
1604     *      Deallocate the storage associated with a String data object's
1605     *      internal representation.
1606     *
1607     * Results:
1608     *      None.
1609     *
1610     * Side effects:
1611     *      Frees memory.
1612     *
1613     *----------------------------------------------------------------------
1614     */
1615    
1616    static void
1617    FreeStringInternalRep(objPtr)
1618        Tcl_Obj *objPtr;            /* Object with internal rep to free. */
1619    {
1620        ckfree((char *) GET_STRING(objPtr));
1621    }
1622    
1623    /* End of tclstringobj.c */
Legend:
Removed from v.25  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25