os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStringObj.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStringObj.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1880 @@
1.4 +/*
1.5 + * tclStringObj.c --
1.6 + *
1.7 + * This file contains procedures that implement string operations on Tcl
1.8 + * objects. Some string operations work with UTF strings and others
1.9 + * require Unicode format. Functions that require knowledge of the width
1.10 + * of each character, such as indexing, operate on Unicode data.
1.11 + *
1.12 + * A Unicode string is an internationalized string. Conceptually, a
1.13 + * Unicode string is an array of 16-bit quantities organized as a sequence
1.14 + * of properly formed UTF-8 characters. There is a one-to-one map between
1.15 + * Unicode and UTF characters. Because Unicode characters have a fixed
1.16 + * width, operations such as indexing operate on Unicode data. The String
1.17 + * object is optimized for the case where each UTF char in a string is
1.18 + * only one byte. In this case, we store the value of numChars, but we
1.19 + * don't store the Unicode data (unless Tcl_GetUnicode is explicitly
1.20 + * called).
1.21 + *
1.22 + * The String object type stores one or both formats. The default
1.23 + * behavior is to store UTF. Once Unicode is calculated by a function, it
1.24 + * is stored in the internal rep for future access (without an additional
1.25 + * O(n) cost).
1.26 + *
1.27 + * To allow many appends to be done to an object without constantly
1.28 + * reallocating the space for the string or Unicode representation, we
1.29 + * allocate double the space for the string or Unicode and use the
1.30 + * internal representation to keep track of how much space is used
1.31 + * vs. allocated.
1.32 + *
1.33 + * Copyright (c) 1995-1997 Sun Microsystems, Inc.
1.34 + * Copyright (c) 1999 by Scriptics Corporation.
1.35 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.36 + *
1.37 + * See the file "license.terms" for information on usage and redistribution
1.38 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.39 + *
1.40 + * RCS: @(#) $Id: tclStringObj.c,v 1.32.2.2 2006/09/24 21:15:11 msofer Exp $ */
1.41 +
1.42 +#include "tclInt.h"
1.43 +
1.44 +/*
1.45 + * Prototypes for procedures defined later in this file:
1.46 + */
1.47 +
1.48 +static void AppendUnicodeToUnicodeRep _ANSI_ARGS_((
1.49 + Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
1.50 + int appendNumChars));
1.51 +static void AppendUnicodeToUtfRep _ANSI_ARGS_((
1.52 + Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode,
1.53 + int numChars));
1.54 +static void AppendUtfToUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr,
1.55 + CONST char *bytes, int numBytes));
1.56 +static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
1.57 + CONST char *bytes, int numBytes));
1.58 +
1.59 +static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
1.60 +
1.61 +static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
1.62 +static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
1.63 + Tcl_Obj *copyPtr));
1.64 +static int SetStringFromAny _ANSI_ARGS_((Tcl_Interp *interp,
1.65 + Tcl_Obj *objPtr));
1.66 +static void UpdateStringOfString _ANSI_ARGS_((Tcl_Obj *objPtr));
1.67 +
1.68 +/*
1.69 + * The structure below defines the string Tcl object type by means of
1.70 + * procedures that can be invoked by generic object code.
1.71 + */
1.72 +
1.73 +Tcl_ObjType tclStringType = {
1.74 + "string", /* name */
1.75 + FreeStringInternalRep, /* freeIntRepPro */
1.76 + DupStringInternalRep, /* dupIntRepProc */
1.77 + UpdateStringOfString, /* updateStringProc */
1.78 + SetStringFromAny /* setFromAnyProc */
1.79 +};
1.80 +
1.81 +/*
1.82 + * The following structure is the internal rep for a String object.
1.83 + * It keeps track of how much memory has been used and how much has been
1.84 + * allocated for the Unicode and UTF string to enable growing and
1.85 + * shrinking of the UTF and Unicode reps of the String object with fewer
1.86 + * mallocs. To optimize string length and indexing operations, this
1.87 + * structure also stores the number of characters (same of UTF and Unicode!)
1.88 + * once that value has been computed.
1.89 + */
1.90 +
1.91 +typedef struct String {
1.92 + int numChars; /* The number of chars in the string.
1.93 + * -1 means this value has not been
1.94 + * calculated. >= 0 means that there is a
1.95 + * valid Unicode rep, or that the number
1.96 + * of UTF bytes == the number of chars. */
1.97 + size_t allocated; /* The amount of space actually allocated
1.98 + * for the UTF string (minus 1 byte for
1.99 + * the termination char). */
1.100 + size_t uallocated; /* The amount of space actually allocated
1.101 + * for the Unicode string (minus 2 bytes for
1.102 + * the termination char). */
1.103 + int hasUnicode; /* Boolean determining whether the string
1.104 + * has a Unicode representation. */
1.105 + Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual
1.106 + * size of this field depends on the
1.107 + * 'uallocated' field above. */
1.108 +} String;
1.109 +
1.110 +#define STRING_UALLOC(numChars) \
1.111 + (numChars * sizeof(Tcl_UniChar))
1.112 +#define STRING_SIZE(ualloc) \
1.113 + ((unsigned) ((ualloc) \
1.114 + ? sizeof(String) - sizeof(Tcl_UniChar) + (ualloc) \
1.115 + : sizeof(String)))
1.116 +#define GET_STRING(objPtr) \
1.117 + ((String *) (objPtr)->internalRep.otherValuePtr)
1.118 +#define SET_STRING(objPtr, stringPtr) \
1.119 + (objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
1.120 +
1.121 +/*
1.122 + * TCL STRING GROWTH ALGORITHM
1.123 + *
1.124 + * When growing strings (during an append, for example), the following growth
1.125 + * algorithm is used:
1.126 + *
1.127 + * Attempt to allocate 2 * (originalLength + appendLength)
1.128 + * On failure:
1.129 + * attempt to allocate originalLength + 2*appendLength +
1.130 + * TCL_GROWTH_MIN_ALLOC
1.131 + *
1.132 + * This algorithm allows very good performance, as it rapidly increases the
1.133 + * memory allocated for a given string, which minimizes the number of
1.134 + * reallocations that must be performed. However, using only the doubling
1.135 + * algorithm can lead to a significant waste of memory. In particular, it
1.136 + * may fail even when there is sufficient memory available to complete the
1.137 + * append request (but there is not 2 * totalLength memory available). So when
1.138 + * the doubling fails (because there is not enough memory available), the
1.139 + * algorithm requests a smaller amount of memory, which is still enough to
1.140 + * cover the request, but which hopefully will be less than the total available
1.141 + * memory.
1.142 + *
1.143 + * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling
1.144 + * of very small appends. Without this extra slush factor, a sequence
1.145 + * of several small appends would cause several memory allocations.
1.146 + * As long as TCL_GROWTH_MIN_ALLOC is a reasonable size, we can
1.147 + * avoid that behavior.
1.148 + *
1.149 + * The growth algorithm can be tuned by adjusting the following parameters:
1.150 + *
1.151 + * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when
1.152 + * the double allocation has failed.
1.153 + * Default is 1024 (1 kilobyte).
1.154 + */
1.155 +#ifndef TCL_GROWTH_MIN_ALLOC
1.156 +#define TCL_GROWTH_MIN_ALLOC 1024
1.157 +#endif
1.158 +
1.159 +
1.160 +/*
1.161 + *----------------------------------------------------------------------
1.162 + *
1.163 + * Tcl_NewStringObj --
1.164 + *
1.165 + * This procedure is normally called when not debugging: i.e., when
1.166 + * TCL_MEM_DEBUG is not defined. It creates a new string object and
1.167 + * initializes it from the byte pointer and length arguments.
1.168 + *
1.169 + * When TCL_MEM_DEBUG is defined, this procedure just returns the
1.170 + * result of calling the debugging version Tcl_DbNewStringObj.
1.171 + *
1.172 + * Results:
1.173 + * A newly created string object is returned that has ref count zero.
1.174 + *
1.175 + * Side effects:
1.176 + * The new object's internal string representation will be set to a
1.177 + * copy of the length bytes starting at "bytes". If "length" is
1.178 + * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
1.179 + * points to a C-style NULL-terminated string. The object's type is set
1.180 + * to NULL. An extra NULL is added to the end of the new object's byte
1.181 + * array.
1.182 + *
1.183 + *----------------------------------------------------------------------
1.184 + */
1.185 +
1.186 +#ifdef TCL_MEM_DEBUG
1.187 +#undef Tcl_NewStringObj
1.188 +
1.189 +EXPORT_C Tcl_Obj *
1.190 +Tcl_NewStringObj(bytes, length)
1.191 + CONST char *bytes; /* Points to the first of the length bytes
1.192 + * used to initialize the new object. */
1.193 + int length; /* The number of bytes to copy from "bytes"
1.194 + * when initializing the new object. If
1.195 + * negative, use bytes up to the first
1.196 + * NULL byte. */
1.197 +{
1.198 + return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
1.199 +}
1.200 +
1.201 +#else /* if not TCL_MEM_DEBUG */
1.202 +
1.203 +EXPORT_C Tcl_Obj *
1.204 +Tcl_NewStringObj(bytes, length)
1.205 + CONST char *bytes; /* Points to the first of the length bytes
1.206 + * used to initialize the new object. */
1.207 + int length; /* The number of bytes to copy from "bytes"
1.208 + * when initializing the new object. If
1.209 + * negative, use bytes up to the first
1.210 + * NULL byte. */
1.211 +{
1.212 + register Tcl_Obj *objPtr;
1.213 +
1.214 + if (length < 0) {
1.215 + length = (bytes? strlen(bytes) : 0);
1.216 + }
1.217 + TclNewObj(objPtr);
1.218 + TclInitStringRep(objPtr, bytes, length);
1.219 + return objPtr;
1.220 +}
1.221 +#endif /* TCL_MEM_DEBUG */
1.222 +
1.223 +/*
1.224 + *----------------------------------------------------------------------
1.225 + *
1.226 + * Tcl_DbNewStringObj --
1.227 + *
1.228 + * This procedure is normally called when debugging: i.e., when
1.229 + * TCL_MEM_DEBUG is defined. It creates new string objects. It is the
1.230 + * same as the Tcl_NewStringObj procedure above except that it calls
1.231 + * Tcl_DbCkalloc directly with the file name and line number from its
1.232 + * caller. This simplifies debugging since then the [memory active]
1.233 + * command will report the correct file name and line number when
1.234 + * reporting objects that haven't been freed.
1.235 + *
1.236 + * When TCL_MEM_DEBUG is not defined, this procedure just returns the
1.237 + * result of calling Tcl_NewStringObj.
1.238 + *
1.239 + * Results:
1.240 + * A newly created string object is returned that has ref count zero.
1.241 + *
1.242 + * Side effects:
1.243 + * The new object's internal string representation will be set to a
1.244 + * copy of the length bytes starting at "bytes". If "length" is
1.245 + * negative, use bytes up to the first NULL byte; i.e., assume "bytes"
1.246 + * points to a C-style NULL-terminated string. The object's type is set
1.247 + * to NULL. An extra NULL is added to the end of the new object's byte
1.248 + * array.
1.249 + *
1.250 + *----------------------------------------------------------------------
1.251 + */
1.252 +
1.253 +#ifdef TCL_MEM_DEBUG
1.254 +
1.255 +EXPORT_C Tcl_Obj *
1.256 +Tcl_DbNewStringObj(bytes, length, file, line)
1.257 + CONST char *bytes; /* Points to the first of the length bytes
1.258 + * used to initialize the new object. */
1.259 + int length; /* The number of bytes to copy from "bytes"
1.260 + * when initializing the new object. If
1.261 + * negative, use bytes up to the first
1.262 + * NULL byte. */
1.263 + CONST char *file; /* The name of the source file calling this
1.264 + * procedure; used for debugging. */
1.265 + int line; /* Line number in the source file; used
1.266 + * for debugging. */
1.267 +{
1.268 + register Tcl_Obj *objPtr;
1.269 +
1.270 + if (length < 0) {
1.271 + length = (bytes? strlen(bytes) : 0);
1.272 + }
1.273 + TclDbNewObj(objPtr, file, line);
1.274 + TclInitStringRep(objPtr, bytes, length);
1.275 + return objPtr;
1.276 +}
1.277 +
1.278 +#else /* if not TCL_MEM_DEBUG */
1.279 +
1.280 +EXPORT_C Tcl_Obj *
1.281 +Tcl_DbNewStringObj(bytes, length, file, line)
1.282 + CONST char *bytes; /* Points to the first of the length bytes
1.283 + * used to initialize the new object. */
1.284 + register int length; /* The number of bytes to copy from "bytes"
1.285 + * when initializing the new object. If
1.286 + * negative, use bytes up to the first
1.287 + * NULL byte. */
1.288 + CONST char *file; /* The name of the source file calling this
1.289 + * procedure; used for debugging. */
1.290 + int line; /* Line number in the source file; used
1.291 + * for debugging. */
1.292 +{
1.293 + return Tcl_NewStringObj(bytes, length);
1.294 +}
1.295 +#endif /* TCL_MEM_DEBUG */
1.296 +
1.297 +/*
1.298 + *---------------------------------------------------------------------------
1.299 + *
1.300 + * Tcl_NewUnicodeObj --
1.301 + *
1.302 + * This procedure is creates a new String object and initializes
1.303 + * it from the given Unicode String. If the Utf String is the same size
1.304 + * as the Unicode string, don't duplicate the data.
1.305 + *
1.306 + * Results:
1.307 + * The newly created object is returned. This object will have no
1.308 + * initial string representation. The returned object has a ref count
1.309 + * of 0.
1.310 + *
1.311 + * Side effects:
1.312 + * Memory allocated for new object and copy of Unicode argument.
1.313 + *
1.314 + *---------------------------------------------------------------------------
1.315 + */
1.316 +
1.317 +EXPORT_C Tcl_Obj *
1.318 +Tcl_NewUnicodeObj(unicode, numChars)
1.319 + CONST Tcl_UniChar *unicode; /* The unicode string used to initialize
1.320 + * the new object. */
1.321 + int numChars; /* Number of characters in the unicode
1.322 + * string. */
1.323 +{
1.324 + Tcl_Obj *objPtr;
1.325 + String *stringPtr;
1.326 + size_t uallocated;
1.327 +
1.328 + if (numChars < 0) {
1.329 + numChars = 0;
1.330 + if (unicode) {
1.331 + while (unicode[numChars] != 0) { numChars++; }
1.332 + }
1.333 + }
1.334 + uallocated = STRING_UALLOC(numChars);
1.335 +
1.336 + /*
1.337 + * Create a new obj with an invalid string rep.
1.338 + */
1.339 +
1.340 + TclNewObj(objPtr);
1.341 + Tcl_InvalidateStringRep(objPtr);
1.342 + objPtr->typePtr = &tclStringType;
1.343 +
1.344 + stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
1.345 + stringPtr->numChars = numChars;
1.346 + stringPtr->uallocated = uallocated;
1.347 + stringPtr->hasUnicode = (numChars > 0);
1.348 + stringPtr->allocated = 0;
1.349 + memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
1.350 + stringPtr->unicode[numChars] = 0;
1.351 + SET_STRING(objPtr, stringPtr);
1.352 + return objPtr;
1.353 +}
1.354 +
1.355 +/*
1.356 + *----------------------------------------------------------------------
1.357 + *
1.358 + * Tcl_GetCharLength --
1.359 + *
1.360 + * Get the length of the Unicode string from the Tcl object.
1.361 + *
1.362 + * Results:
1.363 + * Pointer to unicode string representing the unicode object.
1.364 + *
1.365 + * Side effects:
1.366 + * Frees old internal rep. Allocates memory for new "String"
1.367 + * internal rep.
1.368 + *
1.369 + *----------------------------------------------------------------------
1.370 + */
1.371 +
1.372 +EXPORT_C int
1.373 +Tcl_GetCharLength(objPtr)
1.374 + Tcl_Obj *objPtr; /* The String object to get the num chars of. */
1.375 +{
1.376 + String *stringPtr;
1.377 +
1.378 + SetStringFromAny(NULL, objPtr);
1.379 + stringPtr = GET_STRING(objPtr);
1.380 +
1.381 + /*
1.382 + * If numChars is unknown, then calculate the number of characaters
1.383 + * while populating the Unicode string.
1.384 + */
1.385 +
1.386 + if (stringPtr->numChars == -1) {
1.387 + register int i = objPtr->length;
1.388 + register unsigned char *str = (unsigned char *) objPtr->bytes;
1.389 +
1.390 + /*
1.391 + * This is a speed sensitive function, so run specially over the
1.392 + * string to count continuous ascii characters before resorting
1.393 + * to the Tcl_NumUtfChars call. This is a long form of:
1.394 + stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
1.395 + */
1.396 +
1.397 + while (i && (*str < 0xC0)) { i--; str++; }
1.398 + stringPtr->numChars = objPtr->length - i;
1.399 + if (i) {
1.400 + stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
1.401 + + (objPtr->length - i), i);
1.402 + }
1.403 +
1.404 + if (stringPtr->numChars == objPtr->length) {
1.405 +
1.406 + /*
1.407 + * Since we've just calculated the number of chars, and all
1.408 + * UTF chars are 1-byte long, we don't need to store the
1.409 + * unicode string.
1.410 + */
1.411 +
1.412 + stringPtr->hasUnicode = 0;
1.413 +
1.414 + } else {
1.415 +
1.416 + /*
1.417 + * Since we've just calucalated the number of chars, and not
1.418 + * all UTF chars are 1-byte long, go ahead and populate the
1.419 + * unicode string.
1.420 + */
1.421 +
1.422 + FillUnicodeRep(objPtr);
1.423 +
1.424 + /*
1.425 + * We need to fetch the pointer again because we have just
1.426 + * reallocated the structure to make room for the Unicode data.
1.427 + */
1.428 +
1.429 + stringPtr = GET_STRING(objPtr);
1.430 + }
1.431 + }
1.432 + return stringPtr->numChars;
1.433 +}
1.434 +
1.435 +/*
1.436 + *----------------------------------------------------------------------
1.437 + *
1.438 + * Tcl_GetUniChar --
1.439 + *
1.440 + * Get the index'th Unicode character from the String object. The
1.441 + * index is assumed to be in the appropriate range.
1.442 + *
1.443 + * Results:
1.444 + * Returns the index'th Unicode character in the Object.
1.445 + *
1.446 + * Side effects:
1.447 + * Fills unichar with the index'th Unicode character.
1.448 + *
1.449 + *----------------------------------------------------------------------
1.450 + */
1.451 +
1.452 +EXPORT_C Tcl_UniChar
1.453 +Tcl_GetUniChar(objPtr, index)
1.454 + Tcl_Obj *objPtr; /* The object to get the Unicode charater from. */
1.455 + int index; /* Get the index'th Unicode character. */
1.456 +{
1.457 + Tcl_UniChar unichar;
1.458 + String *stringPtr;
1.459 +
1.460 + SetStringFromAny(NULL, objPtr);
1.461 + stringPtr = GET_STRING(objPtr);
1.462 +
1.463 + if (stringPtr->numChars == -1) {
1.464 +
1.465 + /*
1.466 + * We haven't yet calculated the length, so we don't have the
1.467 + * Unicode str. We need to know the number of chars before we
1.468 + * can do indexing.
1.469 + */
1.470 +
1.471 + Tcl_GetCharLength(objPtr);
1.472 +
1.473 + /*
1.474 + * We need to fetch the pointer again because we may have just
1.475 + * reallocated the structure.
1.476 + */
1.477 +
1.478 + stringPtr = GET_STRING(objPtr);
1.479 + }
1.480 + if (stringPtr->hasUnicode == 0) {
1.481 +
1.482 + /*
1.483 + * All of the characters in the Utf string are 1 byte chars,
1.484 + * so we don't store the unicode char. We get the Utf string
1.485 + * and convert the index'th byte to a Unicode character.
1.486 + */
1.487 +
1.488 + unichar = (Tcl_UniChar) objPtr->bytes[index];
1.489 + } else {
1.490 + unichar = stringPtr->unicode[index];
1.491 + }
1.492 + return unichar;
1.493 +}
1.494 +
1.495 +/*
1.496 + *----------------------------------------------------------------------
1.497 + *
1.498 + * Tcl_GetUnicode --
1.499 + *
1.500 + * Get the Unicode form of the String object. If
1.501 + * the object is not already a String object, it will be converted
1.502 + * to one. If the String object does not have a Unicode rep, then
1.503 + * one is create from the UTF string format.
1.504 + *
1.505 + * Results:
1.506 + * Returns a pointer to the object's internal Unicode string.
1.507 + *
1.508 + * Side effects:
1.509 + * Converts the object to have the String internal rep.
1.510 + *
1.511 + *----------------------------------------------------------------------
1.512 + */
1.513 +
1.514 +EXPORT_C Tcl_UniChar *
1.515 +Tcl_GetUnicode(objPtr)
1.516 + Tcl_Obj *objPtr; /* The object to find the unicode string for. */
1.517 +{
1.518 + String *stringPtr;
1.519 +
1.520 + SetStringFromAny(NULL, objPtr);
1.521 + stringPtr = GET_STRING(objPtr);
1.522 +
1.523 + if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
1.524 +
1.525 + /*
1.526 + * We haven't yet calculated the length, or all of the characters
1.527 + * in the Utf string are 1 byte chars (so we didn't store the
1.528 + * unicode str). Since this function must return a unicode string,
1.529 + * and one has not yet been stored, force the Unicode to be
1.530 + * calculated and stored now.
1.531 + */
1.532 +
1.533 + FillUnicodeRep(objPtr);
1.534 +
1.535 + /*
1.536 + * We need to fetch the pointer again because we have just
1.537 + * reallocated the structure to make room for the Unicode data.
1.538 + */
1.539 +
1.540 + stringPtr = GET_STRING(objPtr);
1.541 + }
1.542 + return stringPtr->unicode;
1.543 +}
1.544 +
1.545 +/*
1.546 + *----------------------------------------------------------------------
1.547 + *
1.548 + * Tcl_GetUnicodeFromObj --
1.549 + *
1.550 + * Get the Unicode form of the String object with length. If
1.551 + * the object is not already a String object, it will be converted
1.552 + * to one. If the String object does not have a Unicode rep, then
1.553 + * one is create from the UTF string format.
1.554 + *
1.555 + * Results:
1.556 + * Returns a pointer to the object's internal Unicode string.
1.557 + *
1.558 + * Side effects:
1.559 + * Converts the object to have the String internal rep.
1.560 + *
1.561 + *----------------------------------------------------------------------
1.562 + */
1.563 +
1.564 +EXPORT_C Tcl_UniChar *
1.565 +Tcl_GetUnicodeFromObj(objPtr, lengthPtr)
1.566 + Tcl_Obj *objPtr; /* The object to find the unicode string for. */
1.567 + int *lengthPtr; /* If non-NULL, the location where the
1.568 + * string rep's unichar length should be
1.569 + * stored. If NULL, no length is stored. */
1.570 +{
1.571 + String *stringPtr;
1.572 +
1.573 + SetStringFromAny(NULL, objPtr);
1.574 + stringPtr = GET_STRING(objPtr);
1.575 +
1.576 + if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
1.577 +
1.578 + /*
1.579 + * We haven't yet calculated the length, or all of the characters
1.580 + * in the Utf string are 1 byte chars (so we didn't store the
1.581 + * unicode str). Since this function must return a unicode string,
1.582 + * and one has not yet been stored, force the Unicode to be
1.583 + * calculated and stored now.
1.584 + */
1.585 +
1.586 + FillUnicodeRep(objPtr);
1.587 +
1.588 + /*
1.589 + * We need to fetch the pointer again because we have just
1.590 + * reallocated the structure to make room for the Unicode data.
1.591 + */
1.592 +
1.593 + stringPtr = GET_STRING(objPtr);
1.594 + }
1.595 +
1.596 + if (lengthPtr != NULL) {
1.597 + *lengthPtr = stringPtr->numChars;
1.598 + }
1.599 + return stringPtr->unicode;
1.600 +}
1.601 +
1.602 +/*
1.603 + *----------------------------------------------------------------------
1.604 + *
1.605 + * Tcl_GetRange --
1.606 + *
1.607 + * Create a Tcl Object that contains the chars between first and last
1.608 + * of the object indicated by "objPtr". If the object is not already
1.609 + * a String object, convert it to one. The first and last indices
1.610 + * are assumed to be in the appropriate range.
1.611 + *
1.612 + * Results:
1.613 + * Returns a new Tcl Object of the String type.
1.614 + *
1.615 + * Side effects:
1.616 + * Changes the internal rep of "objPtr" to the String type.
1.617 + *
1.618 + *----------------------------------------------------------------------
1.619 + */
1.620 +
1.621 +EXPORT_C Tcl_Obj *
1.622 +Tcl_GetRange(objPtr, first, last)
1.623 + Tcl_Obj *objPtr; /* The Tcl object to find the range of. */
1.624 + int first; /* First index of the range. */
1.625 + int last; /* Last index of the range. */
1.626 +{
1.627 + Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
1.628 + String *stringPtr;
1.629 +
1.630 + SetStringFromAny(NULL, objPtr);
1.631 + stringPtr = GET_STRING(objPtr);
1.632 +
1.633 + if (stringPtr->numChars == -1) {
1.634 +
1.635 + /*
1.636 + * We haven't yet calculated the length, so we don't have the
1.637 + * Unicode str. We need to know the number of chars before we
1.638 + * can do indexing.
1.639 + */
1.640 +
1.641 + Tcl_GetCharLength(objPtr);
1.642 +
1.643 + /*
1.644 + * We need to fetch the pointer again because we may have just
1.645 + * reallocated the structure.
1.646 + */
1.647 +
1.648 + stringPtr = GET_STRING(objPtr);
1.649 + }
1.650 +
1.651 + if (objPtr->bytes && stringPtr->numChars == objPtr->length) {
1.652 + char *str = Tcl_GetString(objPtr);
1.653 +
1.654 + /*
1.655 + * All of the characters in the Utf string are 1 byte chars,
1.656 + * so we don't store the unicode char. Create a new string
1.657 + * object containing the specified range of chars.
1.658 + */
1.659 +
1.660 + newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
1.661 +
1.662 + /*
1.663 + * Since we know the new string only has 1-byte chars, we
1.664 + * can set it's numChars field.
1.665 + */
1.666 +
1.667 + SetStringFromAny(NULL, newObjPtr);
1.668 + stringPtr = GET_STRING(newObjPtr);
1.669 + stringPtr->numChars = last-first+1;
1.670 + } else {
1.671 + newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
1.672 + last-first+1);
1.673 + }
1.674 + return newObjPtr;
1.675 +}
1.676 +
1.677 +/*
1.678 + *----------------------------------------------------------------------
1.679 + *
1.680 + * Tcl_SetStringObj --
1.681 + *
1.682 + * Modify an object to hold a string that is a copy of the bytes
1.683 + * indicated by the byte pointer and length arguments.
1.684 + *
1.685 + * Results:
1.686 + * None.
1.687 + *
1.688 + * Side effects:
1.689 + * The object's string representation will be set to a copy of
1.690 + * the "length" bytes starting at "bytes". If "length" is negative, use
1.691 + * bytes up to the first NULL byte; i.e., assume "bytes" points to a
1.692 + * C-style NULL-terminated string. The object's old string and internal
1.693 + * representations are freed and the object's type is set NULL.
1.694 + *
1.695 + *----------------------------------------------------------------------
1.696 + */
1.697 +
1.698 +EXPORT_C void
1.699 +Tcl_SetStringObj(objPtr, bytes, length)
1.700 + register Tcl_Obj *objPtr; /* Object whose internal rep to init. */
1.701 + CONST char *bytes; /* Points to the first of the length bytes
1.702 + * used to initialize the object. */
1.703 + register int length; /* The number of bytes to copy from "bytes"
1.704 + * when initializing the object. If
1.705 + * negative, use bytes up to the first
1.706 + * NULL byte.*/
1.707 +{
1.708 + register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
1.709 +
1.710 + /*
1.711 + * Free any old string rep, then set the string rep to a copy of
1.712 + * the length bytes starting at "bytes".
1.713 + */
1.714 +
1.715 + if (Tcl_IsShared(objPtr)) {
1.716 + panic("Tcl_SetStringObj called with shared object");
1.717 + }
1.718 +
1.719 + /*
1.720 + * Set the type to NULL and free any internal rep for the old type.
1.721 + */
1.722 +
1.723 + if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
1.724 + oldTypePtr->freeIntRepProc(objPtr);
1.725 + }
1.726 + objPtr->typePtr = NULL;
1.727 +
1.728 + Tcl_InvalidateStringRep(objPtr);
1.729 + if (length < 0) {
1.730 + length = (bytes? strlen(bytes) : 0);
1.731 + }
1.732 + TclInitStringRep(objPtr, bytes, length);
1.733 +}
1.734 +
1.735 +/*
1.736 + *----------------------------------------------------------------------
1.737 + *
1.738 + * Tcl_SetObjLength --
1.739 + *
1.740 + * This procedure changes the length of the string representation
1.741 + * of an object.
1.742 + *
1.743 + * Results:
1.744 + * None.
1.745 + *
1.746 + * Side effects:
1.747 + * If the size of objPtr's string representation is greater than
1.748 + * length, then it is reduced to length and a new terminating null
1.749 + * byte is stored in the strength. If the length of the string
1.750 + * representation is greater than length, the storage space is
1.751 + * reallocated to the given length; a null byte is stored at the
1.752 + * end, but other bytes past the end of the original string
1.753 + * representation are undefined. The object's internal
1.754 + * representation is changed to "expendable string".
1.755 + *
1.756 + *----------------------------------------------------------------------
1.757 + */
1.758 +
1.759 +EXPORT_C void
1.760 +Tcl_SetObjLength(objPtr, length)
1.761 + register Tcl_Obj *objPtr; /* Pointer to object. This object must
1.762 + * not currently be shared. */
1.763 + register int length; /* Number of bytes desired for string
1.764 + * representation of object, not including
1.765 + * terminating null byte. */
1.766 +{
1.767 + String *stringPtr;
1.768 +
1.769 + if (Tcl_IsShared(objPtr)) {
1.770 + panic("Tcl_SetObjLength called with shared object");
1.771 + }
1.772 + SetStringFromAny(NULL, objPtr);
1.773 +
1.774 + stringPtr = GET_STRING(objPtr);
1.775 +
1.776 + /* Check that we're not extending a pure unicode string */
1.777 +
1.778 + if (length > (int) stringPtr->allocated &&
1.779 + (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
1.780 + char *new;
1.781 +
1.782 + /*
1.783 + * Not enough space in current string. Reallocate the string
1.784 + * space and free the old string.
1.785 + */
1.786 + if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
1.787 + new = (char *) ckrealloc((char *)objPtr->bytes,
1.788 + (unsigned)(length+1));
1.789 + } else {
1.790 + new = (char *) ckalloc((unsigned) (length+1));
1.791 + if (objPtr->bytes != NULL && objPtr->length != 0) {
1.792 + memcpy((VOID *) new, (VOID *) objPtr->bytes,
1.793 + (size_t) objPtr->length);
1.794 + Tcl_InvalidateStringRep(objPtr);
1.795 + }
1.796 + }
1.797 + objPtr->bytes = new;
1.798 + stringPtr->allocated = length;
1.799 + /* Invalidate the unicode data. */
1.800 + stringPtr->hasUnicode = 0;
1.801 + }
1.802 +
1.803 + if (objPtr->bytes != NULL) {
1.804 + objPtr->length = length;
1.805 + if (objPtr->bytes != tclEmptyStringRep) {
1.806 + /* Ensure the string is NULL-terminated */
1.807 + objPtr->bytes[length] = 0;
1.808 + }
1.809 + /* Invalidate the unicode data. */
1.810 + stringPtr->numChars = -1;
1.811 + stringPtr->hasUnicode = 0;
1.812 + } else {
1.813 + /* Changing length of pure unicode string */
1.814 + size_t uallocated = STRING_UALLOC(length);
1.815 + if (uallocated > stringPtr->uallocated) {
1.816 + stringPtr = (String *) ckrealloc((char*) stringPtr,
1.817 + STRING_SIZE(uallocated));
1.818 + SET_STRING(objPtr, stringPtr);
1.819 + stringPtr->uallocated = uallocated;
1.820 + }
1.821 + stringPtr->numChars = length;
1.822 + stringPtr->hasUnicode = (length > 0);
1.823 + /* Ensure the string is NULL-terminated */
1.824 + stringPtr->unicode[length] = 0;
1.825 + stringPtr->allocated = 0;
1.826 + objPtr->length = 0;
1.827 + }
1.828 +}
1.829 +
1.830 +/*
1.831 + *----------------------------------------------------------------------
1.832 + *
1.833 + * Tcl_AttemptSetObjLength --
1.834 + *
1.835 + * This procedure changes the length of the string representation
1.836 + * of an object. It uses the attempt* (non-panic'ing) memory allocators.
1.837 + *
1.838 + * Results:
1.839 + * 1 if the requested memory was allocated, 0 otherwise.
1.840 + *
1.841 + * Side effects:
1.842 + * If the size of objPtr's string representation is greater than
1.843 + * length, then it is reduced to length and a new terminating null
1.844 + * byte is stored in the strength. If the length of the string
1.845 + * representation is greater than length, the storage space is
1.846 + * reallocated to the given length; a null byte is stored at the
1.847 + * end, but other bytes past the end of the original string
1.848 + * representation are undefined. The object's internal
1.849 + * representation is changed to "expendable string".
1.850 + *
1.851 + *----------------------------------------------------------------------
1.852 + */
1.853 +
1.854 +EXPORT_C int
1.855 +Tcl_AttemptSetObjLength(objPtr, length)
1.856 + register Tcl_Obj *objPtr; /* Pointer to object. This object must
1.857 + * not currently be shared. */
1.858 + register int length; /* Number of bytes desired for string
1.859 + * representation of object, not including
1.860 + * terminating null byte. */
1.861 +{
1.862 + String *stringPtr;
1.863 +
1.864 + if (Tcl_IsShared(objPtr)) {
1.865 + panic("Tcl_AttemptSetObjLength called with shared object");
1.866 + }
1.867 + SetStringFromAny(NULL, objPtr);
1.868 +
1.869 + stringPtr = GET_STRING(objPtr);
1.870 +
1.871 + /* Check that we're not extending a pure unicode string */
1.872 +
1.873 + if (length > (int) stringPtr->allocated &&
1.874 + (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
1.875 + char *new;
1.876 +
1.877 + /*
1.878 + * Not enough space in current string. Reallocate the string
1.879 + * space and free the old string.
1.880 + */
1.881 + if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
1.882 + new = (char *) attemptckrealloc((char *)objPtr->bytes,
1.883 + (unsigned)(length+1));
1.884 + if (new == NULL) {
1.885 + return 0;
1.886 + }
1.887 + } else {
1.888 + new = (char *) attemptckalloc((unsigned) (length+1));
1.889 + if (new == NULL) {
1.890 + return 0;
1.891 + }
1.892 + if (objPtr->bytes != NULL && objPtr->length != 0) {
1.893 + memcpy((VOID *) new, (VOID *) objPtr->bytes,
1.894 + (size_t) objPtr->length);
1.895 + Tcl_InvalidateStringRep(objPtr);
1.896 + }
1.897 + }
1.898 + objPtr->bytes = new;
1.899 + stringPtr->allocated = length;
1.900 + /* Invalidate the unicode data. */
1.901 + stringPtr->hasUnicode = 0;
1.902 + }
1.903 +
1.904 + if (objPtr->bytes != NULL) {
1.905 + objPtr->length = length;
1.906 + if (objPtr->bytes != tclEmptyStringRep) {
1.907 + /* Ensure the string is NULL-terminated */
1.908 + objPtr->bytes[length] = 0;
1.909 + }
1.910 + /* Invalidate the unicode data. */
1.911 + stringPtr->numChars = -1;
1.912 + stringPtr->hasUnicode = 0;
1.913 + } else {
1.914 + /* Changing length of pure unicode string */
1.915 + size_t uallocated = STRING_UALLOC(length);
1.916 + if (uallocated > stringPtr->uallocated) {
1.917 + stringPtr = (String *) attemptckrealloc((char*) stringPtr,
1.918 + STRING_SIZE(uallocated));
1.919 + if (stringPtr == NULL) {
1.920 + return 0;
1.921 + }
1.922 + SET_STRING(objPtr, stringPtr);
1.923 + stringPtr->uallocated = uallocated;
1.924 + }
1.925 + stringPtr->numChars = length;
1.926 + stringPtr->hasUnicode = (length > 0);
1.927 + /* Ensure the string is NULL-terminated */
1.928 + stringPtr->unicode[length] = 0;
1.929 + stringPtr->allocated = 0;
1.930 + objPtr->length = 0;
1.931 + }
1.932 + return 1;
1.933 +}
1.934 +
1.935 +/*
1.936 + *---------------------------------------------------------------------------
1.937 + *
1.938 + * TclSetUnicodeObj --
1.939 + *
1.940 + * Modify an object to hold the Unicode string indicated by "unicode".
1.941 + *
1.942 + * Results:
1.943 + * None.
1.944 + *
1.945 + * Side effects:
1.946 + * Memory allocated for new "String" internal rep.
1.947 + *
1.948 + *---------------------------------------------------------------------------
1.949 + */
1.950 +
1.951 +EXPORT_C void
1.952 +Tcl_SetUnicodeObj(objPtr, unicode, numChars)
1.953 + Tcl_Obj *objPtr; /* The object to set the string of. */
1.954 + CONST Tcl_UniChar *unicode; /* The unicode string used to initialize
1.955 + * the object. */
1.956 + int numChars; /* Number of characters in the unicode
1.957 + * string. */
1.958 +{
1.959 + Tcl_ObjType *typePtr;
1.960 + String *stringPtr;
1.961 + size_t uallocated;
1.962 +
1.963 + if (numChars < 0) {
1.964 + numChars = 0;
1.965 + if (unicode) {
1.966 + while (unicode[numChars] != 0) { numChars++; }
1.967 + }
1.968 + }
1.969 + uallocated = STRING_UALLOC(numChars);
1.970 +
1.971 + /*
1.972 + * Free the internal rep if one exists, and invalidate the string rep.
1.973 + */
1.974 +
1.975 + typePtr = objPtr->typePtr;
1.976 + if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
1.977 + (*typePtr->freeIntRepProc)(objPtr);
1.978 + }
1.979 + objPtr->typePtr = &tclStringType;
1.980 +
1.981 + /*
1.982 + * Allocate enough space for the String structure + Unicode string.
1.983 + */
1.984 +
1.985 + stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
1.986 + stringPtr->numChars = numChars;
1.987 + stringPtr->uallocated = uallocated;
1.988 + stringPtr->hasUnicode = (numChars > 0);
1.989 + stringPtr->allocated = 0;
1.990 + memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
1.991 + stringPtr->unicode[numChars] = 0;
1.992 + SET_STRING(objPtr, stringPtr);
1.993 + Tcl_InvalidateStringRep(objPtr);
1.994 + return;
1.995 +}
1.996 +
1.997 +/*
1.998 + *----------------------------------------------------------------------
1.999 + *
1.1000 + * Tcl_AppendToObj --
1.1001 + *
1.1002 + * This procedure appends a sequence of bytes to an object.
1.1003 + *
1.1004 + * Results:
1.1005 + * None.
1.1006 + *
1.1007 + * Side effects:
1.1008 + * The bytes at *bytes are appended to the string representation
1.1009 + * of objPtr.
1.1010 + *
1.1011 + *----------------------------------------------------------------------
1.1012 + */
1.1013 +
1.1014 +EXPORT_C void
1.1015 +Tcl_AppendToObj(objPtr, bytes, length)
1.1016 + register Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1017 + CONST char *bytes; /* Points to the bytes to append to the
1.1018 + * object. */
1.1019 + register int length; /* The number of bytes to append from
1.1020 + * "bytes". If < 0, then append all bytes
1.1021 + * up to NULL byte. */
1.1022 +{
1.1023 + String *stringPtr;
1.1024 +
1.1025 + if (Tcl_IsShared(objPtr)) {
1.1026 + panic("Tcl_AppendToObj called with shared object");
1.1027 + }
1.1028 +
1.1029 + SetStringFromAny(NULL, objPtr);
1.1030 +
1.1031 + if (length < 0) {
1.1032 + length = (bytes ? strlen(bytes) : 0);
1.1033 + }
1.1034 + if (length == 0) {
1.1035 + return;
1.1036 + }
1.1037 +
1.1038 + /*
1.1039 + * If objPtr has a valid Unicode rep, then append the Unicode
1.1040 + * conversion of "bytes" to the objPtr's Unicode rep, otherwise
1.1041 + * append "bytes" to objPtr's string rep.
1.1042 + */
1.1043 +
1.1044 + stringPtr = GET_STRING(objPtr);
1.1045 + if (stringPtr->hasUnicode != 0) {
1.1046 + AppendUtfToUnicodeRep(objPtr, bytes, length);
1.1047 +
1.1048 + stringPtr = GET_STRING(objPtr);
1.1049 + } else {
1.1050 + AppendUtfToUtfRep(objPtr, bytes, length);
1.1051 + }
1.1052 +}
1.1053 +
1.1054 +/*
1.1055 + *----------------------------------------------------------------------
1.1056 + *
1.1057 + * Tcl_AppendUnicodeToObj --
1.1058 + *
1.1059 + * This procedure appends a Unicode string to an object in the
1.1060 + * most efficient manner possible. Length must be >= 0.
1.1061 + *
1.1062 + * Results:
1.1063 + * None.
1.1064 + *
1.1065 + * Side effects:
1.1066 + * Invalidates the string rep and creates a new Unicode string.
1.1067 + *
1.1068 + *----------------------------------------------------------------------
1.1069 + */
1.1070 +
1.1071 +EXPORT_C void
1.1072 +Tcl_AppendUnicodeToObj(objPtr, unicode, length)
1.1073 + register Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1074 + CONST Tcl_UniChar *unicode; /* The unicode string to append to the
1.1075 + * object. */
1.1076 + int length; /* Number of chars in "unicode". */
1.1077 +{
1.1078 + String *stringPtr;
1.1079 +
1.1080 + if (Tcl_IsShared(objPtr)) {
1.1081 + panic("Tcl_AppendUnicodeToObj called with shared object");
1.1082 + }
1.1083 +
1.1084 + if (length == 0) {
1.1085 + return;
1.1086 + }
1.1087 +
1.1088 + SetStringFromAny(NULL, objPtr);
1.1089 + stringPtr = GET_STRING(objPtr);
1.1090 +
1.1091 + /*
1.1092 + * If objPtr has a valid Unicode rep, then append the "unicode"
1.1093 + * to the objPtr's Unicode rep, otherwise the UTF conversion of
1.1094 + * "unicode" to objPtr's string rep.
1.1095 + */
1.1096 +
1.1097 + if (stringPtr->hasUnicode != 0) {
1.1098 + AppendUnicodeToUnicodeRep(objPtr, unicode, length);
1.1099 + } else {
1.1100 + AppendUnicodeToUtfRep(objPtr, unicode, length);
1.1101 + }
1.1102 +}
1.1103 +
1.1104 +/*
1.1105 + *----------------------------------------------------------------------
1.1106 + *
1.1107 + * Tcl_AppendObjToObj --
1.1108 + *
1.1109 + * This procedure appends the string rep of one object to another.
1.1110 + * "objPtr" cannot be a shared object.
1.1111 + *
1.1112 + * Results:
1.1113 + * None.
1.1114 + *
1.1115 + * Side effects:
1.1116 + * The string rep of appendObjPtr is appended to the string
1.1117 + * representation of objPtr.
1.1118 + *
1.1119 + *----------------------------------------------------------------------
1.1120 + */
1.1121 +
1.1122 +EXPORT_C void
1.1123 +Tcl_AppendObjToObj(objPtr, appendObjPtr)
1.1124 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1125 + Tcl_Obj *appendObjPtr; /* Object to append. */
1.1126 +{
1.1127 + String *stringPtr;
1.1128 + int length, numChars, allOneByteChars;
1.1129 + char *bytes;
1.1130 +
1.1131 + SetStringFromAny(NULL, objPtr);
1.1132 +
1.1133 + /*
1.1134 + * If objPtr has a valid Unicode rep, then get a Unicode string
1.1135 + * from appendObjPtr and append it.
1.1136 + */
1.1137 +
1.1138 + stringPtr = GET_STRING(objPtr);
1.1139 + if (stringPtr->hasUnicode != 0) {
1.1140 +
1.1141 + /*
1.1142 + * If appendObjPtr is not of the "String" type, don't convert it.
1.1143 + */
1.1144 +
1.1145 + if (appendObjPtr->typePtr == &tclStringType) {
1.1146 + stringPtr = GET_STRING(appendObjPtr);
1.1147 + if ((stringPtr->numChars == -1)
1.1148 + || (stringPtr->hasUnicode == 0)) {
1.1149 +
1.1150 + /*
1.1151 + * If appendObjPtr is a string obj with no valid Unicode
1.1152 + * rep, then fill its unicode rep.
1.1153 + */
1.1154 +
1.1155 + FillUnicodeRep(appendObjPtr);
1.1156 + stringPtr = GET_STRING(appendObjPtr);
1.1157 + }
1.1158 + AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
1.1159 + stringPtr->numChars);
1.1160 + } else {
1.1161 + bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
1.1162 + AppendUtfToUnicodeRep(objPtr, bytes, length);
1.1163 + }
1.1164 + return;
1.1165 + }
1.1166 +
1.1167 + /*
1.1168 + * Append to objPtr's UTF string rep. If we know the number of
1.1169 + * characters in both objects before appending, then set the combined
1.1170 + * number of characters in the final (appended-to) object.
1.1171 + */
1.1172 +
1.1173 + bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
1.1174 +
1.1175 + allOneByteChars = 0;
1.1176 + numChars = stringPtr->numChars;
1.1177 + if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
1.1178 + stringPtr = GET_STRING(appendObjPtr);
1.1179 + if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
1.1180 + numChars += stringPtr->numChars;
1.1181 + allOneByteChars = 1;
1.1182 + }
1.1183 + }
1.1184 +
1.1185 + AppendUtfToUtfRep(objPtr, bytes, length);
1.1186 +
1.1187 + if (allOneByteChars) {
1.1188 + stringPtr = GET_STRING(objPtr);
1.1189 + stringPtr->numChars = numChars;
1.1190 + }
1.1191 +}
1.1192 +
1.1193 +/*
1.1194 + *----------------------------------------------------------------------
1.1195 + *
1.1196 + * AppendUnicodeToUnicodeRep --
1.1197 + *
1.1198 + * This procedure appends the contents of "unicode" to the Unicode
1.1199 + * rep of "objPtr". objPtr must already have a valid Unicode rep.
1.1200 + *
1.1201 + * Results:
1.1202 + * None.
1.1203 + *
1.1204 + * Side effects:
1.1205 + * objPtr's internal rep is reallocated.
1.1206 + *
1.1207 + *----------------------------------------------------------------------
1.1208 + */
1.1209 +
1.1210 +static void
1.1211 +AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
1.1212 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1213 + CONST Tcl_UniChar *unicode; /* String to append. */
1.1214 + int appendNumChars; /* Number of chars of "unicode" to append. */
1.1215 +{
1.1216 + String *stringPtr, *tmpString;
1.1217 + size_t numChars;
1.1218 +
1.1219 + if (appendNumChars < 0) {
1.1220 + appendNumChars = 0;
1.1221 + if (unicode) {
1.1222 + while (unicode[appendNumChars] != 0) { appendNumChars++; }
1.1223 + }
1.1224 + }
1.1225 + if (appendNumChars == 0) {
1.1226 + return;
1.1227 + }
1.1228 +
1.1229 + SetStringFromAny(NULL, objPtr);
1.1230 + stringPtr = GET_STRING(objPtr);
1.1231 +
1.1232 + /*
1.1233 + * If not enough space has been allocated for the unicode rep,
1.1234 + * reallocate the internal rep object with additional space. First
1.1235 + * try to double the required allocation; if that fails, try a more
1.1236 + * modest increase. See the "TCL STRING GROWTH ALGORITHM" comment at
1.1237 + * the top of this file for an explanation of this growth algorithm.
1.1238 + */
1.1239 +
1.1240 + numChars = stringPtr->numChars + appendNumChars;
1.1241 +
1.1242 + if (STRING_UALLOC(numChars) >= stringPtr->uallocated) {
1.1243 + stringPtr->uallocated = STRING_UALLOC(2 * numChars);
1.1244 + tmpString = (String *) attemptckrealloc((char *)stringPtr,
1.1245 + STRING_SIZE(stringPtr->uallocated));
1.1246 + if (tmpString == NULL) {
1.1247 + stringPtr->uallocated =
1.1248 + STRING_UALLOC(numChars + appendNumChars)
1.1249 + + TCL_GROWTH_MIN_ALLOC;
1.1250 + tmpString = (String *) ckrealloc((char *)stringPtr,
1.1251 + STRING_SIZE(stringPtr->uallocated));
1.1252 + }
1.1253 + stringPtr = tmpString;
1.1254 + SET_STRING(objPtr, stringPtr);
1.1255 + }
1.1256 +
1.1257 + /*
1.1258 + * Copy the new string onto the end of the old string, then add the
1.1259 + * trailing null.
1.1260 + */
1.1261 +
1.1262 + memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
1.1263 + appendNumChars * sizeof(Tcl_UniChar));
1.1264 + stringPtr->unicode[numChars] = 0;
1.1265 + stringPtr->numChars = numChars;
1.1266 +
1.1267 + Tcl_InvalidateStringRep(objPtr);
1.1268 +}
1.1269 +
1.1270 +/*
1.1271 + *----------------------------------------------------------------------
1.1272 + *
1.1273 + * AppendUnicodeToUtfRep --
1.1274 + *
1.1275 + * This procedure converts the contents of "unicode" to UTF and
1.1276 + * appends the UTF to the string rep of "objPtr".
1.1277 + *
1.1278 + * Results:
1.1279 + * None.
1.1280 + *
1.1281 + * Side effects:
1.1282 + * objPtr's internal rep is reallocated.
1.1283 + *
1.1284 + *----------------------------------------------------------------------
1.1285 + */
1.1286 +
1.1287 +static void
1.1288 +AppendUnicodeToUtfRep(objPtr, unicode, numChars)
1.1289 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1290 + CONST Tcl_UniChar *unicode; /* String to convert to UTF. */
1.1291 + int numChars; /* Number of chars of "unicode" to convert. */
1.1292 +{
1.1293 + Tcl_DString dsPtr;
1.1294 + CONST char *bytes;
1.1295 +
1.1296 + if (numChars < 0) {
1.1297 + numChars = 0;
1.1298 + if (unicode) {
1.1299 + while (unicode[numChars] != 0) { numChars++; }
1.1300 + }
1.1301 + }
1.1302 + if (numChars == 0) {
1.1303 + return;
1.1304 + }
1.1305 +
1.1306 + Tcl_DStringInit(&dsPtr);
1.1307 + bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
1.1308 + AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
1.1309 + Tcl_DStringFree(&dsPtr);
1.1310 +}
1.1311 +
1.1312 +/*
1.1313 + *----------------------------------------------------------------------
1.1314 + *
1.1315 + * AppendUtfToUnicodeRep --
1.1316 + *
1.1317 + * This procedure converts the contents of "bytes" to Unicode and
1.1318 + * appends the Unicode to the Unicode rep of "objPtr". objPtr must
1.1319 + * already have a valid Unicode rep.
1.1320 + *
1.1321 + * Results:
1.1322 + * None.
1.1323 + *
1.1324 + * Side effects:
1.1325 + * objPtr's internal rep is reallocated.
1.1326 + *
1.1327 + *----------------------------------------------------------------------
1.1328 + */
1.1329 +
1.1330 +static void
1.1331 +AppendUtfToUnicodeRep(objPtr, bytes, numBytes)
1.1332 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1333 + CONST char *bytes; /* String to convert to Unicode. */
1.1334 + int numBytes; /* Number of bytes of "bytes" to convert. */
1.1335 +{
1.1336 + Tcl_DString dsPtr;
1.1337 + int numChars;
1.1338 + Tcl_UniChar *unicode;
1.1339 +
1.1340 + if (numBytes < 0) {
1.1341 + numBytes = (bytes ? strlen(bytes) : 0);
1.1342 + }
1.1343 + if (numBytes == 0) {
1.1344 + return;
1.1345 + }
1.1346 +
1.1347 + Tcl_DStringInit(&dsPtr);
1.1348 + numChars = Tcl_NumUtfChars(bytes, numBytes);
1.1349 + unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
1.1350 + AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
1.1351 + Tcl_DStringFree(&dsPtr);
1.1352 +}
1.1353 +
1.1354 +/*
1.1355 + *----------------------------------------------------------------------
1.1356 + *
1.1357 + * AppendUtfToUtfRep --
1.1358 + *
1.1359 + * This procedure appends "numBytes" bytes of "bytes" to the UTF string
1.1360 + * rep of "objPtr". objPtr must already have a valid String rep.
1.1361 + *
1.1362 + * Results:
1.1363 + * None.
1.1364 + *
1.1365 + * Side effects:
1.1366 + * objPtr's internal rep is reallocated.
1.1367 + *
1.1368 + *----------------------------------------------------------------------
1.1369 + */
1.1370 +
1.1371 +static void
1.1372 +AppendUtfToUtfRep(objPtr, bytes, numBytes)
1.1373 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1374 + CONST char *bytes; /* String to append. */
1.1375 + int numBytes; /* Number of bytes of "bytes" to append. */
1.1376 +{
1.1377 + String *stringPtr;
1.1378 + int newLength, oldLength;
1.1379 +
1.1380 + if (numBytes < 0) {
1.1381 + numBytes = (bytes ? strlen(bytes) : 0);
1.1382 + }
1.1383 + if (numBytes == 0) {
1.1384 + return;
1.1385 + }
1.1386 +
1.1387 + /*
1.1388 + * Copy the new string onto the end of the old string, then add the
1.1389 + * trailing null.
1.1390 + */
1.1391 +
1.1392 + oldLength = objPtr->length;
1.1393 + newLength = numBytes + oldLength;
1.1394 +
1.1395 + stringPtr = GET_STRING(objPtr);
1.1396 + if (newLength > (int) stringPtr->allocated) {
1.1397 +
1.1398 + /*
1.1399 + * There isn't currently enough space in the string representation
1.1400 + * so allocate additional space. First, try to double the length
1.1401 + * required. If that fails, try a more modest allocation. See the
1.1402 + * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
1.1403 + * explanation of this growth algorithm.
1.1404 + */
1.1405 +
1.1406 + if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
1.1407 + Tcl_SetObjLength(objPtr,
1.1408 + newLength + numBytes + TCL_GROWTH_MIN_ALLOC);
1.1409 + }
1.1410 + }
1.1411 +
1.1412 + /*
1.1413 + * Invalidate the unicode data.
1.1414 + */
1.1415 +
1.1416 + stringPtr->numChars = -1;
1.1417 + stringPtr->hasUnicode = 0;
1.1418 +
1.1419 + memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
1.1420 + (size_t) numBytes);
1.1421 + objPtr->bytes[newLength] = 0;
1.1422 + objPtr->length = newLength;
1.1423 +}
1.1424 +
1.1425 +/*
1.1426 + *----------------------------------------------------------------------
1.1427 + *
1.1428 + * Tcl_AppendStringsToObjVA --
1.1429 + *
1.1430 + * This procedure appends one or more null-terminated strings
1.1431 + * to an object.
1.1432 + *
1.1433 + * Results:
1.1434 + * None.
1.1435 + *
1.1436 + * Side effects:
1.1437 + * The contents of all the string arguments are appended to the
1.1438 + * string representation of objPtr.
1.1439 + *
1.1440 + *----------------------------------------------------------------------
1.1441 + */
1.1442 +
1.1443 +EXPORT_C void
1.1444 +Tcl_AppendStringsToObjVA (objPtr, argList)
1.1445 + Tcl_Obj *objPtr; /* Points to the object to append to. */
1.1446 + va_list argList; /* Variable argument list. */
1.1447 +{
1.1448 +#define STATIC_LIST_SIZE 16
1.1449 + String *stringPtr;
1.1450 + int newLength, oldLength, attemptLength;
1.1451 + register char *string, *dst;
1.1452 + char *static_list[STATIC_LIST_SIZE];
1.1453 + char **args = static_list;
1.1454 + int nargs_space = STATIC_LIST_SIZE;
1.1455 + int nargs, i;
1.1456 +
1.1457 + if (Tcl_IsShared(objPtr)) {
1.1458 + panic("Tcl_AppendStringsToObj called with shared object");
1.1459 + }
1.1460 +
1.1461 + SetStringFromAny(NULL, objPtr);
1.1462 +
1.1463 + /*
1.1464 + * Figure out how much space is needed for all the strings, and
1.1465 + * expand the string representation if it isn't big enough. If no
1.1466 + * bytes would be appended, just return. Note that on some platforms
1.1467 + * (notably OS/390) the argList is an array so we need to use memcpy.
1.1468 + */
1.1469 +
1.1470 + nargs = 0;
1.1471 + newLength = 0;
1.1472 + oldLength = objPtr->length;
1.1473 + while (1) {
1.1474 + string = va_arg(argList, char *);
1.1475 + if (string == NULL) {
1.1476 + break;
1.1477 + }
1.1478 + if (nargs >= nargs_space) {
1.1479 + /*
1.1480 + * Expand the args buffer
1.1481 + */
1.1482 + nargs_space += STATIC_LIST_SIZE;
1.1483 + if (args == static_list) {
1.1484 + args = (void *)ckalloc(nargs_space * sizeof(char *));
1.1485 + for (i = 0; i < nargs; ++i) {
1.1486 + args[i] = static_list[i];
1.1487 + }
1.1488 + } else {
1.1489 + args = (void *)ckrealloc((void *)args,
1.1490 + nargs_space * sizeof(char *));
1.1491 + }
1.1492 + }
1.1493 + newLength += strlen(string);
1.1494 + args[nargs++] = string;
1.1495 + }
1.1496 + if (newLength == 0) {
1.1497 + goto done;
1.1498 + }
1.1499 +
1.1500 + stringPtr = GET_STRING(objPtr);
1.1501 + if (oldLength + newLength > (int) stringPtr->allocated) {
1.1502 +
1.1503 + /*
1.1504 + * There isn't currently enough space in the string
1.1505 + * representation, so allocate additional space. If the current
1.1506 + * string representation isn't empty (i.e. it looks like we're
1.1507 + * doing a series of appends) then try to allocate extra space to
1.1508 + * accomodate future growth: first try to double the required memory;
1.1509 + * if that fails, try a more modest allocation. See the "TCL STRING
1.1510 + * GROWTH ALGORITHM" comment at the top of this file for an explanation
1.1511 + * of this growth algorithm. Otherwise, if the current string
1.1512 + * representation is empty, exactly enough memory is allocated.
1.1513 + */
1.1514 +
1.1515 + if (oldLength == 0) {
1.1516 + Tcl_SetObjLength(objPtr, newLength);
1.1517 + } else {
1.1518 + attemptLength = 2 * (oldLength + newLength);
1.1519 + if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
1.1520 + attemptLength = oldLength + (2 * newLength) +
1.1521 + TCL_GROWTH_MIN_ALLOC;
1.1522 + Tcl_SetObjLength(objPtr, attemptLength);
1.1523 + }
1.1524 + }
1.1525 + }
1.1526 +
1.1527 + /*
1.1528 + * Make a second pass through the arguments, appending all the
1.1529 + * strings to the object.
1.1530 + */
1.1531 +
1.1532 + dst = objPtr->bytes + oldLength;
1.1533 + for (i = 0; i < nargs; ++i) {
1.1534 + string = args[i];
1.1535 + if (string == NULL) {
1.1536 + break;
1.1537 + }
1.1538 + while (*string != 0) {
1.1539 + *dst = *string;
1.1540 + dst++;
1.1541 + string++;
1.1542 + }
1.1543 + }
1.1544 +
1.1545 + /*
1.1546 + * Add a null byte to terminate the string. However, be careful:
1.1547 + * it's possible that the object is totally empty (if it was empty
1.1548 + * originally and there was nothing to append). In this case dst is
1.1549 + * NULL; just leave everything alone.
1.1550 + */
1.1551 +
1.1552 + if (dst != NULL) {
1.1553 + *dst = 0;
1.1554 + }
1.1555 + objPtr->length = oldLength + newLength;
1.1556 +
1.1557 + done:
1.1558 + /*
1.1559 + * If we had to allocate a buffer from the heap,
1.1560 + * free it now.
1.1561 + */
1.1562 +
1.1563 + if (args != static_list) {
1.1564 + ckfree((void *)args);
1.1565 + }
1.1566 +#undef STATIC_LIST_SIZE
1.1567 +}
1.1568 +
1.1569 +/*
1.1570 + *----------------------------------------------------------------------
1.1571 + *
1.1572 + * Tcl_AppendStringsToObj --
1.1573 + *
1.1574 + * This procedure appends one or more null-terminated strings
1.1575 + * to an object.
1.1576 + *
1.1577 + * Results:
1.1578 + * None.
1.1579 + *
1.1580 + * Side effects:
1.1581 + * The contents of all the string arguments are appended to the
1.1582 + * string representation of objPtr.
1.1583 + *
1.1584 + *----------------------------------------------------------------------
1.1585 + */
1.1586 +
1.1587 +EXPORT_C void
1.1588 +Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
1.1589 +{
1.1590 + register Tcl_Obj *objPtr;
1.1591 + va_list argList;
1.1592 +
1.1593 + objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
1.1594 + Tcl_AppendStringsToObjVA(objPtr, argList);
1.1595 + va_end(argList);
1.1596 +}
1.1597 +
1.1598 +/*
1.1599 + *---------------------------------------------------------------------------
1.1600 + *
1.1601 + * FillUnicodeRep --
1.1602 + *
1.1603 + * Populate the Unicode internal rep with the Unicode form of its string
1.1604 + * rep. The object must alread have a "String" internal rep.
1.1605 + *
1.1606 + * Results:
1.1607 + * None.
1.1608 + *
1.1609 + * Side effects:
1.1610 + * Reallocates the String internal rep.
1.1611 + *
1.1612 + *---------------------------------------------------------------------------
1.1613 + */
1.1614 +
1.1615 +static void
1.1616 +FillUnicodeRep(objPtr)
1.1617 + Tcl_Obj *objPtr; /* The object in which to fill the unicode rep. */
1.1618 +{
1.1619 + String *stringPtr;
1.1620 + size_t uallocated;
1.1621 + char *src, *srcEnd;
1.1622 + Tcl_UniChar *dst;
1.1623 + src = objPtr->bytes;
1.1624 +
1.1625 + stringPtr = GET_STRING(objPtr);
1.1626 + if (stringPtr->numChars == -1) {
1.1627 + stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
1.1628 + }
1.1629 + stringPtr->hasUnicode = (stringPtr->numChars > 0);
1.1630 +
1.1631 + uallocated = STRING_UALLOC(stringPtr->numChars);
1.1632 + if (uallocated > stringPtr->uallocated) {
1.1633 +
1.1634 + /*
1.1635 + * If not enough space has been allocated for the unicode rep,
1.1636 + * reallocate the internal rep object.
1.1637 + */
1.1638 +
1.1639 + /*
1.1640 + * There isn't currently enough space in the Unicode
1.1641 + * representation so allocate additional space. If the current
1.1642 + * Unicode representation isn't empty (i.e. it looks like we've
1.1643 + * done some appends) then overallocate the space so
1.1644 + * that we won't have to do as much reallocation in the future.
1.1645 + */
1.1646 +
1.1647 + if (stringPtr->uallocated > 0) {
1.1648 + uallocated *= 2;
1.1649 + }
1.1650 + stringPtr = (String *) ckrealloc((char*) stringPtr,
1.1651 + STRING_SIZE(uallocated));
1.1652 + stringPtr->uallocated = uallocated;
1.1653 + }
1.1654 +
1.1655 + /*
1.1656 + * Convert src to Unicode and store the coverted data in "unicode".
1.1657 + */
1.1658 +
1.1659 + srcEnd = src + objPtr->length;
1.1660 + for (dst = stringPtr->unicode; src < srcEnd; dst++) {
1.1661 + src += TclUtfToUniChar(src, dst);
1.1662 + }
1.1663 + *dst = 0;
1.1664 +
1.1665 + SET_STRING(objPtr, stringPtr);
1.1666 +}
1.1667 +
1.1668 +/*
1.1669 + *----------------------------------------------------------------------
1.1670 + *
1.1671 + * DupStringInternalRep --
1.1672 + *
1.1673 + * Initialize the internal representation of a new Tcl_Obj to a
1.1674 + * copy of the internal representation of an existing string object.
1.1675 + *
1.1676 + * Results:
1.1677 + * None.
1.1678 + *
1.1679 + * Side effects:
1.1680 + * copyPtr's internal rep is set to a copy of srcPtr's internal
1.1681 + * representation.
1.1682 + *
1.1683 + *----------------------------------------------------------------------
1.1684 + */
1.1685 +
1.1686 +static void
1.1687 +DupStringInternalRep(srcPtr, copyPtr)
1.1688 + register Tcl_Obj *srcPtr; /* Object with internal rep to copy. Must
1.1689 + * have an internal rep of type "String". */
1.1690 + register Tcl_Obj *copyPtr; /* Object with internal rep to set. Must
1.1691 + * not currently have an internal rep.*/
1.1692 +{
1.1693 + String *srcStringPtr = GET_STRING(srcPtr);
1.1694 + String *copyStringPtr = NULL;
1.1695 +
1.1696 + /*
1.1697 + * If the src obj is a string of 1-byte Utf chars, then copy the
1.1698 + * string rep of the source object and create an "empty" Unicode
1.1699 + * internal rep for the new object. Otherwise, copy Unicode
1.1700 + * internal rep, and invalidate the string rep of the new object.
1.1701 + */
1.1702 +
1.1703 + if (srcStringPtr->hasUnicode == 0) {
1.1704 + copyStringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
1.1705 + copyStringPtr->uallocated = STRING_UALLOC(0);
1.1706 + } else {
1.1707 + copyStringPtr = (String *) ckalloc(
1.1708 + STRING_SIZE(srcStringPtr->uallocated));
1.1709 + copyStringPtr->uallocated = srcStringPtr->uallocated;
1.1710 +
1.1711 + memcpy((VOID *) copyStringPtr->unicode,
1.1712 + (VOID *) srcStringPtr->unicode,
1.1713 + (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
1.1714 + copyStringPtr->unicode[srcStringPtr->numChars] = 0;
1.1715 + }
1.1716 + copyStringPtr->numChars = srcStringPtr->numChars;
1.1717 + copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
1.1718 + copyStringPtr->allocated = srcStringPtr->allocated;
1.1719 +
1.1720 + /*
1.1721 + * Tricky point: the string value was copied by generic object
1.1722 + * management code, so it doesn't contain any extra bytes that
1.1723 + * might exist in the source object.
1.1724 + */
1.1725 +
1.1726 + copyStringPtr->allocated = copyPtr->length;
1.1727 +
1.1728 + SET_STRING(copyPtr, copyStringPtr);
1.1729 + copyPtr->typePtr = &tclStringType;
1.1730 +}
1.1731 +
1.1732 +/*
1.1733 + *----------------------------------------------------------------------
1.1734 + *
1.1735 + * SetStringFromAny --
1.1736 + *
1.1737 + * Create an internal representation of type "String" for an object.
1.1738 + *
1.1739 + * Results:
1.1740 + * This operation always succeeds and returns TCL_OK.
1.1741 + *
1.1742 + * Side effects:
1.1743 + * Any old internal reputation for objPtr is freed and the
1.1744 + * internal representation is set to "String".
1.1745 + *
1.1746 + *----------------------------------------------------------------------
1.1747 + */
1.1748 +
1.1749 +static int
1.1750 +SetStringFromAny(interp, objPtr)
1.1751 + Tcl_Interp *interp; /* Used for error reporting if not NULL. */
1.1752 + register Tcl_Obj *objPtr; /* The object to convert. */
1.1753 +{
1.1754 + /*
1.1755 + * The Unicode object is optimized for the case where each UTF char
1.1756 + * in a string is only one byte. In this case, we store the value of
1.1757 + * numChars, but we don't copy the bytes to the unicodeObj->unicode.
1.1758 + */
1.1759 +
1.1760 + if (objPtr->typePtr != &tclStringType) {
1.1761 + String *stringPtr;
1.1762 +
1.1763 + if (objPtr->typePtr != NULL) {
1.1764 + if (objPtr->bytes == NULL) {
1.1765 + objPtr->typePtr->updateStringProc(objPtr);
1.1766 + }
1.1767 + if ((objPtr->typePtr->freeIntRepProc) != NULL) {
1.1768 + (*objPtr->typePtr->freeIntRepProc)(objPtr);
1.1769 + }
1.1770 + }
1.1771 + objPtr->typePtr = &tclStringType;
1.1772 +
1.1773 + /*
1.1774 + * Allocate enough space for the basic String structure.
1.1775 + */
1.1776 +
1.1777 + stringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
1.1778 + stringPtr->numChars = -1;
1.1779 + stringPtr->uallocated = STRING_UALLOC(0);
1.1780 + stringPtr->hasUnicode = 0;
1.1781 +
1.1782 + if (objPtr->bytes != NULL) {
1.1783 + stringPtr->allocated = objPtr->length;
1.1784 + objPtr->bytes[objPtr->length] = 0;
1.1785 + } else {
1.1786 + objPtr->length = 0;
1.1787 + }
1.1788 + SET_STRING(objPtr, stringPtr);
1.1789 + }
1.1790 + return TCL_OK;
1.1791 +}
1.1792 +
1.1793 +/*
1.1794 + *----------------------------------------------------------------------
1.1795 + *
1.1796 + * UpdateStringOfString --
1.1797 + *
1.1798 + * Update the string representation for an object whose internal
1.1799 + * representation is "String".
1.1800 + *
1.1801 + * Results:
1.1802 + * None.
1.1803 + *
1.1804 + * Side effects:
1.1805 + * The object's string may be set by converting its Unicode
1.1806 + * represention to UTF format.
1.1807 + *
1.1808 + *----------------------------------------------------------------------
1.1809 + */
1.1810 +
1.1811 +static void
1.1812 +UpdateStringOfString(objPtr)
1.1813 + Tcl_Obj *objPtr; /* Object with string rep to update. */
1.1814 +{
1.1815 + int i, size;
1.1816 + Tcl_UniChar *unicode;
1.1817 + char dummy[TCL_UTF_MAX];
1.1818 + char *dst;
1.1819 + String *stringPtr;
1.1820 +
1.1821 + stringPtr = GET_STRING(objPtr);
1.1822 + if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
1.1823 +
1.1824 + if (stringPtr->numChars <= 0) {
1.1825 +
1.1826 + /*
1.1827 + * If there is no Unicode rep, or the string has 0 chars,
1.1828 + * then set the string rep to an empty string.
1.1829 + */
1.1830 +
1.1831 + objPtr->bytes = tclEmptyStringRep;
1.1832 + objPtr->length = 0;
1.1833 + return;
1.1834 + }
1.1835 +
1.1836 + unicode = stringPtr->unicode;
1.1837 +
1.1838 + /*
1.1839 + * Translate the Unicode string to UTF. "size" will hold the
1.1840 + * amount of space the UTF string needs.
1.1841 + */
1.1842 +
1.1843 + size = 0;
1.1844 + for (i = 0; i < stringPtr->numChars; i++) {
1.1845 + size += Tcl_UniCharToUtf((int) unicode[i], dummy);
1.1846 + }
1.1847 +
1.1848 + dst = (char *) ckalloc((unsigned) (size + 1));
1.1849 + objPtr->bytes = dst;
1.1850 + objPtr->length = size;
1.1851 + stringPtr->allocated = size;
1.1852 +
1.1853 + for (i = 0; i < stringPtr->numChars; i++) {
1.1854 + dst += Tcl_UniCharToUtf(unicode[i], dst);
1.1855 + }
1.1856 + *dst = '\0';
1.1857 + }
1.1858 + return;
1.1859 +}
1.1860 +
1.1861 +/*
1.1862 + *----------------------------------------------------------------------
1.1863 + *
1.1864 + * FreeStringInternalRep --
1.1865 + *
1.1866 + * Deallocate the storage associated with a String data object's
1.1867 + * internal representation.
1.1868 + *
1.1869 + * Results:
1.1870 + * None.
1.1871 + *
1.1872 + * Side effects:
1.1873 + * Frees memory.
1.1874 + *
1.1875 + *----------------------------------------------------------------------
1.1876 + */
1.1877 +
1.1878 +static void
1.1879 +FreeStringInternalRep(objPtr)
1.1880 + Tcl_Obj *objPtr; /* Object with internal rep to free. */
1.1881 +{
1.1882 + ckfree((char *) GET_STRING(objPtr));
1.1883 +}