Tcl Source Code

#define BINARY_SCAN_MAX_CACHE	260

/*
 * Prototypes for local procedures defined in this file:
 */



static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);

static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
			    int *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);



static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(const void *from, void *to,
			    unsigned length, int type);
/* Binary ensemble commands */
static int		BinaryFormatCmd(ClientData clientData,
			    Tcl_Interp *interp,

 *
 * Converting a String to a ByteArray proceeds by getting the Unicode
 * representation of each character in the String, casting it to a byte by
 * truncating the upper 8 bits, and then storing the byte in the ByteArray.
 * Converting from ByteArray to String and back to ByteArray is not lossy, but
 * converting an arbitrary String to a ByteArray may be.
 */







































































































































































































































































































































































































































/*
 *----------------------------------------------------------------------
 *
 * TclAppendBytesToByteArray --
 *
 *	This function appends an array of bytes to a byte array object. Note

		    if (src[size-1] != '\0' && src[size-1] != ' ') {
			break;
		    }
		    size--;
		}
	    }











	    valuePtr = Tcl_NewByteArrayObj(src, size);


	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    arg++;
	    if (resultPtr == NULL) {
		DeleteScanNumberCache(numberCachePtr);
		return TCL_ERROR;
	    }

	}
	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
		O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_LEN:
	valuePtr = OBJ_AT_TOS;

	length = Tcl_GetCharLength(valuePtr);

	TclNewIntObj(objResultPtr, length);
	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
	NEXT_INST_F(1, 1, 1);

    case INST_STR_INDEX:
	value2Ptr = OBJ_AT_TOS;
	valuePtr = OBJ_UNDER_TOS;

	/*
	 * Get Unicode char length to calulate what 'end' means.
	 */

	length = Tcl_GetCharLength(valuePtr);

	result = TclGetIntForIndexM(interp, value2Ptr, length - 1, &index);
	if (result != TCL_OK) {
	    goto checkForCatch;
	}

	if ((index >= 0) && (index < length)) {


	    objResultPtr = Tcl_GetRange(valuePtr, index, index);




	} else {










	    TclNewObj(objResultPtr);
	}

	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
		O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_MATCH:

    factor = UTF_EXPANSION_FACTOR;

    if (appendFlag == 0) {
	if (encoding == NULL) {
	    Tcl_SetByteArrayLength(objPtr, 0);
	} else {
	    Tcl_SetObjLength(objPtr, 0);








	}
	offset = 0;
    } else {
	if (encoding == NULL) {
	    Tcl_GetByteArrayFromObj(objPtr, &offset);
	} else {
	    TclGetStringFromObj(objPtr, &offset);

MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    mp_int *bignumValue);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE Tcl_UniChar * TclSetUnicodeLength(Tcl_Obj *objPtr, int length);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCompare(Tcl_Obj *obj1Ptr, Tcl_Obj *obj2Ptr,
			    int reqlength, int nocase, int equal);
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    int numBytes, int flags, int line,

			    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 int		SetByteArrayFromAny(Tcl_Interp *interp,




			    Tcl_Obj *objPtr);



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.
 */

const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny		/* setFromAnyProc */
};

/*
 * Keep the old bytearray type for backward compatibility with code
 * that uses it to distinguish binary data.
 */

const Tcl_ObjType tclByteArrayType = {
    "bytearray",
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetByteArrayFromAny		/* setFromAnyProc */
};

/*
 * To know what shortcuts can be taken with an object, it is important
 * to know if all characters are within certain ranges.
 * This enum defines the ranges used.
 */

typedef enum {
    Range_Ascii,  /* Characters within range 1-127   */
    Range_Byte,	  /* Characters within range 0-255   */
    Range_Unicode /* Characters within range 0-65535 */
} CharacterRange;

/*
 * An object can hold up to one fixed width storage of the string.
 * This enum defines which is currently present.
 */

typedef enum {
    Storage_None, Storage_Byte, Storage_Unicode
} StorageType;

/*
 * 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, and that


				 * the range field is invalid. */
    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 fixed width string (minus 2 bytes for
				 * the termination char if it is Unicode). */
    CharacterRange range;	/* The range that all chars in the string are
				 * within. */
    StorageType storageType;	/* Determines if there is a fixed width 
				 * representation stored. */
    union {			/* The array of fixed-width chars. The      */
	unsigned char bytes[4]; /* actual size of this field depends on the */
	Tcl_UniChar unicode[2]; /* 'uallocated' field above.		    */
    } data;
} String;

/*
 * Assertions about String struct:
 *
 * numChars can only be -1 if objPtr->bytes is filled in
 * range can only be Range_Ascii if objPtr->bytes is filled in
 */

#define STRING_UALLOC(numChars)	\
	((numChars) * sizeof(Tcl_UniChar))
#define STRING_SIZE(numBytes)					\
	(sizeof(String) - sizeof(Tcl_UniChar) + (numBytes))
#define BYTEARRAY_UALLOC(numChars) ((numChars) > 4 ? (numChars) : 4)
#define BYTEARRAY_SIZE(ualloc) ((unsigned) (sizeof(String) - 4 + (ualloc)))
#define STRING_NOMEM(numBytes) \

	(Tcl_Panic("unable to alloc %u bytes", STRING_SIZE(numBytes)), \

	 (char *) NULL)
#define stringAlloc(numBytes) \
	(String *) (((numBytes) > INT_MAX - STRING_SIZE(0)) \
	    ? STRING_NOMEM(numBytes) \
	    : ckalloc((unsigned) STRING_SIZE( \
		(numBytes) ? (numBytes) : sizeof(Tcl_UniChar)) ))
#define stringRealloc(ptr, numBytes) \
	(String *) (((numBytes) > INT_MAX - STRING_SIZE(0)) \
	    ? STRING_NOMEM(numBytes) \
	    : ckrealloc((char *) ptr, (unsigned) STRING_SIZE( \
		(numBytes) ? (numBytes) : sizeof(Tcl_UniChar)) ))
#define stringAttemptRealloc(ptr, numBytes) \
	(String *) (((numBytes) > INT_MAX - STRING_SIZE(0)) \
	    ? NULL \
	    : attemptckrealloc((char *) ptr, (unsigned) STRING_SIZE( \
		(numBytes) ? (numBytes) : sizeof(Tcl_UniChar)) ))
#define GET_STRING(objPtr) \
	((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
	((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))

/*
 * TCL STRING GROWTH ALGORITHM

    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
 *	This procedure is creates a new ByteArray object and initializes it
 *	from the given array of bytes.
 *
 * Results:
 *	The newly create 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 byte array argument.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    Tcl_SetByteArrayObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewByteArrayObj --
 *
 *	This procedure is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It is the same as the Tcl_NewByteArrayObj
 *	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 procedure just returns the
 *	result of calling Tcl_NewByteArrayObj.
 *
 * Results:
 *	The newly create 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 byte array argument.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetByteArrayObj(objPtr, bytes, length);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewByteArrayObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SetByteArrayObj --
 *
 *	Modify an object to be a ByteArray object and to have the specified
 *	array of bytes as its value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old string rep and internal rep is freed. Memory
 *	allocated for copy of byte array argument.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				 * value. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
    size_t uallocated;
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }

    TclFreeIntRep(objPtr);
    Tcl_InvalidateStringRep(objPtr);

    uallocated = BYTEARRAY_UALLOC(length);
    stringPtr = (String *) ckalloc(BYTEARRAY_SIZE(uallocated));
    stringPtr->numChars = length;
    stringPtr->uallocated = uallocated;
    stringPtr->storageType = Storage_Byte;
    stringPtr->range = Range_Byte;
    stringPtr->allocated = 0;
    memcpy(stringPtr->data.bytes, bytes, (size_t) length);

    objPtr->typePtr = &tclByteArrayType;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
 *
 *	Attempt to get the array of bytes from the Tcl object. If the object
 *	is not already a ByteArray object, an attempt will be made to convert
 *	it to one.
 *
 * Results:
 *	Pointer to array of bytes representing the ByteArray object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new internal rep.
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    String *stringPtr;

    SetByteArrayFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->data.bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
 *	This procedure changes the length of the byte array for this object.
 *	Once the caller has set the length of the array, it is acceptable to
 *	directly modify the bytes in the array up until Tcl_GetStringFromObj()
 *	has been called on this object.
 *
 * Results:
 *	The new byte array of the specified length.
 *
 * Side effects:
 *	Allocates enough memory for an array of bytes of the requested size.
 *	When growing the array, the old array is copied to the new array; new
 *	bytes are undefined. When shrinking, the old array is truncated to the
 *	specified length.
 *
 *----------------------------------------------------------------------
 */

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int length)			/* New length for internal byte array. */
{
    size_t uallocated;
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }
    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }

    stringPtr = GET_STRING(objPtr);
    uallocated = BYTEARRAY_UALLOC(length);
    if (uallocated > stringPtr->uallocated) {
	stringPtr = (String *) ckrealloc(
		(char *) stringPtr, BYTEARRAY_SIZE(uallocated));
	stringPtr->uallocated = uallocated;
	SET_STRING(objPtr, stringPtr);
    }
    Tcl_InvalidateStringRep(objPtr);
    stringPtr->numChars = length;
    stringPtr->range = Range_Byte;
    return stringPtr->data.bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetUnicodeLength --
 *
 *	This procedure changes the length of the unicode array for this object.
 *	Once the caller has set the length of the array, it is acceptable to
 *	directly modify the elements in the array up until Tcl_GetStringFromObj()
 *	has been called on this object.
 *
 * Results:
 *	The new unicode array of the specified length.
 *
 * Side effects:
 *	Allocates enough memory for an array of unichars of the requested size.
 *	When growing the array, the old array is copied to the new array; new
 *	bytes are undefined. When shrinking, the old array is truncated to the
 *	specified length.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
TclSetUnicodeLength(
    Tcl_Obj *objPtr,		/* The Unicode object. */
    int length)			/* New length for internal unicode array. */
{
    size_t uallocated;
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeLength");
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->storageType != Storage_Unicode) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    uallocated = STRING_UALLOC(length);
    if (uallocated > stringPtr->uallocated) {
	stringPtr = (String *) ckrealloc(
		(char *) stringPtr, STRING_SIZE(uallocated));
	stringPtr->uallocated = uallocated;
	SET_STRING(objPtr, stringPtr);
    }
    Tcl_InvalidateStringRep(objPtr);
    stringPtr->numChars = length;
    stringPtr->range = Range_Unicode;
    stringPtr->data.unicode[length] = 0;
    return stringPtr->data.unicode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCharLength --
 *
 *	Get the length of the Unicode string from the Tcl object.
 *
 * Results:
 *	Pointer to unicode string representing the unicode object.
 *

     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * 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) {
	    /*

	     * All UTF chars are 1-byte long.

	     */

	    stringPtr->range = Range_Ascii;
	} else {
	    stringPtr->range = Range_Unicode;
	}
#endif
    }
    return numChars;
}

/*

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->numChars == -1) {
	Tcl_GetCharLength(objPtr);
    }

    if (stringPtr->range == Range_Ascii) {
	/*

	 * All of the characters in the Utf string are 1 byte chars.  We get
	 * the Utf string and convert the index'th byte to a Unicode character.
	 */

	unichar = (Tcl_UniChar) objPtr->bytes[index];
    } else if ((stringPtr->storageType == Storage_Byte) && 

	    (stringPtr->range == Range_Byte)) {
	unichar = (Tcl_UniChar) stringPtr->data.bytes[index];
    } else {
	if (stringPtr->storageType != Storage_Unicode) {
	    FillUnicodeRep(objPtr);
	    stringPtr = GET_STRING(objPtr);
	}
	unichar = stringPtr->data.unicode[index];
    }
    return stringPtr->unicode[index];
}

/*
 *----------------------------------------------------------------------
 *

 */

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->storageType != Storage_Unicode) {
	/*
	 * 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->data.unicode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *

				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->storageType != Storage_Unicode) {
	/*
	 * 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);
	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->data.unicode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetRange --
 *

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->numChars == -1) {
	Tcl_GetCharLength(objPtr);
    }

    if (stringPtr->range == Range_Ascii) {
	char *str = TclGetString(objPtr);

	/*

	 * All of the characters in the Utf string are 1 byte chars. 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;
	stringPtr->range = Range_Ascii;
    } else if ((stringPtr->storageType == Storage_Byte) && 
	    (stringPtr->range == Range_Byte)) {
	newObjPtr = Tcl_NewByteArrayObj(stringPtr->data.bytes + first,
		last-first+1);
    } else {
	if (stringPtr->storageType != Storage_Unicode) {
	    FillUnicodeRep(objPtr);
	    stringPtr = GET_STRING(objPtr);
	}
	newObjPtr = Tcl_NewUnicodeObj(stringPtr->data.unicode + first,
		last-first+1);
    }
    return newObjPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --
 *

 *
 * 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 string. 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".
 *
 *----------------------------------------------------------------------
 */

	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    if (objPtr->bytes && objPtr->length == length) {
	return;
    }

    if (objPtr->bytes == NULL) {
	UpdateStringOfString(objPtr);
    }

    if (length > (int) stringPtr->allocated) {
	/*
	 * Change length of an existing string rep.
	 */




	if (objPtr->bytes != tclEmptyStringRep) {
	    objPtr->bytes = ckrealloc((char *)objPtr->bytes,
		    (unsigned)(length+1));
	} else {
	    objPtr->bytes = ckalloc((unsigned) (length+1));
	}
	stringPtr->allocated = length;
    }

    objPtr->length = length;
    if (objPtr->bytes != tclEmptyStringRep) {



























	/*
	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
	 * the string rep.
	 */

	objPtr->bytes[length] = 0;
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->storageType = Storage_None;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptSetObjLength --
 *

    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (objPtr->bytes == NULL) {
	UpdateStringOfString(objPtr);
    }

    if (length > (int) stringPtr->allocated) {
	char *new;

	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	if (objPtr->bytes != tclEmptyStringRep) {


	    new = attemptckrealloc(objPtr->bytes, (unsigned)(length+1));
	    if (new == NULL) {
		return 0;
	    }
	} else {
	    new = attemptckalloc((unsigned) (length+1));
	    if (new == NULL) {
		return 0;
	    }
	}
	objPtr->bytes = new;
	stringPtr->allocated = length;
    }

    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->storageType = Storage_None;






























    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SetUnicodeObj --

     */

    stringCheckLimits(numChars);
    stringPtr = stringAlloc(numChars);
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;

    stringPtr->numChars = numChars;
    stringPtr->uallocated = uallocated;
    stringPtr->storageType = Storage_Unicode;
    stringPtr->range = Range_Unicode;
    stringPtr->allocated = 0;
    memcpy(stringPtr->data.unicode, unicode, uallocated);
    stringPtr->data.unicode[numChars] = 0;

    TclInvalidateStringRep(objPtr);
    stringPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------

     * 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.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    if (stringPtr->storageType == Storage_Unicode) {

	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->storageType == Storage_Unicode) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, -1);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
    }
}

/*
 *----------------------------------------------------------------------

    /*
     * 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->storageType == Storage_Unicode) {




	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}

/*

    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    stringPtr = GET_STRING(objPtr);

    if (stringPtr->storageType == Storage_Unicode) {


	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (appendObjPtr->typePtr == &tclStringType) {
	    stringPtr = GET_STRING(appendObjPtr);
	    if (stringPtr->storageType != Storage_Unicode) {
		/*
		 * 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->data.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.
     */

    Tcl_GetString(objPtr);
    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);





    if (allOneByteChars) {
	stringPtr = GET_STRING(objPtr);
	stringPtr->numChars = numChars;
	stringPtr->range = Range_Ascii;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --

    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    memcpy(stringPtr->data.unicode + stringPtr->numChars, unicode,
	    appendNumChars * sizeof(Tcl_UniChar));
    stringPtr->data.unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->range = Range_Unicode;

    TclInvalidateStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *

    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->storageType = Storage_None;

    memcpy(objPtr->bytes + oldLength, bytes, numBytes);
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}

/*

    va_start(argList, format);
    AppendPrintfToObjVA(objPtr, format, argList);
    va_end(argList);
    return objPtr;
}

int
TclStringCompare(
    Tcl_Obj *obj1Ptr,
    Tcl_Obj *obj2Ptr,
    int reqlength,
    int nocase,
    int equal)
{
    /*
     * Remember to keep code here in some sync with the byte-compiled
     * versions in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and
     * INST_STR_CMP as well as the expr string comparison in
     * INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, length;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;
    char *string1, *string2;
    int length1, length2;

    if ((reqlength == 0) || (obj1Ptr == obj2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */

	return 0;
    } else if (!nocase && obj1Ptr->typePtr == &tclByteArrayType &&
	    obj2Ptr->typePtr == &tclByteArrayType) {
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some
	 * reason... :^)
	 */

	string1 = (char *) Tcl_GetByteArrayFromObj(obj1Ptr, &length1);
	string2 = (char *) Tcl_GetByteArrayFromObj(obj2Ptr, &length2);
	strCmpFn = (strCmpFn_t) memcmp;
    } else if ((obj1Ptr->typePtr == &tclStringType)
	    && (obj2Ptr->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of
	 * String type. In benchmark testing this proved the most
	 * efficient check between the unicode and string comparison
	 * operations.
	 */

	string1 = (char *) Tcl_GetUnicodeFromObj(obj1Ptr, &length1);
	string2 = (char *) Tcl_GetUnicodeFromObj(obj2Ptr, &length2);
	strCmpFn = (strCmpFn_t)
		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
    } else {
	/*
	 * As a catch-all we will work with UTF-8. We cannot use memcmp()
	 * as that is unsafe with any string containing NULL (\xC0\x80 in
	 * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
	 * we are case-sensitive and no specific length was requested.
	 */

	string1 = (char *) Tcl_GetStringFromObj(obj1Ptr, &length1);
	string2 = (char *) Tcl_GetStringFromObj(obj2Ptr, &length2);
	if ((reqlength < 0) && !nocase) {
	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
	} else {
	    length1 = Tcl_NumUtfChars(string1, length1);
	    length2 = Tcl_NumUtfChars(string2, length2);
	    strCmpFn = (strCmpFn_t)
		    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	}
    }

    if (equal && (reqlength < 0) && (length1 != length2)) {
	return 1;
    }

    length = (length1 < length2) ? length1 : length2;
    if (reqlength > 0 && reqlength < length) {
	length = reqlength;
    } else if (reqlength < 0) {
	/*
	 * The requested length is negative, so we ignore it by
	 * setting it to length + 1 so we correct the match var.
	 */

	reqlength = length + 1;
    }

    match = strCmpFn(string1, string2, (unsigned) length);
    if ((match == 0) && (reqlength > length)) {
	match = length1 - length2;
    }

    return (match > 0) ? 1 : (match < 0) ? -1 : 0;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringObjReverse --
 *
 *	Implements the [string reverse] operation.
 *

    char *src = NULL, *dest = NULL;
    Tcl_UniChar *usrc = NULL, *udest = NULL;
    Tcl_Obj *resultPtr = NULL;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * Make sure we have either fixed width UTF data or Unicode data present.
     */

    if ((stringPtr->storageType != Storage_Unicode) &&
	    (stringPtr->range != Range_Ascii)) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }

    if (stringPtr->storageType == Storage_Unicode) {
	Tcl_UniChar *source = stringPtr->data.unicode;

	if (Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *dest;

	    Tcl_Obj *resultPtr = Tcl_NewObj();
	    dest = TclSetUnicodeLength(resultPtr, numChars);

	    while (i < numChars) {
		dest[i++] = source[lastCharIdx--];
	    }
	    return resultPtr;
	}
	if (stringPtr->numChars <= 1) {
	    return objPtr;
	}
	if (stringPtr->numChars == objPtr->length) {
	    /*
	     * All one-byte chars. Reverse in objPtr->bytes.


/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
 *	Populate the Unicode internal rep with the Unicode form of its string
 *	rep. The object must already 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;



    unsigned char *srcByte;





    Tcl_UniChar *dst;

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->numChars == -1) {
	Tcl_GetCharLength(objPtr);
    }
    if (stringPtr->storageType == Storage_Unicode) {
	return;
    }

    if (stringPtr->storageType == Storage_Byte) {
	/*
	 * Convert ualloc count to unicode
	 */

	stringPtr->uallocated = stringPtr->uallocated - 2;
    }

    uallocated = STRING_UALLOC(stringPtr->numChars);
    if (uallocated > stringPtr->uallocated) {
	/*
	 * If not enough space has been allocated for the unicode rep,
	 * reallocate the internal rep object.
	 *
	 * There isn't currently enough space in the Unicode representation so
	 * allocate additional space. If the current Unicode representation
	 * isn't empty (i.e. it looks like we've done some appends) then
	 * overallocate the space so that we won't have to do as much
	 * reallocation in the future.
	 */

	if (stringPtr->uallocated > 0) {
	    uallocated *= 2;
	}
	stringPtr = stringRealloc(stringPtr, uallocated);
	stringPtr->uallocated = uallocated;
	SET_STRING(objPtr, stringPtr);
    }

    if (stringPtr->storageType == Storage_Byte) {
	if (stringPtr->range <= Range_Byte) {
	    /*
	     * Convert byte to unicode directly.
	     */

	    srcByte = stringPtr->data.bytes + stringPtr->numChars - 1;
	    dst = stringPtr->data.unicode + stringPtr->numChars - 1;
	    while (srcByte >= stringPtr->data.bytes) {
		*dst = (Tcl_UniChar) *srcByte;
		dst--;
		srcByte--;
	    }
	    stringPtr->data.unicode[stringPtr->numChars] = 0;
	    stringPtr->storageType = Storage_Unicode;
	    objPtr->typePtr = &tclStringType;
	    return;
	} else {
	    if (objPtr->bytes == NULL) {
		Tcl_GetString(objPtr);
	    }
	}
    }

    src = objPtr->bytes;
    stringPtr->storageType = Storage_Unicode;
    objPtr->typePtr = &tclStringType;

    /*
     * Convert src to Unicode and store the coverted data in "unicode".
     */

    srcEnd = src + objPtr->length;
    for (dst = stringPtr->data.unicode; src < srcEnd; dst++) {
	src += TclUtfToUniChar(src, dst);
    }
    *dst = 0;
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * 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->storageType == Storage_None) {
	copyStringPtr = (String *) ckalloc(STRING_SIZE(STRING_UALLOC(0)));
	copyStringPtr->uallocated = STRING_UALLOC(0);

    } else if (srcStringPtr->storageType == Storage_Byte) {
	copyStringPtr = (String *) ckalloc(
		BYTEARRAY_SIZE(srcStringPtr->uallocated));
	copyStringPtr->uallocated = srcStringPtr->uallocated;

	memcpy((void *) copyStringPtr->data.bytes,
		(void *) srcStringPtr->data.bytes,
		(size_t) srcStringPtr->numChars);
    } else {
	copyStringPtr = stringAlloc(srcStringPtr->uallocated);
	copyStringPtr->uallocated = srcStringPtr->uallocated;

	memcpy(copyStringPtr->data.unicode,
		srcStringPtr->data.unicode,
		(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
	copyStringPtr->data.unicode[srcStringPtr->numChars] = 0;
    }
    copyStringPtr->numChars = srcStringPtr->numChars;

    copyStringPtr->storageType = srcStringPtr->storageType;
    copyStringPtr->allocated = srcStringPtr->allocated;
    copyStringPtr->range = srcStringPtr->range;

    /*
     * 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;
}

/*
 *----------------------------------------------------------------------

 */

static int
SetStringFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    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) && 
	    (objPtr->typePtr != &tclByteArrayType)) {
	String *stringPtr;

	/*
	 * Convert whatever we have into an untyped value. Just A String.
	 */

	(void) TclGetString(objPtr);
	TclFreeIntRep(objPtr);

	/*
	 * Create a basic String intrep that just points to the UTF-8 string
	 * already in place at objPtr->bytes.
	 */

	stringPtr->numChars = -1;
	stringPtr->uallocated = STRING_UALLOC(0);
	stringPtr->storageType = Storage_None;

	if (objPtr->bytes != NULL) {
	    stringPtr->allocated = objPtr->length;
	    objPtr->bytes[objPtr->length] = 0;
	} else {
	    objPtr->length = 0;
	}
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;
}

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    String *stringPtr;
    CharacterRange range = Range_Unicode;
    int length, count;

    if (objPtr->typePtr == &tclByteArrayType) {
	return TCL_OK;
    }
    if (objPtr->typePtr != &tclStringType) {
	SetStringFromAny(interp, objPtr);
    }
    stringPtr = GET_STRING(objPtr);

    objPtr->typePtr = &tclByteArrayType;
    if (stringPtr->storageType == Storage_Byte) {
	return TCL_OK;
    }

    length = Tcl_GetCharLength(objPtr);

    if (stringPtr->storageType != Storage_Unicode) {
	/*
	 * Since the unicode representation is larger than the byte rep
	 * we only need to allocate storage when there is none.
	 */
	    
	size_t uallocated = BYTEARRAY_UALLOC(length);
	stringPtr = (String *) ckrealloc((char*) stringPtr,
					 BYTEARRAY_SIZE(uallocated));
	SET_STRING(objPtr, stringPtr);
	stringPtr->uallocated = uallocated;
    } else {
	/*
	 * Change allocation count from unicode to bytes.
	 */

	stringPtr->uallocated = stringPtr->uallocated + 2;
    }

    if (stringPtr->range == Range_Ascii) {
	memcpy((void *) stringPtr->data.bytes, objPtr->bytes, length);
	stringPtr->storageType = Storage_Byte;
	return TCL_OK;
    }

    if (stringPtr->storageType == Storage_Unicode) {
	Tcl_UniChar *srcPtr = stringPtr->data.unicode;
	unsigned char *dstPtr = stringPtr->data.bytes;
	
	/*
	 * Look for any char outside of byte range.
	 */

	count = length;
	range = Range_Byte;
	while (count-- > 0) {
	    if (*srcPtr++ > 255) {
		range = Range_Unicode;
		break;
	    }
	}

	/* 
	 * If a pure Unicode object contains chars outside the byte range we
	 * must fill in the UTF representation to not lose information.
	 */

	if (range == Range_Unicode) {
	    Tcl_GetString(objPtr);
	}

	count = length;
	srcPtr = stringPtr->data.unicode;
	while (count-- > 0) {
	    *dstPtr = (unsigned char) *srcPtr;
	    dstPtr++;
	    srcPtr++;
	}

	stringPtr->storageType = Storage_Byte;
	stringPtr->range = range;
    } else {
	Tcl_UniChar ch;
	char *srcPtr = Tcl_GetStringFromObj(objPtr, &length);
	unsigned char *dstPtr = stringPtr->data.bytes;
	char *srcEnd = srcPtr + length;

	range = Range_Byte;
	while (srcPtr < srcEnd) {
	    srcPtr += Tcl_UtfToUniChar(srcPtr, &ch);
	    *dstPtr++ = (unsigned char) ch;
	    if (ch > 255) {
		range = Range_Unicode;
	    }
	}
	stringPtr->storageType = Storage_Byte;
	stringPtr->range = range;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfString --
 *
 *	Update the string representation for an object whose internal

 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    int i, size;
    Tcl_UniChar *unicode;
    char dummy[TCL_UTF_MAX];
    unsigned char *src;
    char *dst;
    String *stringPtr;

    stringPtr = GET_STRING(objPtr);
    if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {


	if (stringPtr->storageType == Storage_None) {


	    /*

	     * If there is no Unicode rep, or the string has 0 chars, then set
	     * the string rep to an empty string.
	     */
    String *stringPtr = GET_STRING(objPtr);



	if (stringPtr->storageType == Storage_Byte) {
	    /*
	     * How much space will string rep need?
	     */

	    size = stringPtr->numChars;

	    src = stringPtr->data.bytes;
	    for (i = 0; i < stringPtr->numChars; i++) {
		if ((src[i] == 0) || (src[i] > 127)) {
		    size++;
		}


	    }

	    dst = (char *) ckalloc((unsigned) (size + 1));
	    objPtr->bytes = dst;

	    objPtr->length = size;
	    stringPtr->allocated = size;

	    if (size == stringPtr->numChars) {
		memcpy(dst, src, (size_t) size);
		dst[size] = '\0';
	    } else {
		for (i = 0; i < stringPtr->numChars; i++) {
		    dst += Tcl_UniCharToUtf(src[i], dst);
		}

		*dst = '\0';
	    }
	} else {
	    unicode = stringPtr->data.unicode;

	    /*

	     * Translate the Unicode string to UTF. "size" will hold the amount
	     * of space the UTF string needs.
	     */





	    size = 0;
	    for (i = 0; i < stringPtr->numChars; i++) {
		size += Tcl_UniCharToUtf((int) unicode[i], dummy);
	    }

	    dst = (char *) ckalloc((unsigned) (size + 1));
	    objPtr->bytes = dst;
	    objPtr->length = size;
	    stringPtr->allocated = size;

	    for (i = 0; i < stringPtr->numChars; i++) {
		dst += Tcl_UniCharToUtf(unicode[i], dst);
	    }
	    *dst = '\0';


	}


    }

  copyBytes:
    dst = objPtr->bytes + origLength;
    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf((int) unicode[i], dst);
    }

static int		TestobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);

typedef struct TestString {
    int numChars;
    size_t allocated;
    size_t uallocated;
    int range;
    int storageType;
    Tcl_UniChar unicode[2];
} TestString;

/*
 *----------------------------------------------------------------------
 *
 * TclObjTest_Init --

	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	TclFormatInt(buf, varPtr[varIndex]->refCount);
        Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(subCmd, "pure") == 0) {
        if (objc != 3) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewBooleanObj(varPtr[varIndex]->bytes == NULL));
    } else if (strcmp(subCmd, "type") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;

    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option, i, length;
#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    TestString *strPtr;
    Tcl_UniChar uniChar, *uniPtr;
    Tcl_Obj *objPtr;
    static const char *options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "ualloc", "getunicode", "range", "getunichar",
	"setunicode", "appendunicode", NULL
    };

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

	    break;
	case 10:			/* getunicode */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
	    break;
	case 11:				/* range */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		strPtr = (TestString *)
		    (varPtr[varIndex])->internalRep.otherValuePtr;
		length = (int) strPtr->range;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);




	    break;
	case 12:				/* getunichar */
	    if (objc != 4) {


		goto wrongNumArgs;

	    }
	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }

	    uniChar = Tcl_GetUniChar(varPtr[varIndex], i);
	    Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(&uniChar, 1));

	    break;
	case 13:				/* setunicode */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    uniPtr = Tcl_GetUnicodeFromObj(objv[3], &length);
	    objPtr = Tcl_NewObj();
	    Tcl_SetUnicodeObj(objPtr, uniPtr, length);
	    SetVarToObj(varIndex, objPtr);
	    break;
	case 14:				/* appendunicode */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varIndex, Tcl_NewObj());
	    }










	    uniPtr = Tcl_GetUnicodeFromObj(objv[3], &length);
	    objPtr = Tcl_NewObj();









	    Tcl_AppendUnicodeToObj(varPtr[varIndex], uniPtr, length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
    }

    return TCL_OK;
}


This is the original write down of the Unify idea, from Sep 2007...


Currently there are two internal reps called "string" and "bytearray".
They share some common properties including storing the length of the
string and a fixed-sized-per-char array allowing O(1) indexing.

Currently any place that handles strings, such as indexing, ranging,
comparing etc, needs to handle both intreps to avoid shimmering
and preserve efficiency.

Unifying these into one intrep might help simplifying the code
and maybe make things more efficient.
It will also make shimmering more efficient when needed.

Properties of "string":
 Stores length in characters.
 Stores info about extra allocated utf-8 space.
 Optionally stores 16-bit unicode array, handling extra space.
 Knows if utf-8 is one-byte-per-char.

Properties of "bytearray":
 Stores length in characters.
 Stores 8-bit byte array, handling extra space.
 
A current bug in bytearray is that it does not handle if a char
outside of 0-255 is present in the utf-8 string, i.e. if indexing
into the bytearray is really valid.  This does not matter in any
sane code, but to be picky it is a bug.


Does a unified version need the ability to keep both a byte and a
unicode rep?
If not, the data can be in a union at the end of the struct keeping
the entire intrep in one block as the current intreps do.
If yes, the intrep could need three memory blocks, the struct, the
byte data and the unicode data. This would make handling generally
trickier.
I would say no to this currently.


A combined structure could contain:
 The length in characters.
 Size of utf-8 allocation.
 If utf-8 is one-byte-per-char (all chars within 1-127).
 If all chars are within 0-255 (pure bytearray).
 If stored array is not present, byte or unicode.
 Size of array allocation.
 Data Union

The property "utf-8 is one-byte-per-char" is currently
indicated by numChars != -1 and hasUnicode == 0.
A special field for this combined with a value for a pure bytearray
covers all needs.  This could be expanded in the future if
"Unicode" is split into UTF-16 and real Unicode.

typedef enum {
    Ascii, Byte, Unicode
} CharacterRange;

The presence of data can be indicated with an enum.  This
can also be expanded if UTF-16/Unicode needs to be separated.

typedef enum {
    None, Byte, Unicode
} StorageType;

Giving something like this:

typedef struct String {
    int numChars;
    size_t allocated;
    CharacterRange range;
    StorageType storageType;
    size_t allocatedStorage;
    union {
        unsigned char bytes[4];
        Tcl_UniChar unicode[2];
    } data;
} String;

This only expands the String array with one integer.


Implementation:
All ByteArray APIs move to tclStringObj.c
The binary command stays in tclBinary.c

Shimmering from unicode to byte is a rather cheap operation
since it can be done in-place.

Compatibility:
If anyone accesses through e.g. Tcl_GetObjType("bytearray") it gets
tricker to maintain full compatiblity.  I wonder if this is needed?

test stringObj-12.5 {Tcl_GetUniChar} testobj {
    set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef"
    list [string index $x 4] [string index $x 0]
} "\u00ae \u00ef"
test stringObj-12.6 {Tcl_GetUniChar} testobj {
    string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end
} "\u00ae"

test stringObj-12.7 {Tcl_GetUniChar with byte-size chars} testobj {
    teststringobj set2 1 "abcdefghi"
    list [teststringobj getunichar 1 0] [teststringobj getunichar 1 1]
} {a b}

test stringObj-12.8 {Tcl_GetUniChar with unicode rep} testobj {
    set a "abcd\u129fefghi"
    teststringobj set2 1 $a 
    list [teststringobj getunichar 1 4] [teststringobj getunichar 1 6]
} [list \u129f f]

test stringObj-12.9 {Tcl_GetUniChar with byte rep} testobj {
    set a "abcd\u009fefghi"
    binary scan $a I dummy
    teststringobj set2 1 $a 
    list [teststringobj getunichar 1 4] [teststringobj getunichar 1 6]
} [list \u009f f]

test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj {
    set a ""
    list [string length $a] [string length $a]
} {0 0}
test stringObj-13.2 {Tcl_GetCharLength with byte-size chars} testobj {
    string length "a"

    teststringobj appendself2 1 2
} fooo
test stringObj-15.8 {Tcl_Append*ToObj: self appends} {
    teststringobj set 1 foo
    teststringobj appendself2 1 3
} foo

test stringObj-15.1 {byte/unicode shimmering, start from byte} testobj {
    set res ""
    # Pure byte object
    teststringobj set2 1 [binary format c* {1 5 8 9 78 178 250 180}]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Still byte object
    string length [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Unicode object
    regexp {.*} [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Byte object
    binary scan [teststringobj get 1] I dummy
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Unicode object
    regexp {.*} [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

} {bytearray 8 1 bytearray 8 1 string 32 1 bytearray 34 1 string 32 1}

test stringObj-15.2 {byte/unicode shimmering, start from unicode} testobj {
    set res ""
    # Pure unicode object
    teststringobj set 1 a\u0095cdef\u00EFh
    teststringobj getunicode 1
    testobj invalidateStringRep 1
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Still unicode object
    string length [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Byte object
    binary scan [teststringobj get 1] I dummy
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Unicode object
    regexp {.*} [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Byte object
    binary scan [teststringobj get 1] I dummy
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

} {string 16 1 string 16 1 bytearray 18 1 string 16 1 bytearray 18 1}

test stringObj-15.3 {byte/unicode shimmering, out of byte range} testobj {
    set res ""
    # Pure unicode object
    teststringobj set 1 a\u1295cdef\u00EFh
    teststringobj getunicode 1
    testobj invalidateStringRep 1
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]
    lappend res [string range [teststringobj get 1] 0 end]

    # Byte object
    binary scan [teststringobj get 1] I dummy
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Reading byte object with out-of-range data
    lappend res [string range [teststringobj get 1] 0 end]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Byte object, without utf
    binary scan [teststringobj get 1] I dummy
    testobj invalidateStringRep 1
    teststringobj getunicode 1
    lappend res [string range [teststringobj get 1] 0 end]

} [list string 16 1 a\u1295cdef\u00EFh bytearray 18 0 a\u1295cdef\u00EFh string 16 0 a\u0095cdef\u00EFh]

test stringObj-15.4 {byte/unicode shimmering, one-char} testobj {
    set res ""
    # Pure byte object
    teststringobj set2 1 [binary format c 178]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]

    # Unicode object
    regexp {.*} [teststringobj get 1]
    lappend res [testobj type 1]
    lappend res [teststringobj ualloc 1]
    lappend res [testobj pure 1]
} {bytearray 4 1 string 2 1}

test stringObj-16.1 {Tcl_SetUnicodeObj} testobj {
    teststringobj setunicode 1 foo\u1234bar
    testobj type 1
} {string}

test stringObj-17.1 {Tcl_AppendUnicodeToObj} testobj {
    set res ""
    teststringobj set 1 apa
    teststringobj appendunicode 1 foo\u1234bar
    lappend res [testobj type 1]
    lappend res [teststringobj get 1]
} [list string apafoo\u1234bar]

if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return