tclStringObj.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:53k
源码类别:

通讯编程

开发平台:

Visual C++

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