diff options
Diffstat (limited to 'generic/tclStringObj.c')
| -rw-r--r-- | generic/tclStringObj.c | 2086 |
1 files changed, 745 insertions, 1341 deletions
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c45baa1..86f0c62 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -36,7 +36,6 @@ #include "tclInt.h" #include "tommath.h" -#include "tclStringRep.h" /* * Prototypes for functions defined later in this file: @@ -54,14 +53,8 @@ static void AppendUtfToUtfRep(Tcl_Obj *objPtr, const char *bytes, int numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static int ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, int numChars); -static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, int numBytes, - int numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); -static void GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, @@ -74,14 +67,71 @@ static void UpdateStringOfString(Tcl_Obj *objPtr); * functions that can be invoked by generic object code. */ -const Tcl_ObjType tclStringType = { +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.twoPtrValue.ptr1) +#define SET_STRING(objPtr, stringPtr) \ + ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr)) + /* * TCL STRING GROWTH ALGORITHM * @@ -90,7 +140,8 @@ const Tcl_ObjType tclStringType = { * * Attempt to allocate 2 * (originalLength + appendLength) * On failure: - * attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH + * 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 @@ -103,93 +154,37 @@ const Tcl_ObjType tclStringType = { * cover the request, but which hopefully will be less than the total * available memory. * - * The addition of TCL_MIN_GROWTH allows for efficient handling of very + * 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_MIN_GROWTH is a reasonable size, we can avoid that behavior. + * 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_MIN_GROWTH Additional space, in bytes, to allocate when + * TCL_GROWTH_MIN_ALLOC Additional space, in bytes, to allocate when * the double allocation has failed. Default is - * 1024 (1 kilobyte). See tclInt.h. + * 1024 (1 kilobyte). */ -#ifndef TCL_MIN_UNICHAR_GROWTH -#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar) +#ifndef TCL_GROWTH_MIN_ALLOC +#define TCL_GROWTH_MIN_ALLOC 1024 #endif static void -GrowStringBuffer( - Tcl_Obj *objPtr, - int needed, - int flag) -{ - /* - * Pre-conditions: - * objPtr->typePtr == &tclStringType - * needed > stringPtr->allocated - * flag || objPtr->bytes != NULL - */ - - String *stringPtr = GET_STRING(objPtr); - char *ptr = NULL; - int attempt; - - if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = NULL; - } - if (flag == 0 || stringPtr->allocated > 0) { - attempt = 2 * needed; - if (attempt >= 0) { - ptr = attemptckrealloc(objPtr->bytes, attempt + 1); - } - if (ptr == NULL) { - /* - * Take care computing the amount of modest growth to avoid - * overflow into invalid argument values for attempt. - */ - - unsigned int limit = INT_MAX - needed; - unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH; - int growth = (int) ((extra > limit) ? limit : extra); - - attempt = needed + growth; - ptr = attemptckrealloc(objPtr->bytes, attempt + 1); - } - } - if (ptr == NULL) { - /* - * First allocation - just big enough; or last chance fallback. - */ - - attempt = needed; - ptr = ckrealloc(objPtr->bytes, attempt + 1); - } - objPtr->bytes = ptr; - stringPtr->allocated = attempt; -} - -static void GrowUnicodeBuffer( Tcl_Obj *objPtr, int needed) { - /* - * Pre-conditions: - * objPtr->typePtr == &tclStringType - * needed > stringPtr->maxChars - * needed < STRING_MAXCHARS + /* Pre-conditions: + * objPtr->typePtr == &tclStringType + * STRING_UALLOC(needed) > stringPtr->uallocated + * needed < STRING_MAXCHARS */ - String *ptr = NULL, *stringPtr = GET_STRING(objPtr); int attempt; - if (stringPtr->maxChars > 0) { - /* - * Subsequent appends - apply the growth algorithm. - */ - + if (stringPtr->uallocated > 0) { + /* Subsequent appends - apply the growth algorithm. */ attempt = 2 * needed; if (attempt >= 0 && attempt <= STRING_MAXCHARS) { ptr = stringAttemptRealloc(stringPtr, attempt); @@ -199,28 +194,24 @@ GrowUnicodeBuffer( * 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_MIN_UNICHAR_GROWTH; + + 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. - */ - + /* First allocation - just big enough; or last chance fallback. */ attempt = needed; ptr = stringRealloc(stringPtr, attempt); } stringPtr = ptr; - stringPtr->maxChars = attempt; + stringPtr->uallocated = STRING_UALLOC(attempt); SET_STRING(objPtr, stringPtr); } + /* *---------------------------------------------------------------------- @@ -270,7 +261,7 @@ Tcl_NewStringObj( * negative, use bytes up to the first NUL * byte. */ { - Tcl_Obj *objPtr; + register Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); @@ -323,7 +314,7 @@ Tcl_DbNewStringObj( int line) /* Line number in the source file; used for * debugging. */ { - Tcl_Obj *objPtr; + register Tcl_Obj *objPtr; if (length < 0) { length = (bytes? strlen(bytes) : 0); @@ -337,7 +328,7 @@ 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" + 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. */ @@ -406,47 +397,64 @@ Tcl_GetCharLength( * of. */ { String *stringPtr; - int numChars; + + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); /* - * Quick, no-shimmer return for short string reps. + * If numChars is unknown, then calculate the number of characaters while + * populating the Unicode string. */ - if ((objPtr->bytes) && (objPtr->length < 2)) { - /* 0 bytes -> 0 chars; 1 byte -> 1 char */ - return objPtr->length; - } + if (stringPtr->numChars == -1) { + register int i = objPtr->length; + register unsigned char *str = (unsigned char *) objPtr->bytes; - /* - * Optimize the case where we're really dealing with a bytearray object - * without string representation; we don't need to convert to a string to - * perform the get-length operation. - */ + /* + * 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. + */ - if (TclIsPureByteArray(objPtr)) { - int length; + while (i && (*str < 0xC0)) { + i--; + str++; + } + stringPtr->numChars = objPtr->length - i; + if (i) { + stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes + + (objPtr->length - i), i); + } - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - return length; - } + if (stringPtr->numChars == objPtr->length) { + /* + * Since we've just calculated the number of chars, and all UTF + * chars are 1-byte long, we don't need to store the unicode + * string. + */ - /* - * OK, need to work with the object as a 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. + */ - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); - numChars = stringPtr->numChars; + FillUnicodeRep(objPtr); - /* - * If numChars is unknown, compute it. - */ + /* + * We need to fetch the pointer again because we have just + * reallocated the structure to make room for the Unicode data. + */ - if (numChars == -1) { - TclNumUtfChars(numChars, objPtr->bytes, objPtr->length); - stringPtr->numChars = numChars; + stringPtr = GET_STRING(objPtr); + } } - return numChars; + return stringPtr->numChars; } /* @@ -472,42 +480,39 @@ Tcl_GetUniChar( * from. */ int index) /* Get the index'th Unicode character. */ { + Tcl_UniChar unichar; String *stringPtr; - /* - * Optimize the case where we're really dealing with a bytearray object - * without string representation; we don't need to convert to a string to - * perform the indexing operation. - */ - - if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); + SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); - return (Tcl_UniChar) bytes[index]; - } + 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. + */ - /* - * OK, need to work with the object as a string. - */ + Tcl_GetCharLength(objPtr); - SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); + /* + * We need to fetch the pointer again because we may have just + * reallocated the structure. + */ + stringPtr = GET_STRING(objPtr); + } if (stringPtr->hasUnicode == 0) { /* - * If numChars is unknown, compute it. + * 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. */ - if (stringPtr->numChars == -1) { - TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); - } - if (stringPtr->numChars == objPtr->length) { - return (Tcl_UniChar) objPtr->bytes[index]; - } - FillUnicodeRep(objPtr); - stringPtr = GET_STRING(objPtr); + unichar = (Tcl_UniChar) objPtr->bytes[index]; + } else { + unichar = stringPtr->unicode[index]; } - return stringPtr->unicode[index]; + return unichar; } /* @@ -534,7 +539,30 @@ Tcl_GetUnicode( Tcl_Obj *objPtr) /* The object to find the unicode string * for. */ { - return Tcl_GetUnicodeFromObj(objPtr, NULL); + 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; } /* @@ -569,8 +597,22 @@ Tcl_GetUnicodeFromObj( SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode == 0) { + 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); } @@ -608,50 +650,49 @@ Tcl_GetRange( Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; - /* - * Optimize the case where we're really dealing with a bytearray object - * without string representation; we don't need to convert to a string to - * perform the substring operation. - */ - - if (TclIsPureByteArray(objPtr)) { - unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL); - - return Tcl_NewByteArrayObj(bytes+first, last-first+1); - } - - /* - * OK, need to work with the object as a string. - */ - SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode == 0) { + if (stringPtr->numChars == -1) { /* - * If numChars is unknown, compute it. + * 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. */ - if (stringPtr->numChars == -1) { - TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); - } - if (stringPtr->numChars == objPtr->length) { - newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1); + Tcl_GetCharLength(objPtr); - /* - * Since we know the char length of the result, store it. - */ + /* + * We need to fetch the pointer again because we may have just + * reallocated the structure. + */ - SetStringFromAny(NULL, newObjPtr); - stringPtr = GET_STRING(newObjPtr); - stringPtr->numChars = newObjPtr->length; - return newObjPtr; - } - FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); + 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; } /* @@ -677,10 +718,10 @@ Tcl_GetRange( void Tcl_SetStringObj( - Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + 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. */ - int length) /* The number of bytes to copy from "bytes" + 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.*/ { @@ -693,6 +734,7 @@ Tcl_SetStringObj( */ TclFreeIntRep(objPtr); + objPtr->typePtr = NULL; /* * Free any old string rep, then set the string rep to a copy of the @@ -731,9 +773,9 @@ Tcl_SetStringObj( void Tcl_SetObjLength( - Tcl_Obj *objPtr, /* Pointer to object. This object must not + register Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + register int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -741,42 +783,60 @@ Tcl_SetObjLength( if (length < 0) { /* - * Setting to a negative length is nonsense. This is probably the + * 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"); } - - if (objPtr->bytes && objPtr->length == length) { - return; - } - SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); - if (objPtr->bytes != NULL) { + /* + * Check that we're not extending a pure unicode string. + */ + + if ((size_t)length > stringPtr->allocated && + (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { /* - * Change length of an existing string rep. + * Not enough space in current string. Reallocate the string space and + * free the old string. */ - if (length > stringPtr->allocated) { - /* - * Need to enlarge the buffer. - */ - if (objPtr->bytes == &tclEmptyString) { - objPtr->bytes = ckalloc(length + 1); - } else { - objPtr->bytes = ckrealloc(objPtr->bytes, length + 1); + + 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); + TclInvalidateStringRep(objPtr); } - stringPtr->allocated = length; + objPtr->bytes = newBytes; } + stringPtr->allocated = length; + + /* + * Invalidate the unicode data. + */ + stringPtr->hasUnicode = 0; + } + + if (objPtr->bytes != NULL) { objPtr->length = length; - objPtr->bytes[length] = 0; + if (objPtr->bytes != tclEmptyStringRep) { + /* + * Ensure the string is NUL-terminated. + */ + + objPtr->bytes[length] = 0; + } /* * Invalidate the unicode data. @@ -789,25 +849,24 @@ Tcl_SetObjLength( * Changing length of pure unicode string. */ + size_t uallocated = STRING_UALLOC(length); + stringCheckLimits(length); - if (length > stringPtr->maxChars) { + if (uallocated > stringPtr->uallocated) { stringPtr = stringRealloc(stringPtr, length); SET_STRING(objPtr, stringPtr); - stringPtr->maxChars = length; + stringPtr->uallocated = uallocated; } + stringPtr->numChars = length; + stringPtr->hasUnicode = (length > 0); /* - * Mark the new end of the unicode string + * Ensure the string is NUL-terminated. */ - stringPtr->numChars = length; stringPtr->unicode[length] = 0; - stringPtr->hasUnicode = 1; - - /* - * Can only get here when objPtr->bytes == NULL. No need to invalidate - * the string rep. - */ + stringPtr->allocated = 0; + objPtr->length = 0; } } @@ -836,9 +895,9 @@ Tcl_SetObjLength( int Tcl_AttemptSetObjLength( - Tcl_Obj *objPtr, /* Pointer to object. This object must not + register Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - int length) /* Number of bytes desired for string + register int length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { @@ -846,47 +905,66 @@ Tcl_AttemptSetObjLength( if (length < 0) { /* - * Setting to a negative length is nonsense. This is probably the + * 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"); } - if (objPtr->bytes && objPtr->length == length) { - return 1; - } - SetStringFromAny(NULL, objPtr); + stringPtr = GET_STRING(objPtr); - if (objPtr->bytes != NULL) { + /* + * Check that we're not extending a pure unicode string. + */ + + if (length > (int) stringPtr->allocated && + (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) { + char *newBytes; + /* - * Change length of an existing string rep. + * Not enough space in current string. Reallocate the string space and + * free the old string. */ - if (length > stringPtr->allocated) { - /* - * Need to enlarge the buffer. - */ - - char *newBytes; - if (objPtr->bytes == &tclEmptyString) { - newBytes = attemptckalloc(length + 1); - } else { - newBytes = attemptckrealloc(objPtr->bytes, length + 1); + 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; } - objPtr->bytes = newBytes; - stringPtr->allocated = length; + if (objPtr->bytes != NULL && objPtr->length != 0) { + memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length); + TclInvalidateStringRep(objPtr); + } } + objPtr->bytes = newBytes; + stringPtr->allocated = length; + + /* + * Invalidate the unicode data. + */ + + stringPtr->hasUnicode = 0; + } + if (objPtr->bytes != NULL) { objPtr->length = length; - objPtr->bytes[length] = 0; + if (objPtr->bytes != tclEmptyStringRep) { + /* + * Ensure the string is NULL-terminated. + */ + + objPtr->bytes[length] = 0; + } /* * Invalidate the unicode data. @@ -899,30 +977,29 @@ Tcl_AttemptSetObjLength( * Changing length of pure unicode string. */ + size_t uallocated = STRING_UALLOC(length); if (length > STRING_MAXCHARS) { return 0; } - if (length > stringPtr->maxChars) { + + if (uallocated > stringPtr->uallocated) { stringPtr = stringAttemptRealloc(stringPtr, length); if (stringPtr == NULL) { return 0; } SET_STRING(objPtr, stringPtr); - stringPtr->maxChars = length; + stringPtr->uallocated = uallocated; } + stringPtr->numChars = length; + stringPtr->hasUnicode = (length > 0); /* - * Mark the new end of the unicode string. + * Ensure the string is NUL-terminated. */ stringPtr->unicode[length] = 0; - stringPtr->numChars = length; - stringPtr->hasUnicode = 1; - - /* - * Can only get here when objPtr->bytes == NULL. No need to invalidate - * the string rep. - */ + stringPtr->allocated = 0; + objPtr->length = 0; } return 1; } @@ -982,6 +1059,7 @@ SetUnicodeObj( * string. */ { String *stringPtr; + size_t uallocated; if (numChars < 0) { numChars = UnicodeLength(unicode); @@ -992,18 +1070,19 @@ SetUnicodeObj( */ stringCheckLimits(numChars); - stringPtr = stringAlloc(numChars); - SET_STRING(objPtr, stringPtr); - objPtr->typePtr = &tclStringType; + uallocated = STRING_UALLOC(numChars); + stringPtr = (String *) ckalloc(STRING_SIZE(uallocated)); - stringPtr->maxChars = numChars; - memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar)); - stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; - stringPtr->hasUnicode = 1; + stringPtr->uallocated = uallocated; + stringPtr->hasUnicode = (numChars > 0); + stringPtr->allocated = 0; + memcpy(stringPtr->unicode, unicode, uallocated); + stringPtr->unicode[numChars] = 0; TclInvalidateStringRep(objPtr); - stringPtr->allocated = 0; + objPtr->typePtr = &tclStringType; + SET_STRING(objPtr, stringPtr); } /* @@ -1026,13 +1105,13 @@ SetUnicodeObj( void Tcl_AppendLimitedToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ + register Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length, /* The number of bytes available to be + 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. */ - int limit, /* The maximum number of bytes to append to + 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 @@ -1045,6 +1124,8 @@ Tcl_AppendLimitedToObj( Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj"); } + SetStringFromAny(NULL, objPtr); + if (length < 0) { length = (bytes ? strlen(bytes) : 0); } @@ -1068,10 +1149,8 @@ Tcl_AppendLimitedToObj( * objPtr's string rep. */ - SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { + if (stringPtr->hasUnicode != 0) { AppendUtfToUnicodeRep(objPtr, bytes, toCopy); } else { AppendUtfToUtfRep(objPtr, bytes, toCopy); @@ -1082,10 +1161,10 @@ Tcl_AppendLimitedToObj( } stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode && stringPtr->numChars > 0) { - AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis)); + if (stringPtr->hasUnicode != 0) { + AppendUtfToUnicodeRep(objPtr, ellipsis, -1); } else { - AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis)); + AppendUtfToUtfRep(objPtr, ellipsis, -1); } } @@ -1108,10 +1187,10 @@ Tcl_AppendLimitedToObj( void Tcl_AppendToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ + register Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - int length) /* The number of bytes to append from "bytes". + register int length) /* The number of bytes to append from "bytes". * If < 0, then append all bytes up to NUL * byte. */ { @@ -1137,7 +1216,7 @@ Tcl_AppendToObj( void Tcl_AppendUnicodeToObj( - Tcl_Obj *objPtr, /* Points to the object to append to. */ + 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". */ @@ -1161,7 +1240,7 @@ Tcl_AppendUnicodeToObj( * objPtr's string rep. */ - if (stringPtr->hasUnicode) { + if (stringPtr->hasUnicode != 0) { AppendUnicodeToUnicodeRep(objPtr, unicode, length); } else { AppendUnicodeToUtfRep(objPtr, unicode, length); @@ -1182,8 +1261,6 @@ Tcl_AppendUnicodeToObj( * Side effects: * The string rep of appendObjPtr is appended to the string * representation of objPtr. - * IMPORTANT: This routine does not and MUST NOT shimmer appendObjPtr. - * Callers are counting on that. * *---------------------------------------------------------------------- */ @@ -1194,89 +1271,35 @@ Tcl_AppendObjToObj( Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - int length, numChars, appendNumChars = -1; - const char *bytes; - - /* - * Special case: second object is standard-empty is fast case. We know - * that appending nothing to anything leaves that starting anything... - */ - - if (appendObjPtr->bytes == &tclEmptyString) { - return; - } - - /* - * Handle append of one bytearray object to another as a special case. - * Note that we only do this when the objects don't have string reps; if - * it did, then appending the byte arrays together could well lose - * information; this is a special-case optimization only. - */ - - if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) - && TclIsPureByteArray(appendObjPtr)) { - - /* - * You might expect the code here to be - * - * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); - * TclAppendBytesToByteArray(objPtr, bytes, length); - * - * and essentially all of the time that would be fine. However, - * it would run into trouble in the case where objPtr and - * appendObjPtr point to the same thing. That may never be a - * good idea. It seems to violate Copy On Write, and we don't - * have any tests for the situation, since making any Tcl commands - * that call Tcl_AppendObjToObj() do that appears impossible - * (They honor Copy On Write!). For the sake of extensions that - * go off into that realm, though, here's a more complex approach - * that can handle all the cases. - */ - - /* Get lengths */ - int lengthSrc; - - (void) Tcl_GetByteArrayFromObj(objPtr, &length); - (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); - - /* Grow buffer enough for the append */ - TclAppendBytesToByteArray(objPtr, NULL, lengthSrc); - - /* Reset objPtr back to the original value */ - Tcl_SetByteArrayLength(objPtr, length); - - /* - * Now do the append knowing that buffer growth cannot cause - * any trouble. - */ - - TclAppendBytesToByteArray(objPtr, - Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc); - return; - } - - /* - * Must append as strings. - */ + int length, numChars, allOneByteChars; + char *bytes; SetStringFromAny(NULL, objPtr); - stringPtr = GET_STRING(objPtr); /* * If objPtr has a valid Unicode rep, then get a Unicode string from * appendObjPtr and append it. */ - if (stringPtr->hasUnicode) { + stringPtr = GET_STRING(objPtr); + if (stringPtr->hasUnicode != 0) { /* * If appendObjPtr is not of the "String" type, don't convert it. */ if (appendObjPtr->typePtr == &tclStringType) { - Tcl_UniChar *unicode = - Tcl_GetUnicodeFromObj(appendObjPtr, &numChars); + 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. + */ - AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); + FillUnicodeRep(appendObjPtr); + stringPtr = GET_STRING(appendObjPtr); + } + AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode, + stringPtr->numChars); } else { bytes = TclGetStringFromObj(appendObjPtr, &length); AppendUtfToUnicodeRep(objPtr, bytes, length); @@ -1292,16 +1315,21 @@ Tcl_AppendObjToObj( bytes = TclGetStringFromObj(appendObjPtr, &length); + allOneByteChars = 0; numChars = stringPtr->numChars; if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) { - String *appendStringPtr = GET_STRING(appendObjPtr); - appendNumChars = appendStringPtr->numChars; + stringPtr = GET_STRING(appendObjPtr); + if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) { + numChars += stringPtr->numChars; + allOneByteChars = 1; + } } AppendUtfToUtfRep(objPtr, bytes, length); - if (numChars >= 0 && appendNumChars >= 0) { - stringPtr->numChars = numChars + appendNumChars; + if (allOneByteChars) { + stringPtr = GET_STRING(objPtr); + stringPtr->numChars = numChars; } } @@ -1352,27 +1380,23 @@ AppendUnicodeToUnicodeRep( numChars = stringPtr->numChars + appendNumChars; stringCheckLimits(numChars); - if (numChars > stringPtr->maxChars) { - int offset = -1; - + 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. + * stringPtr->unicode array. Force it to follow any relocations + * due to the reallocs below. */ - + int offset = -1; if (unicode && unicode >= stringPtr->unicode - && unicode <= stringPtr->unicode + stringPtr->maxChars) { + && unicode <= stringPtr->unicode + + stringPtr->uallocated / sizeof(Tcl_UniChar)) { offset = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); - /* - * Relocate unicode if needed; see above. - */ - + /* Relocate unicode if needed; see above. */ if (offset >= 0) { unicode = stringPtr->unicode + offset; } @@ -1384,7 +1408,7 @@ AppendUnicodeToUnicodeRep( */ if (unicode) { - memmove(stringPtr->unicode + stringPtr->numChars, unicode, + memcpy(stringPtr->unicode + stringPtr->numChars, unicode, appendNumChars * sizeof(Tcl_UniChar)); } stringPtr->unicode[numChars] = 0; @@ -1417,13 +1441,20 @@ AppendUnicodeToUtfRep( const Tcl_UniChar *unicode, /* String to convert to UTF. */ int numChars) /* Number of chars of "unicode" to convert. */ { - String *stringPtr = GET_STRING(objPtr); - - numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars); + Tcl_DString dsPtr; + const char *bytes; - if (stringPtr->numChars != -1) { - stringPtr->numChars += numChars; + 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); } /* @@ -1433,7 +1464,7 @@ AppendUnicodeToUtfRep( * * 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. numBytes must be non-negative. + * valid Unicode rep. * * Results: * None. @@ -1450,16 +1481,25 @@ AppendUtfToUnicodeRep( const char *bytes, /* String to convert to Unicode. */ int numBytes) /* Number of bytes of "bytes" to convert. */ { - String *stringPtr; + Tcl_DString dsPtr; + int numChars = numBytes; + Tcl_UniChar *unicode = NULL; + if (numBytes < 0) { + numBytes = (bytes ? strlen(bytes) : 0); + } if (numBytes == 0) { return; } - ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1); - TclInvalidateStringRep(objPtr); - stringPtr = GET_STRING(objPtr); - stringPtr->allocated = 0; + Tcl_DStringInit(&dsPtr); + if (bytes) { + numChars = Tcl_NumUtfChars(bytes, numBytes); + unicode = (Tcl_UniChar *) Tcl_UtfToUniCharDString(bytes, numBytes, + &dsPtr); + } + AppendUnicodeToUnicodeRep(objPtr, unicode, numChars); + Tcl_DStringFree(&dsPtr); } /* @@ -1469,7 +1509,6 @@ AppendUtfToUnicodeRep( * * This function appends "numBytes" bytes of "bytes" to the UTF string * rep of "objPtr". objPtr must already have a valid String rep. - * numBytes must be non-negative. * * Results: * None. @@ -1489,6 +1528,9 @@ AppendUtfToUtfRep( String *stringPtr; int newLength, oldLength; + if (numBytes < 0) { + numBytes = (bytes ? strlen(bytes) : 0); + } if (numBytes == 0) { return; } @@ -1498,9 +1540,6 @@ AppendUtfToUtfRep( * trailing null. */ - if (objPtr->bytes == NULL) { - objPtr->length = 0; - } oldLength = objPtr->length; newLength = numBytes + oldLength; if (newLength < 0) { @@ -1508,32 +1547,40 @@ AppendUtfToUtfRep( } stringPtr = GET_STRING(objPtr); - if (newLength > stringPtr->allocated) { - int offset = -1; - + 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. + * stringPtr->unicode array. Force it to follow any relocations + * due to the reallocs below. */ - + int offset = -1; if (bytes && bytes >= objPtr->bytes && bytes <= objPtr->bytes + objPtr->length) { offset = bytes - objPtr->bytes; } /* - * TODO: consider passing flag=1: no overalloc on first append. This - * would make test stringObj-8.1 fail. + * 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. */ - GrowStringBuffer(objPtr, newLength, 0); + 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); - /* - * Relocate bytes if needed; see above. - */ + Tcl_SetObjLength(objPtr, newLength + growth); + } - if (offset >= 0) { + /* Relocate bytes if needed; see above. */ + if (offset >=0) { bytes = objPtr->bytes + offset; } } @@ -1546,7 +1593,7 @@ AppendUtfToUtfRep( stringPtr->hasUnicode = 0; if (bytes) { - memmove(objPtr->bytes + oldLength, bytes, numBytes); + memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes); } objPtr->bytes[newLength] = 0; objPtr->length = newLength; @@ -1575,18 +1622,130 @@ 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) { - const char *bytes = va_arg(argList, char *); + 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. + */ - if (bytes == NULL) { + dst = objPtr->bytes + oldLength; + for (i = 0; i < nargs; ++i) { + string = args[i]; + if (string == NULL) { break; } - Tcl_AppendToObj(objPtr, bytes, -1); + 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 } /* @@ -1647,12 +1806,12 @@ Tcl_AppendFormatToObj( int objc, Tcl_Obj *const objv[]) { - const char *span = format, *msg, *errCode; + 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 *const badIndex[2] = { + static const char *badIndex[2] = { "not enough arguments for all format specifiers", "\"%n$\" argument index out of range" }; @@ -1685,7 +1844,6 @@ Tcl_AppendFormatToObj( if (numBytes) { if (numBytes > limit) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(appendObj, span, numBytes); @@ -1714,7 +1872,6 @@ Tcl_AppendFormatToObj( newXpg = 0; if (isdigit(UCHAR(ch))) { int position = strtoul(format, &end, 10); - if (*end == '$') { newXpg = 1; objIndex = position - 1; @@ -1725,21 +1882,18 @@ Tcl_AppendFormatToObj( if (newXpg) { if (gotSequential) { msg = mixedXPG; - errCode = "MIXEDSPECTYPES"; goto errorMsg; } gotXpg = 1; } else { if (gotXpg) { msg = mixedXPG; - errCode = "MIXEDSPECTYPES"; goto errorMsg; } gotSequential = 1; } if ((objIndex < 0) || (objIndex >= objc)) { msg = badIndex[gotXpg]; - errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } @@ -1787,7 +1941,6 @@ Tcl_AppendFormatToObj( } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; - errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { @@ -1803,7 +1956,6 @@ Tcl_AppendFormatToObj( } if (width > limit) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } @@ -1824,7 +1976,6 @@ Tcl_AppendFormatToObj( } else if (ch == '*') { if (objIndex >= objc - 1) { msg = badIndex[gotXpg]; - errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } if (TclGetIntFromObj(interp, objv[objIndex], &precision) @@ -1860,19 +2011,11 @@ Tcl_AppendFormatToObj( useBig = 1; format += step; step = Tcl_UtfToUniChar(format, &ch); -#ifndef TCL_WIDE_INT_IS_LONG } else { +#ifndef TCL_WIDE_INT_IS_LONG useWide = 1; #endif } - } else if ((ch == 'I') && (format[1] == '6') && (format[2] == '4')) { - format += (step + 2); - step = Tcl_UtfToUniChar(format, &ch); - useBig = 1; - } else if (ch == 'L') { - format += step; - step = Tcl_UtfToUniChar(format, &ch); - useBig = 1; } format += step; @@ -1890,7 +2033,6 @@ Tcl_AppendFormatToObj( switch (ch) { case '\0': msg = "format string ended in middle of field specifier"; - errCode = "INCOMPLETE"; goto errorMsg; case 's': if (gotPrecision) { @@ -1920,15 +2062,13 @@ Tcl_AppendFormatToObj( case 'u': if (useBig) { msg = "unsigned bignum format is invalid"; - errCode = "BADUNSIGNED"; goto errorMsg; } case 'd': case 'o': case 'x': - case 'X': - case 'b': { - short s = 0; /* Silence compiler warning; only defined and + case 'X': { + short int s = 0; /* Silence compiler warning; only defined and * used when useShort is true. */ long l; Tcl_WideInt w; @@ -1953,7 +2093,7 @@ Tcl_AppendFormatToObj( Tcl_GetWideIntFromObj(NULL, objPtr, &w); Tcl_DecrRefCount(objPtr); } - isNegative = (w < (Tcl_WideInt) 0); + isNegative = (w < (Tcl_WideInt)0); } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) { Tcl_Obj *objPtr; @@ -1970,16 +2110,16 @@ Tcl_AppendFormatToObj( l = Tcl_WideAsLong(w); } if (useShort) { - s = (short) l; - isNegative = (s < (short) 0); + s = (short int) l; + isNegative = (s < (short int)0); } else { - isNegative = (l < (long) 0); + isNegative = (l < (long)0); } } else if (useShort) { - s = (short) l; - isNegative = (s < (short) 0); + s = (short int) l; + isNegative = (s < (short int)0); } else { - isNegative = (l < (long) 0); + isNegative = (l < (long)0); } segment = Tcl_NewObj(); @@ -1987,9 +2127,8 @@ Tcl_AppendFormatToObj( segmentLimit = INT_MAX; Tcl_IncrRefCount(segment); - if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) { - Tcl_AppendToObj(segment, - (isNegative ? "-" : gotPlus ? "+" : " "), 1); + if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) { + Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1); segmentLimit -= 1; } @@ -2005,10 +2144,6 @@ Tcl_AppendFormatToObj( Tcl_AppendToObj(segment, "0x", 2); segmentLimit -= 2; break; - case 'b': - Tcl_AppendToObj(segment, "0b", 2); - segmentLimit -= 2; - break; } } @@ -2019,7 +2154,7 @@ Tcl_AppendFormatToObj( const char *bytes; if (useShort) { - pure = Tcl_NewIntObj((int) s); + pure = Tcl_NewIntObj((int)(s)); } else if (useWide) { pure = Tcl_NewWideIntObj(w); } else if (useBig) { @@ -2048,7 +2183,7 @@ Tcl_AppendFormatToObj( if (gotPrecision) { if (length < precision) { - segmentLimit -= precision - length; + segmentLimit -= (precision - length); } while (length < precision) { Tcl_AppendToObj(segment, "0", 1); @@ -2059,7 +2194,7 @@ Tcl_AppendFormatToObj( if (gotZero) { length += Tcl_GetCharLength(segment); if (length < width) { - segmentLimit -= width - length; + segmentLimit -= (width - length); } while (length < width) { Tcl_AppendToObj(segment, "0", 1); @@ -2068,7 +2203,6 @@ Tcl_AppendFormatToObj( } if (toAppend > segmentLimit) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(segment, bytes, toAppend); @@ -2079,25 +2213,23 @@ Tcl_AppendFormatToObj( case 'u': case 'o': case 'x': - case 'X': - case 'b': { - Tcl_WideUInt bits = (Tcl_WideUInt) 0; - Tcl_WideInt numDigits = (Tcl_WideInt) 0; - int length, numBits = 4, base = 16, index = 0, shift = 0; + 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; - } else if (ch == 'o') { + } + if (ch == 'o') { base = 8; numBits = 3; - } else if (ch == 'b') { - base = 2; - numBits = 1; } if (useShort) { - unsigned short us = (unsigned short) s; + unsigned short int us = (unsigned short int) s; bits = (Tcl_WideUInt) us; while (us) { @@ -2117,18 +2249,17 @@ Tcl_AppendFormatToObj( mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover); numDigits = 1 + - (((Tcl_WideInt) big.used * DIGIT_BIT) / numBits); + (((Tcl_WideInt)big.used * DIGIT_BIT) / numBits); while ((mask & big.dp[big.used-1]) == 0) { numDigits--; mask >>= numBits; } if (numDigits > INT_MAX) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } } else if (!useBig) { - unsigned long ul = (unsigned long) l; + unsigned long int ul = (unsigned long int) l; bits = (Tcl_WideUInt) ul; while (ul) { @@ -2145,16 +2276,16 @@ Tcl_AppendFormatToObj( numDigits = 1; } pure = Tcl_NewObj(); - Tcl_SetObjLength(pure, (int) numDigits); + Tcl_SetObjLength(pure, (int)numDigits); bytes = TclGetString(pure); - toAppend = length = (int) numDigits; + 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; + bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift); shift += DIGIT_BIT; } shift -= numBits; @@ -2172,7 +2303,7 @@ Tcl_AppendFormatToObj( } if (gotPrecision) { if (length < precision) { - segmentLimit -= precision - length; + segmentLimit -= (precision - length); } while (length < precision) { Tcl_AppendToObj(segment, "0", 1); @@ -2183,7 +2314,7 @@ Tcl_AppendFormatToObj( if (gotZero) { length += Tcl_GetCharLength(segment); if (length < width) { - segmentLimit -= width - length; + segmentLimit -= (width - length); } while (length < width) { Tcl_AppendToObj(segment, "0", 1); @@ -2192,7 +2323,6 @@ Tcl_AppendFormatToObj( } if (toAppend > segmentLimit) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendObjToObj(segment, pure); @@ -2245,8 +2375,7 @@ Tcl_AppendFormatToObj( *p++ = '.'; p += sprintf(p, "%d", precision); if (precision > INT_MAX - length) { - msg = overflow; - errCode = "OVERFLOW"; + msg=overflow; goto errorMsg; } length += precision; @@ -2263,13 +2392,11 @@ Tcl_AppendFormatToObj( allocSegment = 1; if (!Tcl_AttemptSetObjLength(segment, length)) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } bytes = TclGetString(segment); if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } break; @@ -2278,7 +2405,6 @@ Tcl_AppendFormatToObj( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad field specifier \"%c\"", ch)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); } goto error; } @@ -2291,26 +2417,27 @@ Tcl_AppendFormatToObj( } } - if (width>0 && numChars<0) { - numChars = Tcl_GetCharLength(segment); - } - if (!gotMinus && width>0) { - if (numChars < width) { - limit -= width - numChars; + if (width > 0) { + if (numChars < 0) { + numChars = Tcl_GetCharLength(segment); } - while (numChars < width) { - Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); - numChars++; + if (!gotMinus) { + if (numChars < width) { + limit -= (width - numChars); + } + while (numChars < width) { + Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); + numChars++; + } } } - TclGetStringFromObj(segment, &segmentNumBytes); + Tcl_GetStringFromObj(segment, &segmentNumBytes); if (segmentNumBytes > limit) { if (allocSegment) { Tcl_DecrRefCount(segment); } msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendObjToObj(appendObj, segment); @@ -2320,7 +2447,7 @@ Tcl_AppendFormatToObj( } if (width > 0) { if (numChars < width) { - limit -= width-numChars; + limit -= (width - numChars); } while (numChars < width) { Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1); @@ -2333,7 +2460,6 @@ Tcl_AppendFormatToObj( if (numBytes) { if (numBytes > limit) { msg = overflow; - errCode = "OVERFLOW"; goto errorMsg; } Tcl_AppendToObj(appendObj, span, numBytes); @@ -2346,7 +2472,6 @@ Tcl_AppendFormatToObj( errorMsg: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL); } error: Tcl_SetObjLength(appendObj, originalLength); @@ -2362,7 +2487,7 @@ Tcl_AppendFormatToObj( * A refcount zero Tcl_Obj. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -2376,7 +2501,6 @@ Tcl_Format( { int result; Tcl_Obj *objPtr = Tcl_NewObj(); - result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv); if (result != TCL_OK) { Tcl_DecrRefCount(objPtr); @@ -2406,6 +2530,7 @@ AppendPrintfToObjVA( int code, objc; Tcl_Obj **objv, *list = Tcl_NewObj(); const char *p; + char *end; p = format; Tcl_IncrRefCount(list); @@ -2422,6 +2547,7 @@ AppendPrintfToObjVA( } do { switch (*p) { + case '\0': seekingConversion = 0; break; @@ -2474,15 +2600,11 @@ AppendPrintfToObjVA( case -1: case 0: Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( - (long) va_arg(argList, int))); + (long int)va_arg(argList, int))); break; case 1: Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( - va_arg(argList, long))); - break; - case 2: - Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( - va_arg(argList, Tcl_WideInt))); + va_arg(argList, long int))); break; } break; @@ -2496,36 +2618,22 @@ AppendPrintfToObjVA( seekingConversion = 0; break; case '*': - lastNum = (int) va_arg(argList, int); + 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': { - char *end; - + 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 bignum arguments */ + /* TODO: support for wide (and bignum?) arguments */ case 'l': - ++size; - p++; - break; - case 'L': - size = 2; - p++; - break; - case 'I': - if (p[1]=='6' && p[2]=='4') { - p += 2; - size = 2; - } + size = 1; p++; break; case 'h': @@ -2554,7 +2662,7 @@ AppendPrintfToObjVA( * A standard Tcl result. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -2581,7 +2689,7 @@ Tcl_AppendPrintfToObj( * A refcount zero Tcl_Obj. * * Side effects: - * None. + * None. * *--------------------------------------------------------------------------- */ @@ -2632,616 +2740,6 @@ TclGetStringStorage( *sizePtr = stringPtr->allocated; return objPtr->bytes; } - -/* - *--------------------------------------------------------------------------- - * - * TclStringRepeat -- - * - * Performs the [string repeat] function. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation - * of count copies of the value in objPtr. - * - *--------------------------------------------------------------------------- - */ - -int -TclStringRepeat( - Tcl_Interp *interp, - Tcl_Obj *objPtr, - int count, - Tcl_Obj **objPtrPtr) -{ - Tcl_Obj *objResultPtr; - int length = 0, unichar = 0, done = 1; - int binary = TclIsPureByteArray(objPtr); - - /* assert (count >= 2) */ - - /* - * Analyze to determine what representation result should be. - * GOALS: Avoid shimmering & string rep generation. - * Produce pure bytearray when possible. - * Error on overflow. - */ - - if (!binary) { - if (objPtr->typePtr == &tclStringType) { - String *stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode) { - unichar = 1; - } - } - } - - if (binary) { - /* Result will be pure byte array. Pre-size it */ - Tcl_GetByteArrayFromObj(objPtr, &length); - } else if (unichar) { - /* Result will be pure Tcl_UniChar array. Pre-size it. */ - Tcl_GetUnicodeFromObj(objPtr, &length); - } else { - /* Result will be concat of string reps. Pre-size it. */ - Tcl_GetStringFromObj(objPtr, &length); - } - - if (length == 0) { - /* Any repeats of empty is empty. */ - *objPtrPtr = objPtr; - return TCL_OK; - } - - if (count > INT_MAX/length) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - - if (binary) { - /* Efficiently produce a pure byte array result */ - objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr) - : objPtr; - - Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ - Tcl_SetByteArrayLength(objResultPtr, length); - while (count - done > done) { - Tcl_AppendObjToObj(objResultPtr, objResultPtr); - done *= 2; - } - TclAppendBytesToByteArray(objResultPtr, - Tcl_GetByteArrayFromObj(objResultPtr, NULL), - (count - done) * length); - } else if (unichar) { - /* Efficiently produce a pure Tcl_UniChar array result */ - if (Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length); - } else { - TclInvalidateStringRep(objPtr); - objResultPtr = objPtr; - } - - if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(count*length))); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - Tcl_SetObjLength(objResultPtr, length); - while (count - done > done) { - Tcl_AppendObjToObj(objResultPtr, objResultPtr); - done *= 2; - } - Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), - (count - done) * length); - } else { - /* Efficiently concatenate string reps */ - if (Tcl_IsShared(objPtr)) { - objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); - } else { - TclFreeIntRep(objPtr); - objResultPtr = objPtr; - } - if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %u bytes", - count*length)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - Tcl_SetObjLength(objResultPtr, length); - while (count - done > done) { - Tcl_AppendObjToObj(objResultPtr, objResultPtr); - done *= 2; - } - Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), - (count - done) * length); - } - *objPtrPtr = objResultPtr; - return TCL_OK; -} - -/* - *--------------------------------------------------------------------------- - * - * TclStringCatObjv -- - * - * Performs the [string cat] function. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation - * of all objc values in objv. - * - *--------------------------------------------------------------------------- - */ - -int -TclStringCatObjv( - Tcl_Interp *interp, - int inPlace, - int objc, - Tcl_Obj * const objv[], - Tcl_Obj **objPtrPtr) -{ - Tcl_Obj *objPtr, *objResultPtr, * const *ov; - int oc, length = 0, binary = 1, first = 0; - int allowUniChar = 1, requestUniChar = 0; - - /* assert (objc >= 2) */ - - /* - * Analyze to determine what representation result should be. - * GOALS: Avoid shimmering & string rep generation. - * Produce pure bytearray when possible. - * Error on overflow. - */ - - ov = objv, oc = objc; - while (oc-- && (binary || allowUniChar)) { - objPtr = *ov++; - - if (objPtr->bytes) { - /* Value has a string rep. */ - if (objPtr->length) { - /* - * Non-empty string rep. Not a pure bytearray, so we - * won't create a pure bytearray - */ - binary = 0; - if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) { - /* Prevent shimmer of non-string types. */ - allowUniChar = 0; - } - } - } else { - /* assert (objPtr->typePtr != NULL) -- stork! */ - if (TclIsPureByteArray(objPtr)) { - allowUniChar = 0; - } else { - binary = 0; - if (objPtr->typePtr == &tclStringType) { - /* Have a pure Unicode value; ask to preserve it */ - requestUniChar = 1; - } else { - /* Have another type; prevent shimmer */ - allowUniChar = 0; - } - } - } - } - - if (binary) { - /* Result will be pure byte array. Pre-size it */ - ov = objv; oc = objc; - while (oc-- && (length >= 0)) { - objPtr = *ov++; - - if (objPtr->bytes == NULL) { - int numBytes; - - Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ - if (length == 0) { - first = objc - oc - 1; - } - length += numBytes; - } - } - } else if (allowUniChar && requestUniChar) { - /* Result will be pure Tcl_UniChar array. Pre-size it. */ - ov = objv; oc = objc; - while (oc-- && (length >= 0)) { - objPtr = *ov++; - - if ((objPtr->bytes == NULL) || (objPtr->length)) { - int numChars; - - Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ - if (length == 0) { - first = objc - oc - 1; - } - length += numChars; - } - } - } else { - /* Result will be concat of string reps. Pre-size it. */ - ov = objv; oc = objc; - while (oc-- && (length >= 0)) { - int numBytes; - - objPtr = *ov++; - - Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ - if ((length == 0) && numBytes) { - first = objc - oc - 1; - } - length += numBytes; - } - } - - if (length < 0) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - - if (length == 0) { - /* Total length of zero means every value has length zero */ - *objPtrPtr = objv[0]; - return TCL_OK; - } - - objv += first; objc -= first; - - if (binary) { - /* Efficiently produce a pure byte array result */ - unsigned char *dst; - - /* - * Broken interface! Byte array value routines offer no way - * to handle failure to allocate enough space. Following - * stanza may panic. - */ - if (inPlace && !Tcl_IsShared(*objv)) { - int start; - - objResultPtr = *objv++; objc--; - Tcl_GetByteArrayFromObj(objResultPtr, &start); - dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; - } else { - objResultPtr = Tcl_NewByteArrayObj(NULL, length); - dst = Tcl_SetByteArrayLength(objResultPtr, length); - } - while (objc--) { - Tcl_Obj *objPtr = *objv++; - - if (objPtr->bytes == NULL) { - int more; - unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); - memcpy(dst, src, (size_t) more); - dst += more; - } - } - } else if (allowUniChar && requestUniChar) { - /* Efficiently produce a pure Tcl_UniChar array result */ - Tcl_UniChar *dst; - - if (inPlace && !Tcl_IsShared(*objv)) { - int start; - - objResultPtr = *objv++; objc--; - - /* Ugly interface! Force resize of the unicode array. */ - Tcl_GetUnicodeFromObj(objResultPtr, &start); - Tcl_InvalidateStringRep(objResultPtr); - if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(length))); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - dst = Tcl_GetUnicode(objResultPtr) + start; - } else { - Tcl_UniChar ch = 0; - - /* Ugly interface! No scheme to init array size. */ - objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */ - if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %" - TCL_LL_MODIFIER "u bytes", - (Tcl_WideUInt)STRING_SIZE(length))); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - dst = Tcl_GetUnicode(objResultPtr); - } - while (objc--) { - Tcl_Obj *objPtr = *objv++; - - if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); - memcpy(dst, src, more * sizeof(Tcl_UniChar)); - dst += more; - } - } - } else { - /* Efficiently concatenate string reps */ - char *dst; - - if (inPlace && !Tcl_IsShared(*objv)) { - int start; - - objResultPtr = *objv++; objc--; - - Tcl_GetStringFromObj(objResultPtr, &start); - if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", - length)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - dst = Tcl_GetString(objResultPtr) + start; - if (length > start) { - TclFreeIntRep(objResultPtr); - } - } else { - objResultPtr = Tcl_NewObj(); /* PANIC? */ - if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "concatenation failed: unable to alloc %u bytes", - length)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return TCL_ERROR; - } - dst = Tcl_GetString(objResultPtr); - } - while (objc--) { - Tcl_Obj *objPtr = *objv++; - - if ((objPtr->bytes == NULL) || (objPtr->length)) { - int more; - char *src = Tcl_GetStringFromObj(objPtr, &more); - memcpy(dst, src, (size_t) more); - dst += more; - } - } - } - *objPtrPtr = objResultPtr; - return TCL_OK; -} - -/* - *--------------------------------------------------------------------------- - * - * TclStringFind -- - * - * Implements the [string first] operation. - * - * Results: - * If needle is found as a substring of haystack, the index of the - * first instance of such a find is returned. If needle is not present - * as a substring of haystack, -1 is returned. - * - * Side effects: - * needle and haystack may have their Tcl_ObjType changed. - * - *--------------------------------------------------------------------------- - */ - -int -TclStringFind( - Tcl_Obj *needle, - Tcl_Obj *haystack, - int start) -{ - int lh, ln = Tcl_GetCharLength(needle); - - if (ln == 0) { - /* - * We don't find empty substrings. Bizarre! - * - * TODO: When we one day make this a true substring - * finder, change this to "return 0" - */ - return -1; - } - - if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *end, *try, *bh; - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); - - bh = Tcl_GetByteArrayFromObj(haystack, &lh); - end = bh + lh; - - try = bh + start; - while (try + ln <= end) { - try = memchr(try, bn[0], end - try); - - if (try == NULL) { - return -1; - } - if (0 == memcmp(try+1, bn+1, ln-1)) { - return (try - bh); - } - try++; - } - return -1; - } - - lh = Tcl_GetCharLength(haystack); - if (haystack->bytes && (lh == haystack->length)) { - /* haystack is all single-byte chars */ - - if (needle->bytes && (ln == needle->length)) { - /* needle is also all single-byte chars */ - char *found = strstr(haystack->bytes + start, needle->bytes); - - if (found) { - return (found - haystack->bytes); - } else { - return -1; - } - } else { - /* - * Cannot find substring with a multi-byte char inside - * a string with no multi-byte chars. - */ - return -1; - } - } else { - Tcl_UniChar *try, *end, *uh; - Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); - - uh = Tcl_GetUnicodeFromObj(haystack, &lh); - end = uh + lh; - - try = uh + start; - while (try + ln <= end) { - if ((*try == *un) - && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { - return (try - uh); - } - try++; - } - return -1; - } -} - -/* - *--------------------------------------------------------------------------- - * - * TclStringLast -- - * - * Implements the [string last] operation. - * - * Results: - * If needle is found as a substring of haystack, the index of the - * last instance of such a find is returned. If needle is not present - * as a substring of haystack, -1 is returned. - * - * Side effects: - * needle and haystack may have their Tcl_ObjType changed. - * - *--------------------------------------------------------------------------- - */ - -int -TclStringLast( - Tcl_Obj *needle, - Tcl_Obj *haystack, - int last) -{ - int lh, ln = Tcl_GetCharLength(needle); - - if (ln == 0) { - /* - * We don't find empty substrings. Bizarre! - * - * TODO: When we one day make this a true substring - * finder, change this to "return 0" - */ - return -1; - } - - if (ln > last + 1) { - return -1; - } - - if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) { - unsigned char *try, *bh; - unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); - - bh = Tcl_GetByteArrayFromObj(haystack, &lh); - - if (last + 1 > lh) { - last = lh - 1; - } - try = bh + last + 1 - ln; - while (try >= bh) { - if ((*try == bn[0]) - && (0 == memcmp(try+1, bn+1, ln-1))) { - return (try - bh); - } - try--; - } - return -1; - } - - lh = Tcl_GetCharLength(haystack); - if (last + 1 > lh) { - last = lh - 1; - } - if (haystack->bytes && (lh == haystack->length)) { - /* haystack is all single-byte chars */ - - if (needle->bytes && (ln == needle->length)) { - /* needle is also all single-byte chars */ - - char *try = haystack->bytes + last + 1 - ln; - while (try >= haystack->bytes) { - if ((*try == needle->bytes[0]) - && (0 == memcmp(try+1, needle->bytes + 1, ln - 1))) { - return (try - haystack->bytes); - } - try--; - } - return -1; - } else { - /* - * Cannot find substring with a multi-byte char inside - * a string with no multi-byte chars. - */ - return -1; - } - } else { - Tcl_UniChar *try, *uh; - Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln); - - uh = Tcl_GetUnicodeFromObj(haystack, &lh); - - try = uh + last + 1 - ln; - while (try >= uh) { - if ((*try == un[0]) - && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) { - return (try - uh); - } - try--; - } - return -1; - } -} - /* *--------------------------------------------------------------------------- * @@ -3251,8 +2749,8 @@ TclStringLast( * * 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. + * 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. @@ -3260,124 +2758,68 @@ TclStringLast( *--------------------------------------------------------------------------- */ -static void -ReverseBytes( - unsigned char *to, /* Copy bytes into here... */ - unsigned char *from, /* ...from here... */ - int count) /* Until this many are copied, */ - /* reversing as you go. */ -{ - unsigned char *src = from + count; - if (to == from) { - /* Reversing in place */ - while (--src > to) { - unsigned char c = *src; - *src = *to; - *to++ = c; - } - } else { - while (--src >= from) { - *to++ = *src; - } - } -} - Tcl_Obj * TclStringObjReverse( Tcl_Obj *objPtr) { String *stringPtr; - Tcl_UniChar ch; + int numChars = Tcl_GetCharLength(objPtr); + int i = 0, lastCharIdx = numChars - 1; + char *bytes; - if (TclIsPureByteArray(objPtr)) { - int numBytes; - unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_NewByteArrayObj(NULL, numBytes); - } - ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes); + if (numChars <= 1) { return objPtr; } - SetStringFromAny(NULL, objPtr); stringPtr = GET_STRING(objPtr); - if (stringPtr->hasUnicode) { - Tcl_UniChar *from = Tcl_GetUnicode(objPtr); - Tcl_UniChar *src = from + stringPtr->numChars; + Tcl_UniChar *source = stringPtr->unicode; if (Tcl_IsShared(objPtr)) { - Tcl_UniChar *to; + Tcl_UniChar *dest, ch = 0; /* * Create a non-empty, pure unicode value, so we can coax * Tcl_SetObjLength into growing the unicode rep buffer. */ - ch = 0; - objPtr = Tcl_NewUnicodeObj(&ch, 1); - Tcl_SetObjLength(objPtr, stringPtr->numChars); - to = Tcl_GetUnicode(objPtr); - while (--src >= from) { - *to++ = *src; - } - } else { - /* Reversing in place */ - while (--src > from) { - ch = *src; - *src = *from; - *from++ = ch; + Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1); + Tcl_SetObjLength(resultPtr, numChars); + dest = Tcl_GetUnicode(resultPtr); + + while (i < numChars) { + dest[i++] = source[lastCharIdx--]; } + return resultPtr; } - } - if (objPtr->bytes) { - int numChars = stringPtr->numChars; - int numBytes = objPtr->length; - char *to, *from = objPtr->bytes; - - if (Tcl_IsShared(objPtr)) { - objPtr = Tcl_NewObj(); - Tcl_SetObjLength(objPtr, numBytes); + while (i < lastCharIdx) { + Tcl_UniChar tmp = source[lastCharIdx]; + source[lastCharIdx--] = source[i]; + source[i++] = tmp; } - to = objPtr->bytes; - - if (numChars < numBytes) { - /* - * Either numChars == -1 and we don't know how many chars are - * represented by objPtr->bytes and we need Pass 1 just in case, - * or numChars >= 0 and we know we have fewer chars than bytes, - * so we know there's a multibyte character needing Pass 1. - * - * Pass 1. Reverse the bytes of each multi-byte character. - */ - int charCount = 0; - int bytesLeft = numBytes; - - while (bytesLeft) { - /* - * NOTE: We know that the from buffer is NUL-terminated. - * It's part of the contract for objPtr->bytes values. - * Thus, we can skip calling Tcl_UtfCharComplete() here. - */ - int bytesInChar = Tcl_UtfToUniChar(from, &ch); - - ReverseBytes((unsigned char *)to, (unsigned char *)from, - bytesInChar); - to += bytesInChar; - from += bytesInChar; - bytesLeft -= bytesInChar; - charCount++; - } + TclInvalidateStringRep(objPtr); + stringPtr->allocated = 0; + return objPtr; + } - from = to = objPtr->bytes; - stringPtr->numChars = charCount; + 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--]; } - /* Pass 2. Reverse all the bytes. */ - ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes); + return resultPtr; } + while (i < lastCharIdx) { + char tmp = bytes[lastCharIdx]; + bytes[lastCharIdx--] = bytes[i]; + bytes[i++] = tmp; + } return objPtr; } @@ -3403,47 +2845,35 @@ FillUnicodeRep( Tcl_Obj *objPtr) /* The object in which to fill the unicode * rep. */ { - String *stringPtr = GET_STRING(objPtr); - - ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length, - stringPtr->numChars); -} - -static void -ExtendUnicodeRepWithString( - Tcl_Obj *objPtr, - const char *bytes, - int numBytes, - int numAppendChars) -{ - String *stringPtr = GET_STRING(objPtr); - int needed, numOrigChars = 0; + String *stringPtr; + size_t uallocated; + char *srcEnd, *src = objPtr->bytes; Tcl_UniChar *dst; - if (stringPtr->hasUnicode) { - numOrigChars = stringPtr->numChars; - } - if (numAppendChars == -1) { - TclNumUtfChars(numAppendChars, bytes, numBytes); + stringPtr = GET_STRING(objPtr); + if (stringPtr->numChars == -1) { + stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length); } - needed = numOrigChars + numAppendChars; - stringCheckLimits(needed); + stringPtr->hasUnicode = (stringPtr->numChars > 0); - if (needed > stringPtr->maxChars) { - GrowUnicodeBuffer(objPtr, needed); + stringCheckLimits(stringPtr->numChars); + uallocated = STRING_UALLOC(stringPtr->numChars); + if (uallocated > stringPtr->uallocated) { + GrowUnicodeBuffer(objPtr, stringPtr->numChars); stringPtr = GET_STRING(objPtr); } - stringPtr->hasUnicode = 1; - if (bytes) { - stringPtr->numChars = needed; - } else { - numAppendChars = 0; - } - for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) { - bytes += TclUtfToUniChar(bytes, dst); + /* + * 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); } /* @@ -3466,48 +2896,36 @@ ExtendUnicodeRepWithString( static void DupStringInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have + register Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have * an internal rep of type "String". */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not + 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 (srcStringPtr->numChars == -1) { - /* - * The String struct in the source value holds zero useful data. Don't - * bother copying it. Don't even bother allocating space in which to - * copy it. Just let the copy be untyped. - */ - - return; - } + /* + * 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) { - int copyMaxChars; + if (srcStringPtr->hasUnicode == 0) { + copyStringPtr = (String *) ckalloc(sizeof(String)); + copyStringPtr->uallocated = 0; + } else { + copyStringPtr = (String *) ckalloc( + STRING_SIZE(srcStringPtr->uallocated)); + copyStringPtr->uallocated = srcStringPtr->uallocated; - if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) { - copyMaxChars = 2 * srcStringPtr->numChars; - } else { - copyMaxChars = srcStringPtr->maxChars; - } - copyStringPtr = stringAttemptAlloc(copyMaxChars); - if (copyStringPtr == NULL) { - copyMaxChars = srcStringPtr->numChars; - copyStringPtr = stringAlloc(copyMaxChars); - } - copyStringPtr->maxChars = copyMaxChars; memcpy(copyStringPtr->unicode, srcStringPtr->unicode, - srcStringPtr->numChars * sizeof(Tcl_UniChar)); + (size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar)); copyStringPtr->unicode[srcStringPtr->numChars] = 0; - } else { - copyStringPtr = stringAlloc(0); - copyStringPtr->maxChars = 0; - copyStringPtr->unicode[0] = 0; } - copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; copyStringPtr->numChars = srcStringPtr->numChars; + copyStringPtr->hasUnicode = srcStringPtr->hasUnicode; + copyStringPtr->allocated = srcStringPtr->allocated; /* * Tricky point: the string value was copied by generic object management @@ -3515,7 +2933,7 @@ DupStringInternalRep( * source object. */ - copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; + copyStringPtr->allocated = copyPtr->length; SET_STRING(copyPtr, copyStringPtr); copyPtr->typePtr = &tclStringType; @@ -3541,29 +2959,43 @@ DupStringInternalRep( static int SetStringFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + register Tcl_Obj *objPtr) /* The object to convert. */ { - if (objPtr->typePtr != &tclStringType) { - String *stringPtr = stringAlloc(0); + /* + * 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. + */ - /* - * Convert whatever we have into an untyped value. Just A String. - */ + if (objPtr->typePtr != &tclStringType) { + String *stringPtr; - (void) TclGetString(objPtr); - TclFreeIntRep(objPtr); + if (objPtr->typePtr != NULL) { + if (objPtr->bytes == NULL) { + objPtr->typePtr->updateStringProc(objPtr); + } + TclFreeIntRep(objPtr); + } + objPtr->typePtr = &tclStringType; /* - * Create a basic String intrep that just points to the UTF-8 string - * already in place at objPtr->bytes. + * Allocate enough space for the basic String structure. */ + stringPtr = (String *) ckalloc(sizeof(String)); stringPtr->numChars = -1; - stringPtr->allocated = objPtr->length; - stringPtr->maxChars = 0; + 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); - objPtr->typePtr = &tclStringType; } return TCL_OK; } @@ -3590,85 +3022,57 @@ static void UpdateStringOfString( Tcl_Obj *objPtr) /* Object with string rep to update. */ { - String *stringPtr = GET_STRING(objPtr); - - /* - * This routine is only called when we need to generate the - * string rep objPtr->bytes because it does not exist -- it is NULL. - * In that circumstance, any lingering claim about the size of - * memory pointed to by that NULL pointer is clearly bogus, and - * needs a reset. - */ - - stringPtr->allocated = 0; - - if (stringPtr->numChars == 0) { - TclInitStringRep(objPtr, &tclEmptyString, 0); - } else { - (void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode, - stringPtr->numChars); - } -} - -static int -ExtendStringRepWithUnicode( - Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, - int numChars) -{ - /* - * Pre-condition: this is the "string" Tcl_ObjType. - */ - - int i, origLength, size = 0; + int i, size; + Tcl_UniChar *unicode; + char dummy[TCL_UTF_MAX]; char *dst; - String *stringPtr = GET_STRING(objPtr); - - if (numChars < 0) { - numChars = UnicodeLength(unicode); - } + String *stringPtr; - if (numChars == 0) { - return 0; - } + 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. + */ - if (objPtr->bytes == NULL) { - objPtr->length = 0; - } - size = origLength = objPtr->length; + objPtr->bytes = tclEmptyStringRep; + objPtr->length = 0; + return; + } - /* - * Quick cheap check in case we have more than enough room. - */ + unicode = stringPtr->unicode; - if (numChars <= (INT_MAX - size)/TCL_UTF_MAX - && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) { - goto copyBytes; - } + /* + * Translate the Unicode string to UTF. "size" will hold the amount of + * space the UTF string needs. + */ - for (i = 0; i < numChars && size >= 0; i++) { - size += TclUtfCount(unicode[i]); - } - if (size < 0) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); - } + if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX + && stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) { + goto copyBytes; + } - /* - * Grow space if needed. - */ + 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); + } - if (size > stringPtr->allocated) { - GrowStringBuffer(objPtr, size, 1); - } + objPtr->bytes = (char *) ckalloc((unsigned) (size + 1)); + objPtr->length = size; + stringPtr->allocated = size; - copyBytes: - dst = objPtr->bytes + origLength; - for (i = 0; i < numChars; i++) { - dst += Tcl_UniCharToUtf((int) unicode[i], dst); + copyBytes: + dst = objPtr->bytes; + for (i = 0; i < stringPtr->numChars; i++) { + dst += Tcl_UniCharToUtf(unicode[i], dst); + } + *dst = '\0'; } - *dst = '\0'; - objPtr->length = dst - objPtr->bytes; - return numChars; + return; } /* @@ -3692,7 +3096,7 @@ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - ckfree(GET_STRING(objPtr)); + ckfree((char *) GET_STRING(objPtr)); objPtr->typePtr = NULL; } |