/*
* tclStringObj.c --
*
* This file contains functions that implement string operations on Tcl
* objects. Some string operations work with UTF strings and others
* require Unicode format. Functions that require knowledge of the width
* of each character, such as indexing, operate on Unicode data.
*
* A Unicode string is an internationalized string. Conceptually, a
* Unicode string is an array of 16-bit quantities organized as a
* sequence of properly formed UTF-8 characters. There is a one-to-one
* map between Unicode and UTF characters. Because Unicode characters
* have a fixed width, operations such as indexing operate on Unicode
* data. The String object is optimized for the case where each UTF char
* in a string is only one byte. In this case, we store the value of
* numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
* is explicitly called).
*
* The String object type stores one or both formats. The default
* behavior is to store UTF. Once Unicode is calculated by a function, it
* is stored in the internal rep for future access (without an additional
* O(n) cost).
*
* To allow many appends to be done to an object without constantly
* reallocating the space for the string or Unicode representation, we
* allocate double the space for the string or Unicode and use the
* internal representation to keep track of how much space is used vs.
* allocated.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclStringObj.c,v 1.70.2.21 2010/04/02 14:30:41 vasiljevic Exp $ */
#include "tclInt.h"
#include "tommath.h"
/*
* Prototypes for functions defined later in this file:
*/
static void AppendPrintfToObjVA(Tcl_Obj *objPtr,
const char *format, va_list argList);
static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int appendNumChars);
static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
const char *bytes, int numBytes);
static void AppendUtfToUtfRep(Tcl_Obj *objPtr,
const char *bytes, int numBytes);
static void DupStringInternalRep(Tcl_Obj *objPtr,
Tcl_Obj *copyPtr);
static void FillUnicodeRep(Tcl_Obj *objPtr);
static void FreeStringInternalRep(Tcl_Obj *objPtr);
static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void SetUnicodeObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, int numChars);
static int UnicodeLength(const Tcl_UniChar *unicode);
static void UpdateStringOfString(Tcl_Obj *objPtr);
/*
* The structure below defines the string Tcl object type by means of
* functions that can be invoked by generic object code.
*/
Tcl_ObjType tclStringType = {
"string", /* name */
FreeStringInternalRep, /* freeIntRepPro */
DupStringInternalRep, /* dupIntRepProc */
UpdateStringOfString, /* updateStringProc */
SetStringFromAny /* setFromAnyProc */
};
/*
* The following structure is the internal rep for a String object. It keeps
* track of how much memory has been used and how much has been allocated for
* the Unicode and UTF string to enable growing and shrinking of the UTF and
* Unicode reps of the String object with fewer mallocs. To optimize string
* length and indexing operations, this structure also stores the number of
* characters (same of UTF and Unicode!) once that value has been computed.
*
* Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
* restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
* can be officially modified by altering the definition of Tcl_UniChar in
* tcl.h, but do not do that unless you are sure what you're doing!
*/
typedef struct String {
int numChars; /* The number of chars in the string. -1 means
* this value has not been calculated. >= 0
* means that there is a valid Unicode rep, or
* that the number of UTF bytes == the number
* of chars. */
size_t allocated; /* The amount of space actually allocated for
* the UTF string (minus 1 byte for the
* termination char). */
size_t uallocated; /* The amount of space actually allocated for
* the Unicode string (minus 2 bytes for the
* termination char). */
int hasUnicode; /* Boolean determining whether the string has
* a Unicode representation. */
Tcl_UniChar unicode[2]; /* The array of Unicode chars. The actual size
* of this field depends on the 'uallocated'
* field above. */
} String;
#define STRING_MAXCHARS \
(1 + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)))
#define STRING_UALLOC(numChars) \
((numChars) * sizeof(Tcl_UniChar))
#define STRING_SIZE(ualloc) \
((unsigned) ((ualloc) \
? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \
: sizeof(String)))
#define stringCheckLimits(numChars) \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
STRING_MAXCHARS); \
}
#define stringRealloc(ptr, numChars) \
(String *) ckrealloc((char *) ptr, \
(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
#define stringAttemptRealloc(ptr, numChars) \
(String *) attemptckrealloc((char *) ptr, \
(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
/*
* TCL STRING GROWTH ALGORITHM
*
* When growing strings (during an append, for example), the following growth
* algorithm is used:
*
* Attempt to allocate 2 * (originalLength + appendLength)
* On failure:
* attempt to allocate originalLength + 2*appendLength +
* TCL_GROWTH_MIN_ALLOC
*
* This algorithm allows very good performance, as it rapidly increases the
* memory allocated for a given string, which minimizes the number of
* reallocations that must be performed. However, using only the doubling
* algorithm can lead to a significant waste of memory. In particular, it may
* fail even when there is sufficient memory available to complete the append
* request (but there is not 2*totalLength memory available). So when the
* doubling fails (because there is not enough memory available), the
* algorithm requests a smaller amount of memory, which is still enough to
* cover the request, but which hopefully will be less than the total
* available memory.
*
* The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very
* small appends. Without this extra slush factor, a sequence of several small
* appends would cause several memory allocations. As long as
* TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
*
* The growth algorithm can be tuned by adjusting the following parameters:
*
* TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when
* the double allocation has failed. Default is
* 1024 (1 kilobyte).
*/
#ifndef TCL_GROWTH_MIN_ALLOC
#define TCL_GROWTH_MIN_ALLOC 1024
#endif
static void
GrowUnicodeBuffer(
Tcl_Obj *objPtr,
int needed)
{
/* Pre-conditions:
* objPtr->typePtr == &tclStringType
* STRING_UALLOC(needed) > stringPtr->uallocated
* needed < STRING_MAXCHARS
*/
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
int attempt;
if (stringPtr->uallocated > 0) {
/* Subsequent appends - apply the growth algorithm. */
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
+ TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
/* First allocation - just big enough; or last chance fallback. */
attempt = needed;
ptr = stringRealloc(stringPtr, attempt);
}
stringPtr = ptr;
stringPtr->uallocated = STRING_UALLOC(attempt);
SET_STRING(objPtr, stringPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewStringObj --
*
* This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new string object and
* initializes it from the byte pointer and length arguments.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewStringObj.
*
* Results:
* A newly created string object is returned that has ref count zero.
*
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
{
return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
{
register Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclNewStringObj(objPtr, bytes, length);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewStringObj --
*
* This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new string objects. It is the
* same as the Tcl_NewStringObj function above except that it calls
* Tcl_DbCkalloc directly with the file name and line number from its
* caller. This simplifies debugging since then the [memory active]
* command will report the correct file name and line number when
* reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewStringObj.
*
* Results:
* A newly created string object is returned that has ref count zero.
*
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
register Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclDbNewObj(objPtr, file, line);
TclInitStringRep(objPtr, bytes, length);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
register int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
return Tcl_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */
/*
*---------------------------------------------------------------------------
*
* Tcl_NewUnicodeObj --
*
* This function is creates a new String object and initializes it from
* the given Unicode String. If the Utf String is the same size as the
* Unicode string, don't duplicate the data.
*
* Results:
* The newly created object is returned. This object will have no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of Unicode argument.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_NewUnicodeObj(
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
int numChars) /* Number of characters in the unicode
* string. */
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetCharLength --
*
* Get the length of the Unicode string from the Tcl object.
*
* Results:
* Pointer to unicode string representing the unicode object.
*
* Side effects:
* Frees old internal rep. Allocates memory for new "String" internal
* rep.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If numChars is unknown, then calculate the number of characaters while
* populating the Unicode string.
*/
if (stringPtr->numChars == -1) {
register int i = objPtr->length;
register unsigned char *str = (unsigned char *) objPtr->bytes;
/*
* This is a speed sensitive function, so run specially over the
* string to count continuous ascii characters before resorting to the
* Tcl_NumUtfChars call. This is a long form of:
stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes,objPtr->length);
*
* TODO: Consider macro-izing this.
*/
while (i && (*str < 0xC0)) {
i--;
str++;
}
stringPtr->numChars = objPtr->length - i;
if (i) {
stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
+ (objPtr->length - i), i);
}
if (stringPtr->numChars == objPtr->length) {
/*
* Since we've just calculated the number of chars, and all UTF
* chars are 1-byte long, we don't need to store the unicode
* string.
*/
stringPtr->hasUnicode = 0;
} else {
/*
* Since we've just calucalated the number of chars, and not all
* UTF chars are 1-byte long, go ahead and populate the unicode
* string.
*/
FillUnicodeRep(objPtr);
/*
* We need to fetch the pointer again because we have just
* reallocated the structure to make room for the Unicode data.
*/
stringPtr = GET_STRING(objPtr);
}
}
return stringPtr->numChars;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUniChar --
*
* Get the index'th Unicode character from the String object. The index
* is assumed to be in the appropriate range.
*
* Results:
* Returns the index'th Unicode character in the Object.
*
* Side effects:
* Fills unichar with the index'th Unicode character.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
int index) /* Get the index'th Unicode character. */
{
Tcl_UniChar unichar;
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->numChars == -1) {
/*
* We haven't yet calculated the length, so we don't have the Unicode
* str. We need to know the number of chars before we can do indexing.
*/
Tcl_GetCharLength(objPtr);
/*
* We need to fetch the pointer again because we may have just
* reallocated the structure.
*/
stringPtr = GET_STRING(objPtr);
}
if (stringPtr->hasUnicode == 0) {
/*
* All of the characters in the Utf string are 1 byte chars, so we
* don't store the unicode char. We get the Utf string and convert the
* index'th byte to a Unicode character.
*/
unichar = (Tcl_UniChar) objPtr->bytes[index];
} else {
unichar = stringPtr->unicode[index];
}
return unichar;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUnicode --
*
* Get the Unicode form of the String object. If the object is not
* already a String object, it will be converted to one. If the String
* object does not have a Unicode rep, then one is create from the UTF
* string format.
*
* Results:
* Returns a pointer to the object's internal Unicode string.
*
* Side effects:
* Converts the object to have the String internal rep.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar *
Tcl_GetUnicode(
Tcl_Obj *objPtr) /* The object to find the unicode string
* for. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
/*
* We haven't yet calculated the length, or all of the characters in
* the Utf string are 1 byte chars (so we didn't store the unicode
* str). Since this function must return a unicode string, and one has
* not yet been stored, force the Unicode to be calculated and stored
* now.
*/
FillUnicodeRep(objPtr);
/*
* We need to fetch the pointer again because we have just reallocated
* the structure to make room for the Unicode data.
*/
stringPtr = GET_STRING(objPtr);
}
return stringPtr->unicode;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUnicodeFromObj --
*
* Get the Unicode form of the String object with length. If the object
* is not already a String object, it will be converted to one. If the
* String object does not have a Unicode rep, then one is create from the
* UTF string format.
*
* Results:
* Returns a pointer to the object's internal Unicode string.
*
* Side effects:
* Converts the object to have the String internal rep.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar *
Tcl_GetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the unicode string
* for. */
int *lengthPtr) /* If non-NULL, the location where the string
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
/*
* We haven't yet calculated the length, or all of the characters in
* the Utf string are 1 byte chars (so we didn't store the unicode
* str). Since this function must return a unicode string, and one has
* not yet been stored, force the Unicode to be calculated and stored
* now.
*/
FillUnicodeRep(objPtr);
/*
* We need to fetch the pointer again because we have just reallocated
* the structure to make room for the Unicode data.
*/
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
*lengthPtr = stringPtr->numChars;
}
return stringPtr->unicode;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetRange --
*
* Create a Tcl Object that contains the chars between first and last of
* the object indicated by "objPtr". If the object is not already a
* String object, convert it to one. The first and last indices are
* assumed to be in the appropriate range.
*
* Results:
* Returns a new Tcl Object of the String type.
*
* Side effects:
* Changes the internal rep of "objPtr" to the String type.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
int first, /* First index of the range. */
int last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->numChars == -1) {
/*
* We haven't yet calculated the length, so we don't have the Unicode
* str. We need to know the number of chars before we can do indexing.
*/
Tcl_GetCharLength(objPtr);
/*
* We need to fetch the pointer again because we may have just
* reallocated the structure.
*/
stringPtr = GET_STRING(objPtr);
}
if (objPtr->bytes && (stringPtr->numChars == objPtr->length)) {
char *str = TclGetString(objPtr);
/*
* All of the characters in the Utf string are 1 byte chars, so we
* don't store the unicode char. Create a new string object containing
* the specified range of chars.
*/
newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);
/*
* Since we know the new string only has 1-byte chars, we can set it's
* numChars field.
*/
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = last-first+1;
} else {
newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
last-first+1);
}
return newObjPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetStringObj --
*
* Modify an object to hold a string that is a copy of the bytes
* indicated by the byte pointer and length arguments.
*
* Results:
* None.
*
* Side effects:
* The object's string representation will be set to a copy of the
* "length" bytes starting at "bytes". If "length" is negative, use bytes
* up to the first NUL byte; i.e., assume "bytes" points to a C-style
* NUL-terminated string. The object's old string and internal
* representations are freed and the object's type is set NULL.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetStringObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
register int length) /* The number of bytes to copy from "bytes"
* when initializing the object. If negative,
* use bytes up to the first NUL byte.*/
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
* Set the type to NULL and free any internal rep for the old type.
*/
TclFreeIntRep(objPtr);
objPtr->typePtr = NULL;
/*
* Free any old string rep, then set the string rep to a copy of the
* length bytes starting at "bytes".
*/
Tcl_InvalidateStringRep(objPtr);
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclInitStringRep(objPtr, bytes, length);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetObjLength --
*
* This function changes the length of the string representation of an
* object.
*
* Results:
* None.
*
* Side effects:
* If the size of objPtr's string representation is greater than length,
* then it is reduced to length and a new terminating null byte is stored
* in the strength. If the length of the string representation is greater
* than length, the storage space is reallocated to the given length; a
* null byte is stored at the end, but other bytes past the end of the
* original string representation are undefined. The object's internal
* representation is changed to "expendable string".
*
*----------------------------------------------------------------------
*/
void
Tcl_SetObjLength(
register Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
register int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (length < 0) {
/*
* Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
Tcl_Panic("Tcl_SetObjLength: negative length requested: "
"%d (integer overflow?)", length);
}
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* Check that we're not extending a pure unicode string.
*/
if ((size_t)length > stringPtr->allocated &&
(objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
/*
* Not enough space in current string. Reallocate the string space and
* free the old string.
*/
if (objPtr->bytes != tclEmptyStringRep) {
objPtr->bytes = ckrealloc((char *) objPtr->bytes,
(unsigned) (length + 1));
} else {
char *newBytes = ckalloc((unsigned) (length+1));
if (objPtr->bytes != NULL && objPtr->length != 0) {
memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
Tcl_InvalidateStringRep(objPtr);
}
objPtr->bytes = newBytes;
}
stringPtr->allocated = length;
/*
* Invalidate the unicode data.
*/
stringPtr->hasUnicode = 0;
}
if (objPtr->bytes != NULL) {
objPtr->length = length;
if (objPtr->bytes != tclEmptyStringRep) {
/*
* Ensure the string is NUL-terminated.
*/
objPtr->bytes[length] = 0;
}
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
size_t uallocated = STRING_UALLOC(length);
stringCheckLimits(length);
if (uallocated > stringPtr->uallocated) {
stringPtr = stringRealloc(stringPtr, length);
SET_STRING(objPtr, stringPtr);
stringPtr->uallocated = uallocated;
}
stringPtr->numChars = length;
stringPtr->hasUnicode = (length > 0);
/*
* Ensure the string is NUL-terminated.
*/
stringPtr->unicode[length] = 0;
stringPtr->allocated = 0;
objPtr->length = 0;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AttemptSetObjLength --
*
* This function changes the length of the string representation of an
* object. It uses the attempt* (non-panic'ing) memory allocators.
*
* Results:
* 1 if the requested memory was allocated, 0 otherwise.
*
* Side effects:
* If the size of objPtr's string representation is greater than length,
* then it is reduced to length and a new terminating null byte is stored
* in the strength. If the length of the string representation is greater
* than length, the storage space is reallocated to the given length; a
* null byte is stored at the end, but other bytes past the end of the
* original string representation are undefined. The object's internal
* representation is changed to "expendable string".
*
*----------------------------------------------------------------------
*/
int
Tcl_AttemptSetObjLength(
register Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
register int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (length < 0) {
/*
* Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
return 0;
}
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* Check that we're not extending a pure unicode string.
*/
if (length > (int) stringPtr->allocated &&
(objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
char *newBytes;
/*
* Not enough space in current string. Reallocate the string space and
* free the old string.
*/
if (objPtr->bytes != tclEmptyStringRep) {
newBytes = attemptckrealloc(objPtr->bytes,
(unsigned)(length + 1));
if (newBytes == NULL) {
return 0;
}
} else {
newBytes = attemptckalloc((unsigned) (length + 1));
if (newBytes == NULL) {
return 0;
}
if (objPtr->bytes != NULL && objPtr->length != 0) {
memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
Tcl_InvalidateStringRep(objPtr);
}
}
objPtr->bytes = newBytes;
stringPtr->allocated = length;
/*
* Invalidate the unicode data.
*/
stringPtr->hasUnicode = 0;
}
if (objPtr->bytes != NULL) {
objPtr->length = length;
if (objPtr->bytes != tclEmptyStringRep) {
/*
* Ensure the string is NULL-terminated.
*/
objPtr->bytes[length] = 0;
}
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
size_t uallocated = STRING_UALLOC(length);
if (length > STRING_MAXCHARS) {
return 0;
}
if (uallocated > stringPtr->uallocated) {
stringPtr = stringAttemptRealloc(stringPtr, length);
if (stringPtr == NULL) {
return 0;
}
SET_STRING(objPtr, stringPtr);
stringPtr->uallocated = uallocated;
}
stringPtr->numChars = length;
stringPtr->hasUnicode = (length > 0);
/*
* Ensure the string is NUL-terminated.
*/
stringPtr->unicode[length] = 0;
stringPtr->allocated = 0;
objPtr->length = 0;
}
return 1;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_SetUnicodeObj --
*
* Modify an object to hold the Unicode string indicated by "unicode".
*
* Results:
* None.
*
* Side effects:
* Memory allocated for new "String" internal rep.
*
*---------------------------------------------------------------------------
*/
void
Tcl_SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeIntRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
static int
UnicodeLength(
const Tcl_UniChar *unicode)
{
int numChars = 0;
if (unicode) {
while (numChars >= 0 && unicode[numChars] != 0) {
numChars++;
}
}
stringCheckLimits(numChars);
return numChars;
}
static void
SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
String *stringPtr;
size_t uallocated;
if (numChars < 0) {
numChars = UnicodeLength(unicode);
}
/*
* Allocate enough space for the String structure + Unicode string.
*/
stringCheckLimits(numChars);
uallocated = STRING_UALLOC(numChars);
stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
stringPtr->numChars = numChars;
stringPtr->uallocated = uallocated;
stringPtr->hasUnicode = (numChars > 0);
stringPtr->allocated = 0;
memcpy(stringPtr->unicode, unicode, uallocated);
stringPtr->unicode[numChars] = 0;
Tcl_InvalidateStringRep(objPtr);
objPtr->typePtr = &tclStringType;
SET_STRING(objPtr, stringPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendLimitedToObj --
*
* This function appends a limited number of bytes from a sequence of
* bytes to an object, marking any limitation with an ellipsis.
*
* Results:
* None.
*
* Side effects:
* The bytes at *bytes are appended to the string representation of
* objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendLimitedToObj(
register Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
register int length, /* The number of bytes available to be
* appended from "bytes". If < 0, then all
* bytes up to a NUL byte are available. */
register int limit, /* The maximum number of bytes to append to
* the object. */
const char *ellipsis) /* Ellipsis marker string, appended to the
* object to indicate not all available bytes
* at "bytes" were appended. */
{
String *stringPtr;
int toCopy = 0;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
SetStringFromAny(NULL, objPtr);
if (length < 0) {
length = (bytes ? strlen(bytes) : 0);
}
if (length == 0) {
return;
}
if (length <= limit) {
toCopy = length;
} else {
if (ellipsis == NULL) {
ellipsis = "...";
}
toCopy = Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
}
/*
* If objPtr has a valid Unicode rep, then append the Unicode conversion
* of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
* objPtr's string rep.
*/
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode != 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
}
if (length <= limit) {
return;
}
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode != 0) {
AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
} else {
AppendUtfToUtfRep(objPtr, ellipsis, -1);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendToObj --
*
* This function appends a sequence of bytes to an object.
*
* Results:
* None.
*
* Side effects:
* The bytes at *bytes are appended to the string representation of
* objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendToObj(
register Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
register int length) /* The number of bytes to append from "bytes".
* If < 0, then append all bytes up to NUL
* byte. */
{
Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendUnicodeToObj --
*
* This function appends a Unicode string to an object in the most
* efficient manner possible. Length must be >= 0.
*
* Results:
* None.
*
* Side effects:
* Invalidates the string rep and creates a new Unicode string.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendUnicodeToObj(
register Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
int length) /* Number of chars in "unicode". */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
}
if (length == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then append the "unicode" to the
* objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
* objPtr's string rep.
*/
if (stringPtr->hasUnicode != 0) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendObjToObj --
*
* This function appends the string rep of one object to another.
* "objPtr" cannot be a shared object.
*
* Results:
* None.
*
* Side effects:
* The string rep of appendObjPtr is appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
int length, numChars, allOneByteChars;
char *bytes;
SetStringFromAny(NULL, objPtr);
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
*/
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode != 0) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
if (appendObjPtr->typePtr == &tclStringType) {
stringPtr = GET_STRING(appendObjPtr);
if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
/*
* If appendObjPtr is a string obj with no valid Unicode rep,
* then fill its unicode rep.
*/
FillUnicodeRep(appendObjPtr);
stringPtr = GET_STRING(appendObjPtr);
}
AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
stringPtr->numChars);
} else {
bytes = TclGetStringFromObj(appendObjPtr, &length);
AppendUtfToUnicodeRep(objPtr, bytes, length);
}
return;
}
/*
* Append to objPtr's UTF string rep. If we know the number of characters
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = TclGetStringFromObj(appendObjPtr, &length);
allOneByteChars = 0;
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
stringPtr = GET_STRING(appendObjPtr);
if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
numChars += stringPtr->numChars;
allOneByteChars = 1;
}
}
AppendUtfToUtfRep(objPtr, bytes, length);
if (allOneByteChars) {
stringPtr = GET_STRING(objPtr);
stringPtr->numChars = numChars;
}
}
/*
*----------------------------------------------------------------------
*
* AppendUnicodeToUnicodeRep --
*
* This function appends the contents of "unicode" to the Unicode rep of
* "objPtr". objPtr must already have a valid Unicode rep.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
int appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
int numChars;
if (appendNumChars < 0) {
appendNumChars = UnicodeLength(unicode);
}
if (appendNumChars == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If not enough space has been allocated for the unicode rep, reallocate
* the internal rep object with additional space. First try to double the
* required allocation; if that fails, try a more modest increase. See the
* "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
* explanation of this growth algorithm.
*/
numChars = stringPtr->numChars + appendNumChars;
stringCheckLimits(numChars);
if (STRING_UALLOC(numChars) >= stringPtr->uallocated) {
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations
* due to the reallocs below.
*/
int offset = -1;
if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode
+ 1 + stringPtr->uallocated / sizeof(Tcl_UniChar)) {
offset = unicode - stringPtr->unicode;
}
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
/* Relocate unicode if needed; see above. */
if (offset >= 0) {
unicode = stringPtr->unicode + offset;
}
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
appendNumChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
stringPtr->allocated = 0;
Tcl_InvalidateStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* AppendUnicodeToUtfRep --
*
* This function converts the contents of "unicode" to UTF and appends
* the UTF to the string rep of "objPtr".
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to convert to UTF. */
int numChars) /* Number of chars of "unicode" to convert. */
{
Tcl_DString dsPtr;
const char *bytes;
if (numChars < 0) {
numChars = UnicodeLength(unicode);
}
if (numChars == 0) {
return;
}
Tcl_DStringInit(&dsPtr);
bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
Tcl_DStringFree(&dsPtr);
}
/*
*----------------------------------------------------------------------
*
* AppendUtfToUnicodeRep --
*
* This function converts the contents of "bytes" to Unicode and appends
* the Unicode to the Unicode rep of "objPtr". objPtr must already have a
* valid Unicode rep.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUtfToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to convert to Unicode. */
int numBytes) /* Number of bytes of "bytes" to convert. */
{
Tcl_DString dsPtr;
int numChars;
Tcl_UniChar *unicode;
if (numBytes < 0) {
numBytes = (bytes ? strlen(bytes) : 0);
}
if (numBytes == 0) {
return;
}
Tcl_DStringInit(&dsPtr);
numChars = Tcl_NumUtfChars(bytes, numBytes);
unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
Tcl_DStringFree(&dsPtr);
}
/*
*----------------------------------------------------------------------
*
* AppendUtfToUtfRep --
*
* This function appends "numBytes" bytes of "bytes" to the UTF string
* rep of "objPtr". objPtr must already have a valid String rep.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUtfToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to append. */
int numBytes) /* Number of bytes of "bytes" to append. */
{
String *stringPtr;
int newLength, oldLength;
if (numBytes < 0) {
numBytes = (bytes ? strlen(bytes) : 0);
}
if (numBytes == 0) {
return;
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
oldLength = objPtr->length;
newLength = numBytes + oldLength;
if (newLength < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
stringPtr = GET_STRING(objPtr);
if (newLength > (int) stringPtr->allocated) {
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations
* due to the reallocs below.
*/
int offset = -1;
if (bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
/*
* There isn't currently enough space in the string representation so
* allocate additional space. First, try to double the length
* required. If that fails, try a more modest allocation. See the "TCL
* STRING GROWTH ALGORITHM" comment at the top of this file for an
* explanation of this growth algorithm.
*/
if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for Tcl_SetObjLength.
*/
unsigned int limit = INT_MAX - newLength;
unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC;
int growth = (int) ((extra > limit) ? limit : extra);
Tcl_SetObjLength(objPtr, newLength + growth);
}
/* Relocate bytes if needed; see above. */
if (offset >=0) {
bytes = objPtr->bytes + offset;
}
}
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendStringsToObjVA --
*
* This function appends one or more null-terminated strings to an
* object.
*
* Results:
* None.
*
* Side effects:
* The contents of all the string arguments are appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendStringsToObjVA(
Tcl_Obj *objPtr, /* Points to the object to append to. */
va_list argList) /* Variable argument list. */
{
#define STATIC_LIST_SIZE 16
String *stringPtr;
int newLength, oldLength, attemptLength;
register char *string, *dst;
char *static_list[STATIC_LIST_SIZE];
char **args = static_list;
int nargs_space = STATIC_LIST_SIZE;
int nargs, i;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
}
SetStringFromAny(NULL, objPtr);
/*
* Force the existence of a string rep. so we avoid crashes operating
* on a pure unicode value. [Bug 2597185]
*/
(void) Tcl_GetStringFromObj(objPtr, &oldLength);
/*
* Figure out how much space is needed for all the strings, and expand the
* string representation if it isn't big enough. If no bytes would be
* appended, just return. Note that on some platforms (notably OS/390) the
* argList is an array so we need to use memcpy.
*/
nargs = 0;
newLength = 0;
while (1) {
string = va_arg(argList, char *);
if (string == NULL) {
break;
}
if (nargs >= nargs_space) {
/*
* Expand the args buffer.
*/
nargs_space += STATIC_LIST_SIZE;
if (args == static_list) {
args = (void *) ckalloc(nargs_space * sizeof(char *));
for (i = 0; i < nargs; ++i) {
args[i] = static_list[i];
}
} else {
args = (void *) ckrealloc((void *) args,
nargs_space * sizeof(char *));
}
}
newLength += strlen(string);
args[nargs++] = string;
}
if (newLength == 0) {
goto done;
}
stringPtr = GET_STRING(objPtr);
if (oldLength + newLength > (int) stringPtr->allocated) {
/*
* There isn't currently enough space in the string representation, so
* allocate additional space. If the current string representation
* isn't empty (i.e. it looks like we're doing a series of appends)
* then try to allocate extra space to accomodate future growth: first
* try to double the required memory; if that fails, try a more modest
* allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the
* top of this file for an explanation of this growth algorithm.
* Otherwise, if the current string representation is empty, exactly
* enough memory is allocated.
*/
if (oldLength == 0) {
Tcl_SetObjLength(objPtr, newLength);
} else {
attemptLength = 2 * (oldLength + newLength);
if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
attemptLength = oldLength + (2 * newLength) +
TCL_GROWTH_MIN_ALLOC;
Tcl_SetObjLength(objPtr, attemptLength);
}
}
}
/*
* Make a second pass through the arguments, appending all the strings to
* the object.
*/
dst = objPtr->bytes + oldLength;
for (i = 0; i < nargs; ++i) {
string = args[i];
if (string == NULL) {
break;
}
while (*string != 0) {
*dst = *string;
dst++;
string++;
}
}
/*
* Add a null byte to terminate the string. However, be careful: it's
* possible that the object is totally empty (if it was empty originally
* and there was nothing to append). In this case dst is NULL; just leave
* everything alone.
*/
if (dst != NULL) {
*dst = 0;
}
objPtr->length = oldLength + newLength;
done:
/*
* If we had to allocate a buffer from the heap, free it now.
*/
if (args != static_list) {
ckfree((void *) args);
}
#undef STATIC_LIST_SIZE
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendStringsToObj --
*
* This function appends one or more null-terminated strings to an
* object.
*
* Results:
* None.
*
* Side effects:
* The contents of all the string arguments are appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendStringsToObj(
Tcl_Obj *objPtr,
...)
{
va_list argList;
va_start(argList, objPtr);
Tcl_AppendStringsToObjVA(objPtr, argList);
va_end(argList);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendFormatToObj --
*
* This function appends a list of Tcl_Obj's to a Tcl_Obj according to
* the formatting instructions embedded in the format string. The
* formatting instructions are inspired by sprintf(). Returns TCL_OK when
* successful. If there's an error in the arguments, TCL_ERROR is
* returned, and an error message is written to the interp, if non-NULL.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_AppendFormatToObj(
Tcl_Interp *interp,
Tcl_Obj *appendObj,
const char *format,
int objc,
Tcl_Obj *const objv[])
{
const char *span = format, *msg;
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
int originalLength, limit;
static const char *mixedXPG =
"cannot mix \"%\" and \"%n$\" conversion specifiers";
static const char *badIndex[2] = {
"not enough arguments for all format specifiers",
"\"%n$\" argument index out of range"
};
static const char *overflow = "max size for a Tcl value exceeded";
if (Tcl_IsShared(appendObj)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
}
TclGetStringFromObj(appendObj, &originalLength);
limit = INT_MAX - originalLength;
/*
* Format string is NUL-terminated.
*/
while (*format != '\0') {
char *end;
int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
int width, gotPrecision, precision, useShort, useWide, useBig;
int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_UniChar ch;
int step = Tcl_UtfToUniChar(format, &ch);
format += step;
if (ch != '%') {
numBytes += step;
continue;
}
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
limit -= numBytes;
numBytes = 0;
}
/*
* Saw a % : process the format specifier.
*
* Step 0. Handle special case of escaped format marker (i.e., %%).
*/
step = Tcl_UtfToUniChar(format, &ch);
if (ch == '%') {
span = format;
numBytes = step;
format += step;
continue;
}
/*
* Step 1. XPG3 position specifier
*/
newXpg = 0;
if (isdigit(UCHAR(ch))) {
int position = strtoul(format, &end, 10);
if (*end == '$') {
newXpg = 1;
objIndex = position - 1;
format = end + 1;
step = Tcl_UtfToUniChar(format, &ch);
}
}
if (newXpg) {
if (gotSequential) {
msg = mixedXPG;
goto errorMsg;
}
gotXpg = 1;
} else {
if (gotXpg) {
msg = mixedXPG;
goto errorMsg;
}
gotSequential = 1;
}
if ((objIndex < 0) || (objIndex >= objc)) {
msg = badIndex[gotXpg];
goto errorMsg;
}
/*
* Step 2. Set of flags.
*/
gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
sawFlag = 1;
do {
switch (ch) {
case '-':
gotMinus = 1;
break;
case '#':
gotHash = 1;
break;
case '0':
gotZero = 1;
break;
case ' ':
gotSpace = 1;
break;
case '+':
gotPlus = 1;
break;
default:
sawFlag = 0;
}
if (sawFlag) {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
} while (sawFlag);
/*
* Step 3. Minimum field width.
*/
width = 0;
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
goto error;
}
if (width < 0) {
width = -width;
gotMinus = 1;
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
if (width > limit) {
msg = overflow;
goto errorMsg;
}
/*
* Step 4. Precision.
*/
gotPrecision = precision = 0;
if (ch == '.') {
gotPrecision = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
if (isdigit(UCHAR(ch))) {
precision = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &precision)
!= TCL_OK) {
goto error;
}
/*
* TODO: Check this truncation logic.
*/
if (precision < 0) {
precision = 0;
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
/*
* Step 5. Length modifier.
*/
useShort = useWide = useBig = 0;
if (ch == 'h') {
useShort = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == 'l') {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
if (ch == 'l') {
useBig = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
} else {
#ifndef TCL_WIDE_INT_IS_LONG
useWide = 1;
#endif
}
}
format += step;
span = format;
/*
* Step 6. The actual conversion character.
*/
segment = objv[objIndex];
numChars = -1;
if (ch == 'i') {
ch = 'd';
}
switch (ch) {
case '\0':
msg = "format string ended in middle of field specifier";
goto errorMsg;
case 's':
if (gotPrecision) {
numChars = Tcl_GetCharLength(segment);
if (precision < numChars) {
segment = Tcl_GetRange(segment, 0, precision - 1);
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
}
}
break;
case 'c': {
char buf[TCL_UTF_MAX];
int code, length;
if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
break;
}
case 'u':
if (useBig) {
msg = "unsigned bignum format is invalid";
goto errorMsg;
}
case 'd':
case 'o':
case 'x':
case 'X': {
short int s = 0; /* Silence compiler warning; only defined and
* used when useShort is true. */
long l;
Tcl_WideInt w;
mp_int big;
int toAppend, isNegative = 0;
if (useBig) {
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt)0);
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
TclGetLongFromObj(NULL, objPtr, &l);
Tcl_DecrRefCount(objPtr);
} else {
l = Tcl_WideAsLong(w);
}
if (useShort) {
s = (short int) l;
isNegative = (s < (short int)0);
} else {
isNegative = (l < (long)0);
}
} else if (useShort) {
s = (short int) l;
isNegative = (s < (short int)0);
} else {
isNegative = (l < (long)0);
}
segment = Tcl_NewObj();
allocSegment = 1;
segmentLimit = INT_MAX;
Tcl_IncrRefCount(segment);
if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) {
Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1);
segmentLimit -= 1;
}
if (gotHash) {
switch (ch) {
case 'o':
Tcl_AppendToObj(segment, "0", 1);
segmentLimit -= 1;
precision--;
break;
case 'x':
case 'X':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
}
}
switch (ch) {
case 'd': {
int length;
Tcl_Obj *pure;
const char *bytes;
if (useShort) {
pure = Tcl_NewIntObj((int)(s));
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
} else if (useBig) {
pure = Tcl_NewBignumObj(&big);
} else {
pure = Tcl_NewLongObj(l);
}
Tcl_IncrRefCount(pure);
bytes = TclGetStringFromObj(pure, &length);
/*
* Already did the sign above.
*/
if (*bytes == '-') {
length--;
bytes++;
}
toAppend = length;
/*
* Canonical decimal string reps for integers are composed
* entirely of one-byte encoded characters, so "length" is the
* number of chars.
*/
if (gotPrecision) {
if (length < precision) {
segmentLimit -= (precision - length);
}
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
gotZero = 0;
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
if (length < width) {
segmentLimit -= (width - length);
}
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
if (toAppend > segmentLimit) {
msg = overflow;
goto errorMsg;
}
Tcl_AppendToObj(segment, bytes, toAppend);
Tcl_DecrRefCount(pure);
break;
}
case 'u':
case 'o':
case 'x':
case 'X': {
Tcl_WideUInt bits = (Tcl_WideUInt)0;
Tcl_WideInt numDigits = (Tcl_WideInt)0;
int length, numBits = 4, base = 16;
int index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
if (ch == 'u') {
base = 10;
}
if (ch == 'o') {
base = 8;
numBits = 3;
}
if (useShort) {
unsigned short int us = (unsigned short int) s;
bits = (Tcl_WideUInt) us;
while (us) {
numDigits++;
us /= base;
}
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
bits = uw;
while (uw) {
numDigits++;
uw /= base;
}
} else if (useBig && big.used) {
int leftover = (big.used * DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
numDigits = 1 +
(((Tcl_WideInt)big.used * DIGIT_BIT) / numBits);
while ((mask & big.dp[big.used-1]) == 0) {
numDigits--;
mask >>= numBits;
}
if (numDigits > INT_MAX) {
msg = overflow;
goto errorMsg;
}
} else if (!useBig) {
unsigned long int ul = (unsigned long int) l;
bits = (Tcl_WideUInt) ul;
while (ul) {
numDigits++;
ul /= base;
}
}
/*
* Need to be sure zero becomes "0", not "".
*/
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
numDigits = 1;
}
pure = Tcl_NewObj();
Tcl_SetObjLength(pure, (int)numDigits);
bytes = TclGetString(pure);
toAppend = length = (int)numDigits;
while (numDigits--) {
int digitOffset;
if (useBig && big.used) {
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift);
shift += DIGIT_BIT;
}
shift -= numBits;
}
digitOffset = (int) (bits % base);
if (digitOffset > 9) {
bytes[numDigits] = 'a' + digitOffset - 10;
} else {
bytes[numDigits] = '0' + digitOffset;
}
bits /= base;
}
if (useBig) {
mp_clear(&big);
}
if (gotPrecision) {
if (length < precision) {
segmentLimit -= (precision - length);
}
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
gotZero = 0;
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
if (length < width) {
segmentLimit -= (width - length);
}
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
if (toAppend > segmentLimit) {
msg = overflow;
goto errorMsg;
}
Tcl_AppendObjToObj(segment, pure);
Tcl_DecrRefCount(pure);
break;
}
}
break;
}
case 'e':
case 'E':
case 'f':
case 'g':
case 'G': {
#define MAX_FLOAT_SIZE 320
char spec[2*TCL_INTEGER_SPACE + 9], *p = spec;
double d;
int length = MAX_FLOAT_SIZE;
char *bytes;
if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) {
/* TODO: Figure out ACCEPT_NAN here */
goto error;
}
*p++ = '%';
if (gotMinus) {
*p++ = '-';
}
if (gotHash) {
*p++ = '#';
}
if (gotZero) {
*p++ = '0';
}
if (gotSpace) {
*p++ = ' ';
}
if (gotPlus) {
*p++ = '+';
}
if (width) {
p += sprintf(p, "%d", width);
if (width > length) {
length = width;
}
}
if (gotPrecision) {
*p++ = '.';
p += sprintf(p, "%d", precision);
if (precision > INT_MAX - length) {
msg=overflow;
goto errorMsg;
}
length += precision;
}
/*
* Don't pass length modifiers!
*/
*p++ = (char) ch;
*p = '\0';
segment = Tcl_NewObj();
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
msg = overflow;
goto errorMsg;
}
bytes = TclGetString(segment);
if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
msg = overflow;
goto errorMsg;
}
break;
}
default:
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
}
goto error;
}
switch (ch) {
case 'E':
case 'G':
case 'X': {
Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
}
}
if (width > 0) {
if (numChars < 0) {
numChars = Tcl_GetCharLength(segment);
}
if (!gotMinus) {
if (numChars < width) {
limit -= (width - numChars);
}
while (numChars < width) {
Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
numChars++;
}
}
}
Tcl_GetStringFromObj(segment, &segmentNumBytes);
if (segmentNumBytes > limit) {
if (allocSegment) {
Tcl_DecrRefCount(segment);
}
msg = overflow;
goto errorMsg;
}
Tcl_AppendObjToObj(appendObj, segment);
limit -= segmentNumBytes;
if (allocSegment) {
Tcl_DecrRefCount(segment);
}
if (width > 0) {
if (numChars < width) {
limit -= (width - numChars);
}
while (numChars < width) {
Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
numChars++;
}
}
objIndex += gotSequential;
}
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
limit -= numBytes;
numBytes = 0;
}
return TCL_OK;
errorMsg:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
}
error:
Tcl_SetObjLength(appendObj, originalLength);
return TCL_ERROR;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_Format--
*
* Results:
* A refcount zero Tcl_Obj.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_Format(
Tcl_Interp *interp,
const char *format,
int objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
return NULL;
}
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* AppendPrintfToObjVA --
*
* Results:
*
* Side effects:
*
*---------------------------------------------------------------------------
*/
static void
AppendPrintfToObjVA(
Tcl_Obj *objPtr,
const char *format,
va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
const char *p;
char *end;
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
int size = 0, seekingConversion = 1, gotPrecision = 0;
int lastNum = -1;
if (*p++ != '%') {
continue;
}
if (*p == '%') {
p++;
continue;
}
do {
switch (*p) {
case '\0':
seekingConversion = 0;
break;
case 's': {
const char *q, *end, *bytes = va_arg(argList, char *);
seekingConversion = 0;
/*
* The buffer to copy characters from starts at bytes and ends
* at either the first NUL byte, or after lastNum bytes, when
* caller has indicated a limit.
*/
end = bytes;
while ((!gotPrecision || lastNum--) && (*end != '\0')) {
end++;
}
/*
* Within that buffer, we trim both ends if needed so that we
* copy only whole characters, and avoid copying any partial
* multi-byte characters.
*/
q = Tcl_UtfPrev(end, bytes);
if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
end = q;
}
q = bytes + TCL_UTF_MAX;
while ((bytes < end) && (bytes < q)
&& ((*bytes & 0xC0) == 0x80)) {
bytes++;
}
Tcl_ListObjAppendElement(NULL, list,
Tcl_NewStringObj(bytes , (int)(end - bytes)));
break;
}
case 'c':
case 'i':
case 'u':
case 'd':
case 'o':
case 'x':
case 'X':
seekingConversion = 0;
switch (size) {
case -1:
case 0:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
(long int)va_arg(argList, int)));
break;
case 1:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
va_arg(argList, long int)));
break;
}
break;
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
va_arg(argList, double)));
seekingConversion = 0;
break;
case '*':
lastNum = (int)va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
lastNum = (int) strtoul(p, &end, 10);
p = end;
break;
case '.':
gotPrecision = 1;
p++;
break;
/* TODO: support for wide (and bignum?) arguments */
case 'l':
size = 1;
p++;
break;
case 'h':
size = -1;
default:
p++;
}
} while (seekingConversion);
}
TclListObjGetElements(NULL, list, &objc, &objv);
code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
if (code != TCL_OK) {
Tcl_AppendPrintfToObj(objPtr,
"Unable to format \"%s\" with supplied arguments: %s",
format, Tcl_GetString(list));
}
Tcl_DecrRefCount(list);
}
/*
*---------------------------------------------------------------------------
*
* Tcl_AppendPrintfToObj --
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
void
Tcl_AppendPrintfToObj(
Tcl_Obj *objPtr,
const char *format,
...)
{
va_list argList;
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
}
/*
*---------------------------------------------------------------------------
*
* Tcl_ObjPrintf --
*
* Results:
* A refcount zero Tcl_Obj.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_ObjPrintf(
const char *format,
...)
{
va_list argList;
Tcl_Obj *objPtr = Tcl_NewObj();
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* TclStringObjReverse --
*
* Implements the [string reverse] operation.
*
* Results:
* An unshared Tcl value which is the [string reverse] of the argument
* supplied. When sharing rules permit, the returned value might be
* the argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
TclStringObjReverse(
Tcl_Obj *objPtr)
{
String *stringPtr;
int numChars = Tcl_GetCharLength(objPtr);
int i = 0, lastCharIdx = numChars - 1;
char *bytes;
if (numChars <= 1) {
return objPtr;
}
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *source = stringPtr->unicode;
if (Tcl_IsShared(objPtr)) {
Tcl_UniChar *dest, ch = 0;
/*
* Create a non-empty, pure unicode value, so we can coax
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(resultPtr, numChars);
dest = Tcl_GetUnicode(resultPtr);
while (i < numChars) {
dest[i++] = source[lastCharIdx--];
}
return resultPtr;
}
while (i < lastCharIdx) {
Tcl_UniChar tmp = source[lastCharIdx];
source[lastCharIdx--] = source[i];
source[i++] = tmp;
}
Tcl_InvalidateStringRep(objPtr);
return objPtr;
}
bytes = TclGetString(objPtr);
if (Tcl_IsShared(objPtr)) {
char *dest;
Tcl_Obj *resultPtr = Tcl_NewObj();
Tcl_SetObjLength(resultPtr, numChars);
dest = TclGetString(resultPtr);
while (i < numChars) {
dest[i++] = bytes[lastCharIdx--];
}
return resultPtr;
}
while (i < lastCharIdx) {
char tmp = bytes[lastCharIdx];
bytes[lastCharIdx--] = bytes[i];
bytes[i++] = tmp;
}
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* FillUnicodeRep --
*
* Populate the Unicode internal rep with the Unicode form of its string
* rep. The object must alread have a "String" internal rep.
*
* Results:
* None.
*
* Side effects:
* Reallocates the String internal rep.
*
*---------------------------------------------------------------------------
*/
static void
FillUnicodeRep(
Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
String *stringPtr;
size_t uallocated;
char *srcEnd, *src = objPtr->bytes;
Tcl_UniChar *dst;
stringPtr = GET_STRING(objPtr);
if (stringPtr->numChars == -1) {
stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
}
stringPtr->hasUnicode = (stringPtr->numChars > 0);
stringCheckLimits(stringPtr->numChars);
uallocated = STRING_UALLOC(stringPtr->numChars);
if (uallocated > stringPtr->uallocated) {
GrowUnicodeBuffer(objPtr, stringPtr->numChars);
stringPtr = GET_STRING(objPtr);
}
/*
* Convert src to Unicode and store the coverted data in "unicode".
*/
srcEnd = src + objPtr->length;
for (dst = stringPtr->unicode; src < srcEnd; dst++) {
src += TclUtfToUniChar(src, dst);
}
*dst = 0;
SET_STRING(objPtr, stringPtr);
}
/*
*----------------------------------------------------------------------
*
* DupStringInternalRep --
*
* Initialize the internal representation of a new Tcl_Obj to a copy of
* the internal representation of an existing string object.
*
* Results:
* None.
*
* Side effects:
* copyPtr's internal rep is set to a copy of srcPtr's internal
* representation.
*
*----------------------------------------------------------------------
*/
static void
DupStringInternalRep(
register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
* an internal rep of type "String". */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
/*
* If the src obj is a string of 1-byte Utf chars, then copy the string
* rep of the source object and create an "empty" Unicode internal rep for
* the new object. Otherwise, copy Unicode internal rep, and invalidate
* the string rep of the new object.
*/
if (srcStringPtr->hasUnicode == 0) {
copyStringPtr = (String *) ckalloc(sizeof(String));
copyStringPtr->uallocated = 0;
} else {
copyStringPtr = (String *) ckalloc(
STRING_SIZE(srcStringPtr->uallocated));
copyStringPtr->uallocated = srcStringPtr->uallocated;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
copyStringPtr->unicode[srcStringPtr->numChars] = 0;
}
copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
copyStringPtr->allocated = srcStringPtr->allocated;
/*
* Tricky point: the string value was copied by generic object management
* code, so it doesn't contain any extra bytes that might exist in the
* source object.
*/
copyStringPtr->allocated = copyPtr->length;
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
}
/*
*----------------------------------------------------------------------
*
* SetStringFromAny --
*
* Create an internal representation of type "String" for an object.
*
* Results:
* This operation always succeeds and returns TCL_OK.
*
* Side effects:
* Any old internal reputation for objPtr is freed and the internal
* representation is set to "String".
*
*----------------------------------------------------------------------
*/
static int
SetStringFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
/*
* The Unicode object is optimized for the case where each UTF char in a
* string is only one byte. In this case, we store the value of numChars,
* but we don't copy the bytes to the unicodeObj->unicode.
*/
if (objPtr->typePtr != &tclStringType) {
String *stringPtr;
if (objPtr->typePtr != NULL) {
if (objPtr->bytes == NULL) {
objPtr->typePtr->updateStringProc(objPtr);
}
TclFreeIntRep(objPtr);
}
objPtr->typePtr = &tclStringType;
/*
* Allocate enough space for the basic String structure.
*/
stringPtr = (String *) ckalloc(sizeof(String));
stringPtr->numChars = -1;
stringPtr->uallocated = 0;
stringPtr->hasUnicode = 0;
if (objPtr->bytes != NULL) {
stringPtr->allocated = objPtr->length;
if (objPtr->bytes != tclEmptyStringRep) {
objPtr->bytes[objPtr->length] = 0;
}
} else {
objPtr->length = 0;
}
SET_STRING(objPtr, stringPtr);
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfString --
*
* Update the string representation for an object whose internal
* representation is "String".
*
* Results:
* None.
*
* Side effects:
* The object's string may be set by converting its Unicode represention
* to UTF format.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
int i, size;
Tcl_UniChar *unicode;
char dummy[TCL_UTF_MAX];
char *dst;
String *stringPtr;
stringPtr = GET_STRING(objPtr);
if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
if (stringPtr->numChars <= 0) {
/*
* If there is no Unicode rep, or the string has 0 chars, then set
* the string rep to an empty string.
*/
objPtr->bytes = tclEmptyStringRep;
objPtr->length = 0;
return;
}
unicode = stringPtr->unicode;
/*
* Translate the Unicode string to UTF. "size" will hold the amount of
* space the UTF string needs.
*/
if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX
&& stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) {
goto copyBytes;
}
size = 0;
for (i = 0; i < stringPtr->numChars && size >= 0; i++) {
size += Tcl_UniCharToUtf((int) unicode[i], dummy);
}
if (size < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
objPtr->bytes = (char *) ckalloc((unsigned) (size + 1));
objPtr->length = size;
stringPtr->allocated = size;
copyBytes:
dst = objPtr->bytes;
for (i = 0; i < stringPtr->numChars; i++) {
dst += Tcl_UniCharToUtf(unicode[i], dst);
}
*dst = '\0';
}
return;
}
/*
*----------------------------------------------------------------------
*
* FreeStringInternalRep --
*
* Deallocate the storage associated with a String data object's internal
* representation.
*
* Results:
* None.
*
* Side effects:
* Frees memory.
*
*----------------------------------------------------------------------
*/
static void
FreeStringInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
ckfree((char *) GET_STRING(objPtr));
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
