Tcl Source Code

name: Linux
on: [push]
jobs:
  gcc:
    runs-on: ubuntu-20.04
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_UTF_MAX=3"
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
    defaults:
      run:

      run:
        shell: powershell
        working-directory: win
    strategy:
      matrix:
        cfgopt:
          - ""
          - "OPTS=utf16"
          - "CHECKS=nodep"
          - "OPTS=static"
          - "OPTS=symbols"
          - "OPTS=symbols STATS=compdbg,memdbg"
    # Using powershell means we need to explicitly stop on failure
    steps:
      - name: Checkout

      run:
        shell: msys2 {0}
        working-directory: win
    strategy:
      matrix:
        cfgopt:
          - ""
          - "CFLAGS=-DTCL_UTF_MAX=3"
          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
          - "--disable-shared"
          - "--enable-symbols"
          - "--enable-symbols=mem"
          - "--enable-symbols=all"
    # Using powershell means we need to explicitly stop on failure
    steps:

declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}
declare 352 {
    int Tcl_Char16Len(const unsigned short *uniStr)
}
declare 353 {deprecated {Use Tcl_UtfNcmp}} {
    int Tcl_UniCharNcmp(const unsigned short *ucs, const unsigned short *uct,
	    unsigned long numChars)
}
declare 354 {
    char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 355 {

    int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
	    Tcl_Obj *textObj, int offset, int nmatches, int flags)
}
declare 377 {
    void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
    Tcl_Obj *Tcl_NewUnicodeObj(const unsigned short *unicode, int numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const unsigned short *unicode,
	    int numChars)
}
declare 380 {
    int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
declare 382 {deprecated {No longer in use, changed to macro}} {
    unsigned short *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const unsigned short *unicode,
	    int length)
}
declare 385 {
    int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
	    Tcl_Obj *patternObj)
}
declare 386 {

declare 417 {
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}
declare 419 {deprecated {Use Tcl_UtfNcasecmp}} {
    int Tcl_UniCharNcasecmp(const unsigned short *ucs, const unsigned short *uct,
	    unsigned long numChars)
}
declare 420 {deprecated {Use Tcl_StringCaseMatch}} {
    int Tcl_UniCharCaseMatch(const unsigned short *uniStr,
	    const unsigned short *uniPattern, int nocase)
}
declare 421 {
    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
}
declare 422 {
    Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
	    const void *key, int *newPtr)

# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    unsigned short *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
declare 435 {deprecated {}} {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)

}

# TIP #481
declare 651 {
    char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 652 {
    unsigned short *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
declare 653 {
    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
}

# TIP #575
declare 654 {

    int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber)
}

# TIP #617
declare 668 {
    int Tcl_UniCharLen(const int *uniStr)
}
declare 669 {
    int TclNumUtfChars(const char *src, int length)
}
declare 670 {
    int TclGetCharLength(Tcl_Obj *objPtr)
}
declare 671 {
    const char *TclUtfAtIndex(const char *src, int index)
}
declare 672 {
    Tcl_Obj *TclGetRange(Tcl_Obj *objPtr, int first, int last)
}
declare 673 {
    int TclGetUniChar(Tcl_Obj *objPtr, int index)
}


# ----- BASELINE -- FOR -- 8.7.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only

 * (or perhaps 1 if we want to support a non-unicode enabled core). If 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16) (the default). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UTF-16 mode
 * is the default and recommended mode.
 */

#ifndef TCL_UTF_MAX
#   ifdef BUILD_tcl
#	define TCL_UTF_MAX		4
#   else
#	define TCL_UTF_MAX		3
#   endif
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

	if (irPtr == NULL) {
	    if (interp) {
		const char *nonbyte;
		int ucs4;

		irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
		baPtr = GET_BYTEARRAY(irPtr);
		nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
		TclUtfToUCS4(nonbyte, &ucs4);

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected byte sequence but character %d "
			"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
	    }

	if (irPtr == NULL) {
	    if (interp) {
		const char *nonbyte;
		int ucs4;

		irPtr = TclFetchInternalRep(objPtr, &tclByteArrayType);
		baPtr = GET_BYTEARRAY(irPtr);
		nonbyte = TclUtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
		TclUtfToUCS4(nonbyte, &ucs4);

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected byte sequence but character %d "
			"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
	    }

    /*
     * Get the length of the string that we are matching against so we can do
     * the termination test for -all matches. Do this before getting the
     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = TclGetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}

	 * start of the string unless the previous character is a newline.
	 */

	if (offset == 0) {
	    eflags = 0;
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (TclGetUniChar(objPtr, offset-1) == '\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
		numMatchesSaved, eflags);

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if ((i <= info.nsubs) && (info.matches[i].end > 0)) {
		    newPtr = TclGetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    TclNewObj(newPtr);
		}
	    }
	    if (doinline) {

	return TCL_ERROR;
    }

    objc -= idx;
    objv += idx;

    if (startIndex) {
	int stringLength = TclGetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset < 0) {
	    offset = 0;
	}
    }

	int slen, nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;

	wsrc = TclGetUnicodeFromObj_(objv[0], &slen);
	wstring = TclGetUnicodeFromObj_(objv[1], &wlen);
	wsubspec = TclGetUnicodeFromObj_(objv[2], &wsublen);
	wend = wstring + wlen - (slen ? slen - 1 : 0);
	result = TCL_OK;

	if (slen == 0) {
	    /*
	     * regsub behavior for "" matches between each character. 'string
	     * map' skips the "" case.
	     */

	    if (wstring < wend) {
		resultPtr = TclNewUnicodeObj(wstring, 0);
		Tcl_IncrRefCount(resultPtr);
		for (; wstring < wend; wstring++) {
		    TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    TclAppendUnicodeToObj(resultPtr, wstring, 1);
		    numMatches++;
		}
		wlen = 0;
	    }
	} else {
	    wsrclc = Tcl_UniCharToLower(*wsrc);
	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
		if ((*wstring == *wsrc ||
			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
			(slen==1 || (strCmpFn(wstring, wsrc,
				(unsigned long) slen) == 0))) {
		    if (numMatches == 0) {
			resultPtr = TclNewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			TclAppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;
		    } else {
			p += slen;
		    }
		    wstring = p - 1;

		    TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    numMatches++;
		}
	    }
	    if (numMatches) {
		wlen    = wfirstChar + wlen - p;
		wstring = p;
	    }

     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = TclGetUnicodeFromObj_(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = TclGetUnicodeFromObj_(subPtr, &wsublen);
    }

    result = TCL_OK;

    /*
     * The following loop is to handle multiple matches within the same source
     * string; each iteration handles one match and its corresponding

	    result = TCL_ERROR;
	    goto done;
	}
	if (match == 0) {
	    break;
	}
	if (numMatches == 0) {
	    resultPtr = TclNewUnicodeObj(wstring, 0);
	    Tcl_IncrRefCount(resultPtr);
	    if (offset > 0) {
		/*
		 * Copy the initial portion of the string in if an offset was
		 * specified.
		 */

		TclAppendUnicodeToObj(resultPtr, wstring, offset);
	    }
	}
	numMatches++;

	/*
	 * Copy the portion of the source string before the match to the
	 * result variable.
	 */

	Tcl_RegExpGetInfo(regExpr, &info);
	start = info.matches[0].start;
	end = info.matches[0].end;
	TclAppendUnicodeToObj(resultPtr, wstring + offset, start);

	/*
	 * In command-prefix mode, the substitutions are added as quoted
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	    args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = TclNewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
		} else {
		    TclNewObj(args[idx + numParts]);
		}
		Tcl_IncrRefCount(args[idx + numParts]);
	    }

	    Tcl_ResetResult(interp);

	    /*
	     * Refetch the unicode, in case the representation was smashed by
	     * the user code.
	     */

	    wstring = TclGetUnicodeFromObj_(objPtr, &wlen);

	    offset += end;
	    if (end == 0 || start == end) {
		/*
		 * Always consume at least one character of the input string
		 * in order to prevent infinite loops, even when we
		 * technically matched the empty string; we must not match
		 * again at the same spot.
		 */

		if (offset < wlen) {
		    TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	    if (all) {
		continue;
	    } else {
		break;

		idx = 0;
	    } else if (ch == '\\') {
		ch = wsrc[1];
		if ((ch >= '0') && (ch <= '9')) {
		    idx = ch - '0';
		} else if ((ch == '\\') || (ch == '&')) {
		    *wsrc = ch;
		    TclAppendUnicodeToObj(resultPtr, wfirstChar,
			    wsrc - wfirstChar + 1);
		    *wsrc = '\\';
		    wfirstChar = wsrc + 2;
		    wsrc++;
		    continue;
		} else {
		    continue;
		}
	    } else {
		continue;
	    }

	    if (wfirstChar != wsrc) {
		TclAppendUnicodeToObj(resultPtr, wfirstChar,
			wsrc - wfirstChar);
	    }

	    if (idx <= info.nsubs) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    TclAppendUnicodeToObj(resultPtr,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;
	    }
	    wfirstChar = wsrc + 1;
	}

	if (wfirstChar != wsrc) {
	    TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
	}

	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string in
	     * order to prevent infinite loops.
	     */

	    if (offset < wlen) {
		TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
	    }
	    offset++;
	} else {
	    offset += end;
	    if (start == end) {
		/*
		 * We matched an empty string, which means we must go forward
		 * one more step so we don't match again at the same spot.
		 */

		if (offset < wlen) {
		    TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	}
	if (!all) {
	    break;
	}

	 * On zero matches, just ignore the offset, since it shouldn't matter
	 * to us in this case, and the user may have skewed it.
	 */

	resultPtr = objv[1];
	Tcl_IncrRefCount(resultPtr);
    } else if (offset < wlen) {
	TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {
	    /*

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = TclGetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));
    return TCL_OK;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

    if (objc == 4) {
	int size = TclGetCharLength(objv[2]);

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));
    return TCL_OK;

	return TCL_ERROR;
    }

    /*
     * Get the char length to calculate what 'end' means.
     */

    length = TclGetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((index >= 0) && (index < length)) {
	int ch = TclGetUniChar(objv[1], index);

	if (ch == -1) {
	    return TCL_OK;
	}

	/*
	 * If we have a ByteArray object, we're careful to generate a new

    Tcl_Obj *outObj;		/* Output object */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
	return TCL_ERROR;
    }

    length = TclGetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (index < 0) {
	index = 0;
    }

		     * if it is the first "element" that has the failure.
		     */

		    while (TclIsSpaceProc(*p)) {
			p++;
		    }
		    TclNewStringObj(tmpStr, string1, p-string1);
		    failat = TclGetCharLength(tmpStr);
		    TclDecrRefCount(tmpStr);
		    break;
		}
	    }
	}
	break;
    }

		     * if it is the first "element" that has the failure.
		     */

		    while (TclIsSpaceProcM(*p)) {
			p++;
		    }
		    TclNewStringObj(tmpStr, string1, p-string1);
		    failat = TclGetCharLength(tmpStr);
		    TclDecrRefCount(tmpStr);
		    break;
		}
	    }
	}
	result = 0;
	break;

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = TclGetUnicodeFromObj_(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }
    end = ustring1 + length1;

    strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp);

    /*
     * Force result to be Unicode
     */

    resultPtr = TclNewUnicodeObj(ustring1, 0);

    if (mapElemc == 2) {
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	int mapLen, u2lc;
	Tcl_UniChar *mapString;

	ustring2 = TclGetUnicodeFromObj_(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = TclGetUnicodeFromObj_(mapElemv[1], &mapLen);
	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
	    for (; ustring1 < end; ustring1++) {
		if (((*ustring1 == *ustring2) ||
			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
			(length2==1 || strCmpFn(ustring1, ustring2,
				(unsigned long) length2) == 0)) {
		    if (p != ustring1) {
			TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    TclAppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	int *mapLens, *u2lc = NULL;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = TclGetUnicodeFromObj_(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
	}
	for (p = ustring1; ustring1 < end; ustring1++) {
	    for (index = 0; index < mapElemc; index += 2) {

			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }

		    /*
		     * Adjust len to be full length of matched string.
		     */

		    ustring1 = p - 1;

		    /*
		     * Append the map value to the unicode string.
		     */

		    TclAppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }
	}
	if (nocase) {
	    TclStackFree(interp, u2lc);
	}
	TclStackFree(interp, mapLens);
	TclStackFree(interp, mapStrings);
    }
    if (p != ustring1) {
	/*
	 * Put the rest of the unmapped chars onto result.
	 */

	TclAppendUnicodeToObj(resultPtr, p, ustring1 - p);
    }
    Tcl_SetObjResult(interp, resultPtr);
  done:
    if (mapWithDict) {
	TclStackFree(interp, mapElemv);
    }
    if (copySource) {

    }

    /*
     * Get the length in actual characters; Then reduce it by one because
     * 'end' refers to the last character, not one past it.
     */

    length = TclGetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (last >= 0) {
	Tcl_SetObjResult(interp, TclGetRange(objv[1], first, last));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    length = TclGetCharLength(objv[1]);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetUnicodeFromObj_(objv[1], &length);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index >= length) {
	index = length - 1;
    }
    cur = 0;

    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetUnicodeFromObj_(objv[1], &length);
    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (index < 0) {
	index = 0;
    }
    if (index < length) {

    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclGetCharLength(objv[1])));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLowerCmd --

	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = TclUtfAtIndex(string1, first);
	end = TclUtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToLower(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, -1);

	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = TclUtfAtIndex(string1, first);
	end = TclUtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToUpper(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, -1);

	}
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = TclUtfAtIndex(string1, first);
	end = TclUtfAtIndex(start, last - first + 1);
	resultPtr = Tcl_NewStringObj(string1, end - string1);
	string2 = TclGetString(resultPtr) + (start - string1);

	length2 = Tcl_UtfToTitle(string2);
	Tcl_SetObjLength(resultPtr, length2 + (start - string1));

	Tcl_AppendToObj(resultPtr, end, -1);

		Tcl_ListObjAppendElement(NULL, indicesObj,
			Tcl_NewListObj(2, rangeObjAry));
	    }

	    if (matchVarObj != NULL) {
		Tcl_Obj *substringObj;

		substringObj = TclGetRange(stringObj,
			info.matches[j].start, info.matches[j].end-1);

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, matchesObj, substringObj);

	/*
	 * Here someone is asking for the length of a static string (or
	 * something with backslashes). Just push the actual character (not
	 * byte) length.
	 */

	char buf[TCL_INTEGER_SPACE];
	int len = TclGetCharLength(objPtr);

	len = sprintf(buf, "%d", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);

EXTERN int		Tcl_UniCharIsUpper(int ch);
/* 351 */
EXTERN int		Tcl_UniCharIsWordChar(int ch);
/* 352 */
EXTERN int		Tcl_Char16Len(const unsigned short *uniStr);
/* 353 */
TCL_DEPRECATED("Use Tcl_UtfNcmp")
int			Tcl_UniCharNcmp(const unsigned short *ucs,
				const unsigned short *uct,
				unsigned long numChars);
/* 354 */
EXTERN char *		Tcl_Char16ToUtfDString(const unsigned short *uniStr,
				int uniLength, Tcl_DString *dsPtr);
/* 355 */
EXTERN unsigned short *	 Tcl_UtfToChar16DString(const char *src, int length,
				Tcl_DString *dsPtr);

EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				int offset, int nmatches, int flags);
/* 377 */
EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
/* 378 */
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const unsigned short *unicode,
				int numChars);
/* 379 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const unsigned short *unicode, int numChars);
/* 380 */
EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
TCL_DEPRECATED("No longer in use, changed to macro")
unsigned short *	Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */

EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				const unsigned short *unicode, int length);
/* 385 */
EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
/* 386 */
EXTERN void		Tcl_SetNotifier(
				const Tcl_NotifierProcs *notifierProcPtr);
/* 387 */

EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
/* 417 */
EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
/* 418 */
EXTERN int		Tcl_IsChannelExisting(const char *channelName);
/* 419 */
TCL_DEPRECATED("Use Tcl_UtfNcasecmp")
int			Tcl_UniCharNcasecmp(const unsigned short *ucs,
				const unsigned short *uct,
				unsigned long numChars);
/* 420 */
TCL_DEPRECATED("Use Tcl_StringCaseMatch")
int			Tcl_UniCharCaseMatch(const unsigned short *uniStr,
				const unsigned short *uniPattern, int nocase);
/* 421 */
EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
				const void *key);
/* 422 */
EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
				const void *key, int *newPtr);
/* 423 */

EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
				const char *file, int line);
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN unsigned short *	 Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
int			Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				const char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,

/* 650 */
EXTERN unsigned char *	Tcl_GetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t *numBytesPtr);
/* 651 */
EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 652 */
EXTERN unsigned short *	 TclGetUnicodeFromObj(Tcl_Obj *objPtr,
				size_t *lengthPtr);
/* 653 */
EXTERN unsigned char *	TclGetByteArrayFromObj(Tcl_Obj *objPtr,
				size_t *numBytesPtr);
/* 654 */
EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
/* 655 */

/* Slot 663 is reserved */
/* Slot 664 is reserved */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
/* Slot 667 is reserved */
/* 668 */
EXTERN int		Tcl_UniCharLen(const int *uniStr);
/* 669 */
EXTERN int		TclNumUtfChars(const char *src, int length);
/* 670 */
EXTERN int		TclGetCharLength(Tcl_Obj *objPtr);
/* 671 */
EXTERN const char *	TclUtfAtIndex(const char *src, int index);
/* 672 */
EXTERN Tcl_Obj *	TclGetRange(Tcl_Obj *objPtr, int first, int last);
/* 673 */
EXTERN int		TclGetUniChar(Tcl_Obj *objPtr, int index);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    int (*tcl_Char16Len) (const unsigned short *uniStr); /* 352 */
    TCL_DEPRECATED_API("Use Tcl_UtfNcmp") int (*tcl_UniCharNcmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 353 */
    char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    unsigned short * (*tcl_UtfToChar16DString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */

    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
    int (*tcl_UniCharIsControl) (int ch); /* 372 */
    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const unsigned short *unicode, int numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const unsigned short *unicode, int numChars); /* 379 */
    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    TCL_DEPRECATED_API("No longer in use, changed to macro") unsigned short * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const unsigned short *unicode, int length); /* 384 */
    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
    void (*tcl_SetNotifier) (const Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */

    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
    int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
    void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
    void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
    int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
    TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 419 */
    TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const unsigned short *uniStr, const unsigned short *uniPattern, int nocase); /* 420 */
    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
    ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
    int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    unsigned short * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */

    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, int uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 648 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
    unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */
    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
    unsigned short * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
    unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */
    int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
    const char * (*tcl_UtfNext) (const char *src); /* 655 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
    int (*tcl_UniCharIsUnicode) (int ch); /* 657 */
    int (*tcl_ExternalToUtfDStringEx) (Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_DString *dsPtr); /* 658 */
    int (*tcl_UtfToExternalDStringEx) (Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_DString *dsPtr); /* 659 */
    int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */
    void (*reserved661)(void);
    void (*reserved662)(void);
    void (*reserved663)(void);
    void (*reserved664)(void);
    void (*reserved665)(void);
    void (*reserved666)(void);
    void (*reserved667)(void);
    int (*tcl_UniCharLen) (const int *uniStr); /* 668 */
    int (*tclNumUtfChars) (const char *src, int length); /* 669 */
    int (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */
    const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */
    Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */
    int (*tclGetUniChar) (Tcl_Obj *objPtr, int index); /* 673 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

/* Slot 663 is reserved */
/* Slot 664 is reserved */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
/* Slot 667 is reserved */
#define Tcl_UniCharLen \
	(tclStubsPtr->tcl_UniCharLen) /* 668 */
#define TclNumUtfChars \
	(tclStubsPtr->tclNumUtfChars) /* 669 */
#define TclGetCharLength \
	(tclStubsPtr->tclGetCharLength) /* 670 */
#define TclUtfAtIndex \
	(tclStubsPtr->tclUtfAtIndex) /* 671 */
#define TclGetRange \
	(tclStubsPtr->tclGetRange) /* 672 */
#define TclGetUniChar \
	(tclStubsPtr->tclGetUniChar) /* 673 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry
#if defined(USE_TCL_STUBS)

	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
		dstCharsPtr);
	if (*dstCharsPtr <= maxChars) {
	    break;
	}
	dstLen = TclUtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
	*statePtr = savedState;
    } while (1);
    if (!noTerminate) {
	/* ...and then append it */

	dst[*dstWrotePtr] = '\0';
    }

	TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
		(match < 0 ? -1 : match > 0 ? 1 : 0)));
	JUMP_PEEPHOLE_F(match, 1, 2);

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

    case INST_STR_UPPER:
	valuePtr = OBJ_AT_TOS;
	TRACE(("\"%.20s\" => ", O2S(valuePtr)));

	valuePtr = OBJ_UNDER_TOS;
	TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr)));

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

	length = TclGetCharLength(valuePtr);
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if ((index < 0) || (index >= length)) {
	    TclNewObj(objResultPtr);
	} else if (TclIsPureByteArray(valuePtr)) {
	    objResultPtr = Tcl_NewByteArrayObj(
		    TclGetByteArrayFromObj(valuePtr, NULL)+index, 1);
	} else if (valuePtr->bytes && length == valuePtr->length) {
	    objResultPtr = Tcl_NewStringObj((const char *)
		    valuePtr->bytes+index, 1);
	} else {
	    char buf[4] = "";
	    int ch = TclGetUniChar(valuePtr, index);

	    /*
	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
	     * but creating the object as a string seems to be faster in
	     * practical use.
	     */
	    if (ch == -1) {

	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
	NEXT_INST_F(1, 2, 1);

    case INST_STR_RANGE:
	TRACE(("\"%.20s\" %.20s %.20s =>",
		O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
	length = TclGetCharLength(OBJ_AT_DEPTH(2)) - 1;

	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
		    &fromIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
		    &toIdx) != TCL_OK) {
	    CACHE_STACK_INFO();
	    TRACE_ERROR(interp);
	    goto gotError;
	}
	CACHE_STACK_INFO();

	if (toIdx < 0) {
	    TclNewObj(objResultPtr);
	} else {
	    objResultPtr = TclGetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
	}
	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
	NEXT_INST_V(1, 3, 1);

    case INST_STR_RANGE_IMM:
	valuePtr = OBJ_AT_TOS;
	fromIdx = TclGetInt4AtPtr(pc+1);
	toIdx = TclGetInt4AtPtr(pc+5);
	length = TclGetCharLength(valuePtr);
	TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));

	/* Every range of an empty value is an empty value */
	if (length == 0) {
	    TRACE_APPEND(("\n"));
	    NEXT_INST_F(9, 0, 0);
	}

	    if (fromIdx == TCL_INDEX_NONE) {
		fromIdx = TCL_INDEX_START;
	    }
	    fromIdx = TclIndexDecode(fromIdx, length - 1);
	    if (toIdx < 0) {
		TclNewObj(objResultPtr);
	    } else {
		objResultPtr = TclGetRange(valuePtr, fromIdx, toIdx);
	    }
	}
	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(9, 1, 1);

    {
	Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
	int length3, endIdx;
	Tcl_Obj *value3Ptr;

    case INST_STR_REPLACE:
	value3Ptr = POP_OBJECT();
	valuePtr = OBJ_AT_DEPTH(2);
	endIdx = TclGetCharLength(valuePtr) - 1;
	TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
	DECACHE_STACK_INFO();
	if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
		    &fromIdx) != TCL_OK
	    || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
		    &toIdx) != TCL_OK) {

	if (value3Ptr == value2Ptr) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (valuePtr == value2Ptr) {
	    objResultPtr = value3Ptr;
	    goto doneStringMap;
	}
	ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
	if (length == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	}
	ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2);
	if (length2 > length || length2 == 0) {
	    objResultPtr = valuePtr;
	    goto doneStringMap;
	} else if (length2 == length) {
	    if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
		objResultPtr = valuePtr;
	    } else {
		objResultPtr = value3Ptr;
	    }
	    goto doneStringMap;
	}
	ustring3 = TclGetUnicodeFromObj_(value3Ptr, &length3);

	objResultPtr = TclNewUnicodeObj(ustring1, 0);
	p = ustring1;
	end = ustring1 + length;
	for (; ustring1 < end; ustring1++) {
	    if ((*ustring1 == *ustring2) &&
		/* Fix bug [69218ab7b]: restrict max compare length. */
		(end-ustring1 >= length2) && (length2==1 ||
		    memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
			    == 0)) {
		if (p != ustring1) {
		    TclAppendUnicodeToObj(objResultPtr, p, ustring1-p);
		    p = ustring1 + length2;
		} else {
		    p += length2;
		}
		ustring1 = p - 1;

		TclAppendUnicodeToObj(objResultPtr, ustring3, length3);
	    }
	}
	if (p != ustring1) {
	    /*
	     * Put the rest of the unmapped chars onto result.
	     */

	    TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p);
	}
    doneStringMap:
	TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
		O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
	NEXT_INST_V(1, 3, 1);

    case INST_STR_FIND:

	NEXT_INST_F(1, 2, 1);

    case INST_STR_CLASS:
	opnd = TclGetInt1AtPtr(pc+1);
	valuePtr = OBJ_AT_TOS;
	TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
		O2S(valuePtr)));
	ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
	match = 1;
	if (length > 0) {
	    int ch;
	    end = ustring1 + length;
	    for (p=ustring1 ; p<end ; ) {
		p += TclUniCharToUCS4(p, &ch);
		if (!tclStringClassTable[opnd].comparator(ch)) {

	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */

	/*
	 * Check that at least one of the objects is Unicode before promoting
	 * both.
	 */

	if (TclHasInternalRep(valuePtr, &tclUniCharStringType)
		|| TclHasInternalRep(value2Ptr, &tclUniCharStringType)) {
	    Tcl_UniChar *ustring1, *ustring2;

	    ustring1 = TclGetUnicodeFromObj_(valuePtr, &length);
	    ustring2 = TclGetUnicodeFromObj_(value2Ptr, &length2);
	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
		    nocase);
	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
	    unsigned char *bytes1, *bytes2;

	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);

     */

    if (flushcode != 0) {
	/* flushcode has precedence, if available */
	result = flushcode;
    }
    if ((result != 0) && (result != TCL_ERROR) && (interp != NULL)
	    && 0 == TclGetCharLength(Tcl_GetObjResult(interp))) {
	Tcl_SetErrno(result);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(Tcl_PosixError(interp), -1));
    }
    if (result != 0) {
	return TCL_ERROR;
    }

	     * TODO: This cannot happen anymore.
	     *
	     * We read more chars than allowed.  Reset limits to prevent that
	     * and try again.  Don't forget the extra padding of TCL_UTF_MAX
	     * bytes demanded by the Tcl_ExternalToUtf() call!
	     */

	    dstLimit = TclUtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1);
	    statePtr->flags = savedFlags;
	    statePtr->inputEncodingFlags = savedIEFlags;
	    statePtr->inputEncodingState = savedState;
	    continue;
	}

	if (dstWrote == 0) {

MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclUniCharStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;

/*
 * Variables denoting the hash key types defined in the core.
 */

MODULE_SCOPE void	TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, int length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);


#if TCL_UTF_MAX > 3
    MODULE_SCOPE int *TclGetUnicodeFromObj_(Tcl_Obj *, int *);
    MODULE_SCOPE Tcl_Obj *TclNewUnicodeObj(const int *, int);
    MODULE_SCOPE void TclAppendUnicodeToObj(Tcl_Obj *, const int *, int);
    MODULE_SCOPE int TclUniCharNcasecmp(const int *, const int *, unsigned long);
    MODULE_SCOPE int TclUniCharCaseMatch(const int *, const int *, int);
    MODULE_SCOPE int TclUniCharNcmp(const int *, const int *, unsigned long);
#   undef Tcl_NumUtfChars
#   define Tcl_NumUtfChars TclNumUtfChars
#   undef Tcl_GetCharLength
#   define Tcl_GetCharLength TclGetCharLength
#   undef Tcl_UtfAtIndex
#   define Tcl_UtfAtIndex TclUtfAtIndex
#   undef Tcl_GetRange
#   define Tcl_GetRange TclGetRange
#   undef Tcl_GetUniChar
#   define Tcl_GetUniChar TclGetUniChar
#else
#   define tclUniCharStringType tclStringType
#   define TclGetUnicodeFromObj_ Tcl_GetUnicodeFromObj
#   define TclNewUnicodeObj Tcl_NewUnicodeObj
#   define TclAppendUnicodeToObj Tcl_AppendUnicodeToObj
#   define TclUniCharNcasecmp Tcl_UniCharNcasecmp
#   define TclUniCharCaseMatch Tcl_UniCharCaseMatch
#   define TclUniCharNcmp Tcl_UniCharNcmp
#   undef TclNumUtfChars
#   define TclNumUtfChars Tcl_NumUtfChars
#   undef TclGetCharLength
#   define TclGetCharLength Tcl_GetCharLength
#   undef TclUtfAtIndex
#   define TclUtfAtIndex Tcl_UtfAtIndex
#   undef TclGetRange
#   define TclGetRange Tcl_GetRange
#   undef TclGetUniChar
#   define TclGetUniChar Tcl_GetUniChar
#endif


/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
 * optimization (fragile on changes) in one place.
 */

#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToChar16(str, chPtr))
#endif

/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfChars(int numChars, const char *bytes,
 *				int numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfCharsM(numChars, bytes, numBytes) \
    do { \
	int _count, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += TclNumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
    } while (0);

/*
 *----------------------------------------------------------------
 * Macro that encapsulates the logic that determines when it is safe to

	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasInternalRep(objPtr, type) \
	((objPtr)->typePtr == (type))
#define TclFetchInternalRep(objPtr, type) \
	(TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)




















/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to increment a namespace's export epoch
 * counter. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);
 *----------------------------------------------------------------

    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclByteArrayType);
    Tcl_RegisterObjType(&tclDoubleType);
#if (TCL_UTF_MAX < 4) || !defined(TCL_NO_DEPRECATED)
    Tcl_RegisterObjType(&tclStringType);
#endif
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

	    Tcl_AppendObjToObj(errorObj, argArray[i]);
	    Tcl_AppendToObj(errorObj, "\"", -1);
	    Tcl_SetObjResult(interp, errorObj);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (TclGetCharLength(fieldValues[0]) == 0)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}
	*startPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_so);
	*endPtr = TclUtfAtIndex(string, regexpPtr->matches[index].rm_eo);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * RegExpExecUniChar --

    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = TclGetUnicodeFromObj_(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;

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,
			    const Tcl_UniChar *unicode, int numChars);
static int		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);
#if (TCL_UTF_MAX) > 3 && !defined(TCL_NO_DEPRECATED)
static void		DupUTF16StringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static int		SetUTF16StringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfUTF16String(Tcl_Obj *objPtr);
#endif

#define ISCONTINUATION(bytes) (\
	((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
	&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))


/*
 * The structure below defines the string Tcl object type by means of
 * functions that can be invoked by generic object code.
 */

#if TCL_UTF_MAX < 4

#define tclUniCharStringType tclStringType
#define GET_UNICHAR_STRING GET_STRING
#define UniCharString String
#define UNICHAR_STRING_MAXCHARS STRING_MAXCHARS
#define uniCharStringAlloc stringAlloc
#define uniCharStringRealloc stringRealloc
#define uniCharStringAttemptAlloc stringAttemptAlloc
#define uniCharStringAttemptRealloc stringAttemptRealloc
#define uniCharStringCheckLimits stringCheckLimits
#define SET_UNICHAR_STRING SET_STRING
#define UNICHAR_STRING_SIZE STRING_SIZE

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

#else

#ifndef TCL_NO_DEPRECATED
const Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupUTF16StringInternalRep,	/* dupIntRepProc */
    UpdateStringOfUTF16String,	/* updateStringProc */
    SetUTF16StringFromAny		/* setFromAnyProc */
};
#endif

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

typedef struct {
    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. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} UniCharString;

#define UNICHAR_STRING_MAXCHARS \
    (int)(((size_t)UINT_MAX  - offsetof(UniCharString, unicode))/sizeof(Tcl_UniChar) - 1)
#define UNICHAR_STRING_SIZE(numChars) \
    (offsetof(UniCharString, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar)))
#define uniCharStringCheckLimits(numChars) \
    do {								\
	if ((numChars) < 0 || (numChars) > UNICHAR_STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		      UNICHAR_STRING_MAXCHARS);					\
	}								\
    } while (0)
#define uniCharStringAttemptAlloc(numChars) \
    (UniCharString *) attemptckalloc(UNICHAR_STRING_SIZE(numChars))
#define uniCharStringAlloc(numChars) \
    (UniCharString *) ckalloc(UNICHAR_STRING_SIZE(numChars))
#define uniCharStringRealloc(ptr, numChars) \
    (UniCharString *) ckrealloc((ptr), UNICHAR_STRING_SIZE(numChars))
#define uniCharStringAttemptRealloc(ptr, numChars) \
    (UniCharString *) attemptckrealloc((ptr), UNICHAR_STRING_SIZE(numChars))
#define GET_UNICHAR_STRING(objPtr) \
    ((UniCharString *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_UNICHAR_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL),			\
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))


#ifndef TCL_NO_DEPRECATED
static void
DupUTF16StringInternalRep(
    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
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    size_t size = offsetof(String, unicode) + (((srcStringPtr->allocated) + 1U) * sizeof(unsigned short));
    String *copyStringPtr = (String *)ckalloc(size);
    memcpy(copyStringPtr, srcStringPtr, size);

    SET_STRING(copyPtr, copyStringPtr);
    copyPtr->typePtr = &tclStringType;
}

static int
SetUTF16StringFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    if (!TclHasInternalRep(objPtr, &tclStringType)) {
	Tcl_DString ds;

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

	(void) TclGetString(objPtr);
	TclFreeInternalRep(objPtr);

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

	Tcl_DStringInit(&ds);
	unsigned short *utf16string = Tcl_UtfToChar16DString(objPtr->bytes, objPtr->length, &ds);
	int size = Tcl_DStringLength(&ds);
	String *stringPtr = (String *)ckalloc((offsetof(String, unicode) + sizeof(unsigned short)) + size);

	memcpy(stringPtr->unicode, utf16string, size);
	Tcl_DStringFree(&ds);
	size /= sizeof(unsigned short);
	stringPtr->unicode[size] = 0;

	stringPtr->numChars = size;
	stringPtr->allocated = size;
	stringPtr->maxChars = size;
	stringPtr->hasUnicode = 1;
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;
}

static void
UpdateStringOfUTF16String(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    Tcl_DString ds;
    String *stringPtr = GET_STRING(objPtr);

	Tcl_DStringInit(&ds);
	const char *string = Tcl_Char16ToUtfDString(stringPtr->unicode, stringPtr->numChars, &ds);

	char *bytes = (char *)ckalloc(Tcl_DStringLength(&ds) + 1U);
	memcpy(bytes, string, Tcl_DStringLength(&ds));
	bytes[Tcl_DStringLength(&ds)] = 0;
	objPtr->bytes = bytes;
	objPtr->length = Tcl_DStringLength(&ds);
	Tcl_DStringFree(&ds);
}
#endif

#endif

/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
 *
 *   Attempt to allocate 2 * (originalLength + appendLength)

    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
     *	flag || objPtr->bytes != NULL
     */

    UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
    char *ptr = NULL;
    int attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {

    Tcl_Obj *objPtr,
    int needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     *	needed < UNICHAR_STRING_MAXCHARS
     */

    UniCharString *ptr = NULL, *stringPtr = GET_UNICHAR_STRING(objPtr);
    int attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	if (needed <= UNICHAR_STRING_MAXCHARS / 2) {
	    attempt = 2 * needed;
	    ptr = uniCharStringAttemptRealloc(stringPtr, attempt);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = UNICHAR_STRING_MAXCHARS - needed;
	    unsigned int extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = uniCharStringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = uniCharStringRealloc(stringPtr, attempt);
    }
    stringPtr = ptr;
    stringPtr->maxChars = attempt;
    SET_UNICHAR_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --
 *

 * Side effects:
 *	Memory allocated for new object and copy of Unicode argument.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
Tcl_Obj *
Tcl_NewUnicodeObj(
    const unsigned short *unicode,	/* The unicode string used to initialize the
				 * new object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);

    String *stringPtr = (String *)ckalloc((offsetof(String, unicode)
	    + sizeof(unsigned short)) + numChars * sizeof(unsigned short));
    memcpy(stringPtr->unicode, unicode, numChars);
    stringPtr->unicode[numChars] = 0;

    stringPtr->numChars = numChars;
    stringPtr->allocated = numChars;
    stringPtr->maxChars = numChars;
    stringPtr->hasUnicode = 1;
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;

    return objPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCharLength --
 *
 *	Get the length of the Unicode string from the Tcl object.
 *
 * Results:
 *	Pointer to unicode string representing the unicode object.
 *
 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

int
TclGetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    UniCharString *stringPtr;
    int numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {

    }

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

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

    /*
     * If numChars is unknown, compute it.
     */

    if (numChars == -1) {
	TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    return numChars;
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
#undef Tcl_GetCharLength
int
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    int numChars;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object;
     * we don't need to convert to a string to perform the get-length operation.
     *
     * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {

	(void) Tcl_GetByteArrayFromObj(objPtr, &numChars);
    } else {
	Tcl_GetString(objPtr);
	numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
    }
    return numChars;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclCheckEmptyString --
 *
 *	Determine whether the string value of an object is or would be the
 *	empty string, without generating a string representation.

 *
 * Side effects:
 *	Fills unichar with the index'th Unicode character.
 *
 *----------------------------------------------------------------------
 */

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
#undef Tcl_GetUniChar
int
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    String *stringPtr;

	return (int) bytes[index];
    }

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

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

    if (index >= stringPtr->numChars) {
	return -1;
    }
    ch = stringPtr->unicode[index];
    /* See: bug [11ae2be95dac9417] */
    if ((ch & 0xF800) == 0xD800) {
	if (ch & 0x400) {
	    if ((index > 0)
		    && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
		ch = -1; /* low surrogate preceded by high surrogate */
	    }
	} else if ((++index < stringPtr->numChars)
		&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
	    /* high surrogate followed by low surrogate */
	    ch = (((ch & 0x3FF) << 10) |
			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
	}
    }
    return ch;
}
#endif

int
TclGetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    int index)			/* Get the index'th Unicode character. */
{
    UniCharString *stringPtr;
    int ch, length;

    if (index < 0) {
	return -1;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	return (int) bytes[index];
    }

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

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

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    return (unsigned char) objPtr->bytes[index];
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }

    if (index >= stringPtr->numChars) {
	return -1;
    }
    ch = stringPtr->unicode[index];
#if TCL_UTF_MAX < 4

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

#undef Tcl_GetUnicodeFromObj
#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetUnicode
unsigned short *
Tcl_GetUnicode(
    Tcl_Obj *objPtr)		/* The object to find the unicode string
				 * for. */
{
    return TclGetUnicodeFromObj(objPtr, NULL);
}
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj/TclGetUnicodeFromObj --

 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
TclGetUnicodeFromObj_(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    int *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    UniCharString *stringPtr;

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

    if (stringPtr->hasUnicode == 0) {
	FillUnicodeRep(objPtr);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }

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

#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
unsigned short *
Tcl_GetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    int *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

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






    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->unicode;
}
#endif

unsigned short *
TclGetUnicodeFromObj(
    Tcl_Obj *objPtr,		/* The object to find the unicode string
				 * for. */
    size_t *lengthPtr)		/* If non-NULL, the location where the string
				 * rep's unichar length should be stored. If
				 * NULL, no length is stored. */
{
    String *stringPtr;

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






    if (lengthPtr != NULL) {

	*lengthPtr = stringPtr->numChars;



    }
    return stringPtr->unicode;
}

/*
 *----------------------------------------------------------------------
 *

 *
 * Side effects:
 *	Changes the internal rep of "objPtr" to the String type.
 *
 *----------------------------------------------------------------------
 */

#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
#undef Tcl_GetRange
Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    int first,			/* First index of the range. */
    int last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    int length;

    if (first < 0) {
	first = 0;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);

	if (last < 0 || last >= length) {
	    last = length - 1;
	}
	if (last < first) {
	    TclNewObj(newObjPtr);
	    return newObjPtr;
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    int numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);

    if (last >= numChars) {
	last = numChars - 1;
    }
    if (last < first) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
    const char *begin = Tcl_UtfAtIndex(objPtr->bytes, first);
    const char *end = Tcl_UtfAtIndex(objPtr->bytes, last + 1);
    return Tcl_NewStringObj(begin, end - begin);
}
#endif

Tcl_Obj *
TclGetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    int first,			/* First index of the range. */
    int last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    UniCharString *stringPtr;
    int length;

    if (first < 0) {
	first = 0;
    }

    /*

    }

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

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

    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == -1) {
	    TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    if (last < 0 || last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	    if (last < first) {
		TclNewObj(newObjPtr);
		return newObjPtr;
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1);

	    /*
	     * Since we know the char length of the result, store it.
	     */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_UNICHAR_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	    return newObjPtr;
	}
	FillUnicodeRep(objPtr);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }
    if (last < 0 || last >= stringPtr->numChars) {
	last = stringPtr->numChars - 1;
    }
    if (last < first) {
	TclNewObj(newObjPtr);
	return newObjPtr;
    }
#if TCL_UTF_MAX < 4
    /* See: bug [11ae2be95dac9417] */
    if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
    }
    if ((last + 1 < stringPtr->numChars)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return TclNewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --
 *

Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    int length)			/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    UniCharString *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense. This is probably the
	 * result of overflowing the signed integer range.
	 */

	Tcl_Panic("Tcl_SetObjLength: negative length requested: "
		"%d (integer overflow?)", length);
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

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

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

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	uniCharStringCheckLimits(length);
	if (length > stringPtr->maxChars) {
	    stringPtr = uniCharStringRealloc(stringPtr, length);
	    SET_UNICHAR_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string
	 */

Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
				 * currently be shared. */
    int length)			/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    UniCharString *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense. This is probably the
	 * result of overflowing the signed integer range.
	 */

	return 0;
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
	return 1;
    }

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

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*

	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	if (length > UNICHAR_STRING_MAXCHARS) {
	    return 0;
	}
	if (length > stringPtr->maxChars) {
	    stringPtr = uniCharStringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_UNICHAR_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	}

	/*
	 * Mark the new end of the unicode string.
	 */

 *
 * Side effects:
 *	Memory allocated for new "String" internal rep.
 *
 *---------------------------------------------------------------------------
 */

#if !defined(TCL_NO_DEPRECATED)
void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const unsigned short *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;

    if (numChars < 0) {
        numChars = 0;

        if (unicode) {
    	while (numChars >= 0 && unicode[numChars] != 0) {
    	    numChars++;
    	}
        }
        stringCheckLimits(numChars);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

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

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(unsigned char));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->hasUnicode = 1;

    TclInvalidateStringRep(objPtr);
    stringPtr->allocated = numChars;
}
#endif

static int
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    int numChars = 0;

    if (unicode) {
	while (numChars >= 0 && unicode[numChars] != 0) {
	    numChars++;
	}
    }
    uniCharStringCheckLimits(numChars);
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    UniCharString *stringPtr;

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

    uniCharStringCheckLimits(numChars);
    stringPtr = uniCharStringAlloc(numChars);
    SET_UNICHAR_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclUniCharStringType;

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->hasUnicode = 1;

				 * bytes up to a NUL byte are available. */
    int limit,			/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    UniCharString *stringPtr;
    int toCopy = 0;
    int eLen = 0;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {

     */

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

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

    /* If appended string starts with a continuation byte or a lower surrogate,
     * force objPtr to unicode representation. See [7f1162a867] */
    if (bytes && ISCONTINUATION(bytes)) {
	TclGetUnicodeFromObj_(objPtr, NULL);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }
    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_UNICHAR_STRING(objPtr);
    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}


 * Side effects:
 *	Invalidates the string rep and creates a new Unicode string.
 *
 *----------------------------------------------------------------------
 */

void
TclAppendUnicodeToObj(
    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". */
{
    UniCharString *stringPtr;

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

    if (length == 0) {
	return;
    }

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

    /*
     * If objPtr has a valid Unicode rep, then append the "unicode" to the
     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
     * objPtr's string rep.
     */

    if (stringPtr->hasUnicode) {
	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}

#if TCL_UTF_MAX > 3 && !defined(TCL_NO_DEPRECATED)
void
Tcl_AppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const unsigned short *unicode,	/* The unicode string to append to the
				 * object. */
    int length)			/* Number of chars in "unicode". */
{
    String *stringPtr;

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

    if (length == 0) {
	return;
    }

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



    memcpy(&stringPtr->unicode[stringPtr->numChars], unicode, length);

    stringPtr->maxChars = stringPtr->allocated = stringPtr->numChars += length;
    stringPtr->unicode[stringPtr->numChars] = 0;


    SET_STRING(objPtr, stringPtr);
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToObj --
 *
 *	This function appends the string rep of one object to another.
 *	"objPtr" cannot be a shared object.

 */

void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    UniCharString *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...
     */

    }

    /*
     * Must append as strings.
     */

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

    /* If appended string starts with a continuation byte or a lower surrogate,
     * force objPtr to unicode representation. See [7f1162a867]
     * This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
    if (ISCONTINUATION(TclGetString(appendObjPtr))) {
	TclGetUnicodeFromObj_(objPtr, NULL);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }
    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    if (stringPtr->hasUnicode) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) {
	    Tcl_UniChar *unicode =
		    TclGetUnicodeFromObj_(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    numChars = stringPtr->numChars;
    if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclUniCharStringType)) {
	UniCharString *appendStringPtr = GET_UNICHAR_STRING(appendObjPtr);

	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if (numChars >= 0 && appendNumChars >= 0) {

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    int appendNumChars)		/* Number of chars of "unicode" to append. */
{
    UniCharString *stringPtr;
    int numChars;

    if (appendNumChars < 0) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

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

    /*
     * If not enough space has been allocated for the unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;
    uniCharStringCheckLimits(numChars);

    if (numChars > stringPtr->maxChars) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 */

	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_UNICHAR_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	 */

	if (offset >= 0) {
	    unicode = stringPtr->unicode + offset;

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    int numChars)		/* Number of chars of "unicode" to convert. */
{
    UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);

    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

    if (stringPtr->numChars != -1) {
	stringPtr->numChars += numChars;
    }
}

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    int numBytes)		/* Number of bytes of "bytes" to convert. */
{
    UniCharString *stringPtr;

    if (numBytes == 0) {
	return;
    }

    ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
    TclInvalidateStringRep(objPtr);
    stringPtr = GET_UNICHAR_STRING(objPtr);
    stringPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUtfRep --

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    int numBytes)		/* Number of bytes of "bytes" to append. */
{
    UniCharString *stringPtr;
    int newLength, oldLength;

    if (numBytes == 0) {
	return;
    }

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

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;
    if (numBytes > INT_MAX - oldLength) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    newLength = numBytes + oldLength;

    stringPtr = GET_UNICHAR_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
	int offset = -1;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.

	switch (ch) {
	case '\0':
	    msg = "format string ended in middle of field specifier";
	    errCode = "INCOMPLETE";
	    goto errorMsg;
	case 's':
	    if (gotPrecision) {
		numChars = TclGetCharLength(segment);
		if (precision < numChars) {
		    if (precision < 1) {
			TclNewObj(segment);
		    } else {
			segment = TclGetRange(segment, 0, precision - 1);
		    }
		    numChars = precision;
		    Tcl_IncrRefCount(segment);
		    allocSegment = 1;
		}
	    }
	    break;

		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += TclGetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }

		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += TclGetCharLength(segment);
		    if (length < width) {
			segmentLimit -= width - length;
		    }
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }

			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
	    }
	    goto error;
	}

	if (width>0 && numChars<0) {
	    numChars = TclGetCharLength(segment);
	}
	if (!gotMinus && width>0) {
	    if (numChars < width) {
		limit -= width - numChars;
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);

 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    unsigned int *sizePtr)
{
    UniCharString *stringPtr;

    if (!TclHasInternalRep(objPtr, &tclUniCharStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_UNICHAR_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}

/*
 *---------------------------------------------------------------------------
 *

     * 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 (TclHasInternalRep(objPtr, &tclUniCharStringType)) {
	    UniCharString *stringPtr = GET_UNICHAR_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. */
	TclGetUnicodeFromObj_(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. */

		(count - done) * length);
    } else if (unichar) {
	/*
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = TclNewUnicodeObj(TclGetUnicodeFromObj_(objPtr, NULL), 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_Z_MODIFIER "u bytes",
			UNICHAR_STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendUnicodeToObj(objResultPtr, TclGetUnicodeFromObj_(objResultPtr, NULL),
		(count - done) * length);
    } else {
	/*
	 * Efficiently concatenate string reps.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {

		 * Non-empty string rep. Not a pure bytearray, so we won't
		 * create a pure bytearray.
		 */

	 	binary = 0;
	 	if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
	 	    forceUniChar = 1;
	 	} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclUniCharStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    binary = 0;
	    if (TclHasInternalRep(objPtr, &tclUniCharStringType)) {
		/* Have a pure Unicode value; ask to preserve it */
		requestUniChar = 1;
	    } else {
		/* Have another type; prevent shimmer */
		allowUniChar = 0;
	    }
	}

	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int numChars;

		TclGetUnicodeFromObj_(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    } else if (numChars > INT_MAX - length) {
			goto overflow;
		    }

	if (inPlace && !Tcl_IsShared(*objv)) {
	    int start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    TclGetUnicodeFromObj_(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			UNICHAR_STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetUnicodeFromObj_(objResultPtr, NULL) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = TclNewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			UNICHAR_STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetUnicodeFromObj_(objResultPtr, NULL);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		int more;
		Tcl_UniChar *src = TclGetUnicodeFromObj_(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if (TclHasInternalRep(value1Ptr, &tclUniCharStringType)
		&& TclHasInternalRep(value2Ptr, &tclUniCharStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, &s1len);
		s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)(void *)TclUniCharNcasecmp;
	    } else {
		s1len = TclGetCharLength(value1Ptr);
		s2len = TclGetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
		    s1 = value1Ptr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) TclGetUnicodeFromObj_(value1Ptr, NULL);
		    s2 = (char *) TclGetUnicodeFromObj_(value2Ptr, NULL);
		    if (
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
			    1
#else
			    checkEq
#endif
			    ) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t)(void *)TclUniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {

Tcl_Obj *
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int start)
{
    int lh, ln = TclGetCharLength(needle);
    Tcl_Obj *result;
    int value = -1;
    Tcl_UniChar *checkStr, *endStr, *uh, *un;

    if (start < 0) {
	start = 0;
    }

     * code pathway, or if it does we want that to be for some values
     * we explicitly decline to support.  Getting there will involve
     * locking down in practice more firmly just what encodings produce
     * what supported results for the objPtr->bytes values.  For now,
     * do only the well-defined Tcl_UniChar array search.
     */

    un = TclGetUnicodeFromObj_(needle, &ln);
    uh = TclGetUnicodeFromObj_(haystack, &lh);
    if ((lh < ln) || (start > lh - ln)) {
	/* Don't start the loop if there cannot be a valid answer */
	goto firstEnd;
    }
    endStr = uh + lh;

    for (checkStr = uh + start; checkStr + ln <= endStr; checkStr++) {

Tcl_Obj *
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    int last)
{
    int lh, ln = TclGetCharLength(needle);
    Tcl_Obj *result;
    int value = -1;
    Tcl_UniChar *checkStr, *uh, *un;

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!

		goto lastEnd;
	    }
	    check--;
	}
	goto lastEnd;
    }

    uh = TclGetUnicodeFromObj_(haystack, &lh);
    un = TclGetUnicodeFromObj_(needle, &ln);

    if (last >= lh) {
	last = lh - 1;
    }
    if (last + 1 < ln) {
	/* Don't start the loop if there cannot be a valid answer */
	goto lastEnd;

}

Tcl_Obj *
TclStringReverse(
    Tcl_Obj *objPtr,
    int flags)
{
    UniCharString *stringPtr;
    Tcl_UniChar ch = 0;
    int inPlace = flags & TCL_STRING_IN_PLACE;
#if TCL_UTF_MAX < 4
    int needFlip = 0;
#endif

    if (TclIsPureByteArray(objPtr)) {
	int numBytes;
	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(TclGetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }

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

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = TclGetUnicodeFromObj_(objPtr, NULL);
	stringPtr = GET_UNICHAR_STRING(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;
	Tcl_UniChar *to;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = TclNewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = TclGetUnicodeFromObj_(objPtr, NULL);
	    stringPtr = GET_UNICHAR_STRING(objPtr);
	    while (--src >= from) {
#if TCL_UTF_MAX < 4
		ch = *src;
		if ((ch & 0xF800) == 0xD800) {
		    needFlip = 1;
		}
		*to++ = ch;

     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

    /* The traditional implementation... */
    {
	int numChars;
	Tcl_UniChar *ustring = TclGetUnicodeFromObj_(objPtr, &numChars);

	/* TODO: Is there an in-place option worth pursuing here? */

	result = TclNewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < numChars) {
	    TclAppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    }
}


 */

static void
FillUnicodeRep(
    Tcl_Obj *objPtr)		/* The object in which to fill the unicode
				 * rep. */
{
    UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);

    ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
	    stringPtr->numChars);
}

static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    int numBytes,
    int numAppendChars)
{
    UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);
    int needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    }
    if (numAppendChars == -1) {
	TclNumUtfCharsM(numAppendChars, bytes, numBytes);
    }
    needed = numOrigChars + numAppendChars;
    uniCharStringCheckLimits(needed);

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
	stringPtr = GET_UNICHAR_STRING(objPtr);
    }

    stringPtr->hasUnicode = 1;
    if (bytes) {
	stringPtr->numChars = needed;
    } else {
	numAppendChars = 0;

static void
DupStringInternalRep(
    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
				 * currently have an internal rep.*/
{
    UniCharString *srcStringPtr = GET_UNICHAR_STRING(srcPtr);
    UniCharString *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 (srcStringPtr->hasUnicode) {
	int copyMaxChars;

	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
	    copyMaxChars = 2 * srcStringPtr->numChars;
	} else {
	    copyMaxChars = srcStringPtr->maxChars;
	}
	copyStringPtr = uniCharStringAttemptAlloc(copyMaxChars);
	if (copyStringPtr == NULL) {
	    copyMaxChars = srcStringPtr->numChars;
	    copyStringPtr = uniCharStringAlloc(copyMaxChars);
	}
	copyStringPtr->maxChars = copyMaxChars;
	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
		srcStringPtr->numChars * sizeof(Tcl_UniChar));
	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
    } else {
	copyStringPtr = uniCharStringAlloc(0);
	copyStringPtr->maxChars = 0;
	copyStringPtr->unicode[0] = 0;
    }
    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
    copyStringPtr->numChars = srcStringPtr->numChars;

    /*
     * 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->bytes ? copyPtr->length : 0;

    SET_UNICHAR_STRING(copyPtr, copyStringPtr);
    copyPtr->typePtr = &tclUniCharStringType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetStringFromAny --
 *

 */

static int
SetStringFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    if (!TclHasInternalRep(objPtr, &tclUniCharStringType)) {
	UniCharString *stringPtr = uniCharStringAlloc(0);

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

	(void) TclGetString(objPtr);
	TclFreeInternalRep(objPtr);

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

	stringPtr->numChars = -1;
	stringPtr->allocated = objPtr->length;
	stringPtr->maxChars = 0;
	stringPtr->hasUnicode = 0;
	SET_UNICHAR_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclUniCharStringType;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

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

static void
UpdateStringOfString(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    UniCharString *stringPtr = GET_UNICHAR_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.

{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

    int i, origLength, size = 0;
    char *dst;
    UniCharString *stringPtr = GET_UNICHAR_STRING(objPtr);

    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;

}

/*
 *----------------------------------------------------------------------
 *
 * FreeStringInternalRep --
 *
 *	Deallocate the storage associated with a (UniChar)String data object's internal
 *	representation.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees memory.

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





 */

typedef struct {
    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. */
    int allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    int maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    unsigned short unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_MAXCHARS \
    (int)(((size_t)UINT_MAX - offsetof(String, unicode))/sizeof(unsigned short) - 1)
#define STRING_SIZE(numChars) \
    (offsetof(String, unicode) + sizeof(unsigned short) + ((numChars) * sizeof(unsigned short)))
#define stringCheckLimits(numChars) \
    do {								\
	if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) {		\
	    Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		      STRING_MAXCHARS);					\
	}								\
    } while (0)

#undef Tcl_AppendUnicodeToObj
#undef Tcl_NewUnicodeObj
#undef Tcl_SetUnicodeObj
#undef Tcl_UniCharNcasecmp
#undef Tcl_UniCharCaseMatch
#undef Tcl_UniCharLen
#undef Tcl_UniCharNcmp
#undef Tcl_GetRange
#undef Tcl_GetUniChar
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef Tcl_SetExitProc

#define TclStaticLibrary Tcl_StaticLibrary
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#undef Tcl_MacOSXOpenBundleResources
#undef TclWinConvertWSAError
#undef TclWinConvertError
#undef Tcl_GetCharLength
#undef Tcl_UtfAtIndex

#if defined(_WIN32) || defined(__CYGWIN__)
#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError
#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError
#endif


#if TCL_UTF_MAX > 3 && defined(TCL_NO_DEPRECATED)
static void uniCodePanic(void) {
    Tcl_Panic("Tcl is compiled without the the UTF16 compatibility layer (-DTCL_NO_DEPRECATED)");
}
#   define Tcl_GetUnicode (unsigned short *(*)(Tcl_Obj *))(void *)uniCodePanic
#   define Tcl_GetUnicodeFromObj (unsigned short *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const unsigned short *, int))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic
#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const unsigned short *, int))(void *)uniCodePanic
#   define Tcl_UtfAtIndex (const char *(*)(const char *, int))(void *)uniCodePanic
#   define Tcl_GetCharLength (int(*)(Tcl_Obj *))(void *)uniCodePanic
#   define Tcl_UniCharNcmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
#   define Tcl_UniCharNcasecmp (int(*)(const unsigned short *, const unsigned short *, unsigned long))(void *)uniCodePanic
#   define Tcl_UniCharCaseMatch (int(*)(const unsigned short *, const unsigned short *, int))(void *)uniCodePanic
#   define Tcl_GetRange (Tcl_Obj *(*)(Tcl_Obj *, int, int))(void *)uniCodePanic
#   define Tcl_GetUniChar (int(*)(Tcl_Obj *, int))(void *)uniCodePanic
#endif

#define TclUtfCharComplete UtfCharComplete
#define TclUtfNext UtfNext
#define TclUtfPrev UtfPrev

static int TclUtfCharComplete(const char *src, int length) {

#   undef TclpGmtime
#   define TclpGmtime 0
#   define TclpLocaltime_unix 0
#   define TclpGmtime_unix 0
#   define Tcl_SetExitProc 0
#   define Tcl_SetPanicProc 0
#   define Tcl_FindExecutable 0

#if TCL_UTF_MAX < 4
#   define Tcl_GetUnicode 0
#   define Tcl_AppendUnicodeToObj 0
#   define Tcl_UniCharCaseMatch 0
#   define Tcl_UniCharNcasecmp 0
#   define Tcl_UniCharNcmp 0
#endif
#   undef Tcl_StringMatch
#   define Tcl_StringMatch 0

    0, /* 662 */
    0, /* 663 */
    0, /* 664 */
    0, /* 665 */
    0, /* 666 */
    0, /* 667 */
    Tcl_UniCharLen, /* 668 */
    TclNumUtfChars, /* 669 */
    TclGetCharLength, /* 670 */
    TclUtfAtIndex, /* 671 */
    TclGetRange, /* 672 */
    TclGetUniChar, /* 673 */
};

/* !END!: Do not edit above this line. */

 * Copyright © 2003 Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#undef BUILD_tcl
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#ifdef TCL_NO_DEPRECATED
#   define TCL_UTF_MAX 4
#else
#   define TCL_NO_DEPRECATED
#endif
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"

static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int numBytes;
    char *bytes;
    const char *result, *first;
    char buffer[32];
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {

 * Copyright © 1995-1998 Sun Microsystems, Inc.
 * Copyright © 1999 Scriptics Corporation.
 * Copyright © 2005 Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
#undef BUILD_tcl
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else

	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (objv[2]->typePtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
	} else {
	    typeName = objv[2]->typePtr->name;
	    if (!strcmp(typeName, "utf32string")) typeName = "string";
#ifndef TCL_WIDE_INT_IS_LONG
	    else if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
	}
    } else if (strcmp(subCmd, "refcount") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}

static int
TeststringobjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    unsigned short *unicode;
    size_t varIndex;
    int size, option, i;
    Tcl_WideInt length;
#define MAX_STRINGS 11
    const char *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;

		    ? varPtr[varIndex]->length : -1);
	    break;
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		const Tcl_ObjType *objType = Tcl_GetObjType("string");
		if (objType != NULL) {
		    Tcl_ConvertToType(NULL, varPtr[varIndex], objType);

		    strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		    length = (int) strPtr->allocated;
		} else {
		    length = -1;
		}
	    } else {
		length = -1;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */
	    if (objc != 4) {

	    }
	    break;
	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		const Tcl_ObjType *objType = Tcl_GetObjType("string");
		if (objType != NULL) {
		    Tcl_ConvertToType(NULL, varPtr[varIndex],objType);

		    strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		    length = strPtr->maxChars;
		} else {
		    length = -1;
		}
	    } else {
		length = -1;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10:			/* appendself */
	    if (objc != 4) {

 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
TclNumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    int length)		/* The length of the string in bytes, or -1
			 * for strlen(string). */
{
    Tcl_UniChar ch = 0;
    int i = 0;

	    }
	    i++;
	}
    }
    return i;
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
#undef Tcl_NumUtfChars
int
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    int length)		/* The length of the string in bytes, or -1
			 * for strlen(string). */
{
    unsigned short ch = 0;
    int i = 0;

    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while ((*src != '\0') && (i < INT_MAX)) {
	    src += Tcl_UtfToChar16(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */

	/* Pointer to the end of string. Never read endPtr[0] */
	const char *endPtr = src + length;
	/* Pointer to last byte where optimization still can be used */
	const char *optPtr = endPtr - 4;

	/*
	 * Optimize away the call in this loop. Justified because...
	 * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr)
	 * By initialization above (endPtr - optPtr) = TCL_UTF_MAX
	 * So (endPtr - src) >= TCL_UTF_MAX, and passing that to
	 * Tcl_UtfCharComplete we know will cause return of 1.
	 */
	while (src <= optPtr
		/* && Tcl_UtfCharComplete(src, endPtr - src) */ ) {
	    src += Tcl_UtfToChar16(src, &ch);
	    i++;
	}
	/* Loop over the remaining string where call must happen */
	while (src < endPtr) {
	    if (Tcl_UtfCharComplete(src, endPtr - src)) {
		src += Tcl_UtfToChar16(src, &ch);
	    } else {
		/*
		 * src points to incomplete UTF-8 sequence
		 * Treat first byte as character and count it
		 */
		src++;
	    }
	    i++;
	}
    }
    return i;
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfFindFirst --
 *
 *	Returns a pointer to the first occurrence of the given Unicode character
 *	in the NULL-terminated UTF-8 string. The NULL terminator is considered

 */

int
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    int index)		/* The position of the desired character. */
{
    unsigned short ch = 0;
    int i = 0;

    if (index < 0) {
	return -1;
    }
    while (index-- > 0) {
	i = Tcl_UtfToChar16(src, &ch);
	src += i;
    }

    if ((ch >= 0xD800) && (i < 3)) {
	/* Index points at character following high Surrogate */
	return -1;
    }

    TclUtfToUCS4(src, &i);
    return i;
}

/*
 *---------------------------------------------------------------------------
 *

 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#if TCL_UTF_MAX < 4
#   undef Tcl_UtfToUniChar
#   define Tcl_UtfToUniChar Tcl_UtfToChar16
#endif

const char *
TclUtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    int index)		/* The position of the desired character. */
{
	Tcl_UniChar ch = 0;
    int len = 0;

    while (index-- > 0) {
	len = (Tcl_UtfToUniChar)(src, &ch);
	src += len;
    }
#if TCL_UTF_MAX < 4
    if ((ch >= 0xD800) && (len < 3)) {
	/* Index points at character following high Surrogate */
	src += (Tcl_UtfToUniChar)(src, &ch);
    }
#endif
    return src;
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
#undef Tcl_UtfAtIndex
const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    int index)		/* The position of the desired character. */
{
    unsigned short ch = 0;
    int len = 0;

    while (index-- > 0) {
	len = Tcl_UtfToChar16(src, &ch);
	src += len;
    }
    if ((ch >= 0xD800) && (len < 3)) {
	/* Index points at character following high Surrogate */
	src += Tcl_UtfToChar16(src, &ch);
    }
    return src;
}


#endif

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfBackslash --
 *
 *	Figure out how to handle a backslash sequence.
 *

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));

#else /* !WORDS_BIGENDIAN */
    /*
     * We can't simply call memcmp() because that is not lexically correct.
     */

    for ( ; numChars != 0; ucs++, uct++, numChars--) {
	if (*ucs != *uct) {
	    return (*ucs - *uct);
	}
    }
    return 0;
#endif /* WORDS_BIGENDIAN */
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
int
Tcl_UniCharNcmp(
    const unsigned short *ucs,	/* Unicode string to compare to uct. */
    const unsigned short *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));

#else /* !WORDS_BIGENDIAN */
    /*
     * We can't simply call memcmp() because that is not lexically correct.
     */

    for ( ; numChars != 0; ucs++, uct++, numChars--) {
	if (*ucs != *uct) {
	    /* special case for handling upper surrogates */
	    if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
		return 1;
	    } else if (((*uct & 0xFC00) == 0xD800)) {
		return -1;
	    }

	    return (*ucs - *uct);
	}
    }
    return 0;
#endif /* WORDS_BIGENDIAN */
}
#endif
/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharNcasecmp --
 *
 *	Compare at most numChars unichars of string ucs to string uct case
 *	insensitive. Both ucs and uct are assumed to be at least numChars
 *	unichars long.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    int lcs = Tcl_UniCharToLower(*ucs);
	    int lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
		return (lcs - lct);
	    }
	}
    }
    return 0;
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
int
Tcl_UniCharNcasecmp(
    const unsigned short *ucs,	/* Unicode string to compare to uct. */
    const unsigned short *uct,	/* Unicode string ucs is compared to. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    unsigned short lcs = Tcl_UniCharToLower(*ucs);
	    unsigned short lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
	    /* special case for handling upper surrogates */
	    if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
		return 1;
	    } else if (((lct & 0xFC00) == 0xD800)) {
		return -1;
	    }

		return (lcs - lct);
	    }
	}
    }
    return 0;
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlnum --
 *
 *	Test if a character is an alphanumeric Unicode character.

 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharCaseMatch(
    const Tcl_UniChar *uniStr,	/* Unicode String. */
    const Tcl_UniChar *uniPattern,
				/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    int ch1 = 0, p;

    while (1) {
	p = *uniPattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,
	 * we succeeded. If we're at the end of the pattern but not at the end
	 * of the string, we failed.
	 */

	if (p == 0) {
	    return (*uniStr == 0);
	}
	if ((*uniStr == 0) && (p != '*')) {
	    return 0;
	}

	/*
	 * Check for a "*" as the next pattern character. It matches any
	 * substring. We handle this by skipping all the characters up to the
	 * next matching one in the pattern, and then calling ourselves
	 * recursively for each postfix of string, until either we match or we
	 * reach the end of the string.
	 */

	if (p == '*') {
	    /*
	     * Skip all successive *'s in the pattern
	     */

	    while (*(++uniPattern) == '*') {
		/* empty body */
	    }
	    p = *uniPattern;
	    if (p == 0) {
		return 1;
	    }
	    if (nocase) {
		p = Tcl_UniCharToLower(p);
	    }
	    while (1) {
		/*
		 * Optimization for matching - cruise through the string
		 * quickly if the next char in the pattern isn't a special
		 * character
		 */

		if ((p != '[') && (p != '?') && (p != '\\')) {
		    if (nocase) {
			while (*uniStr && (p != *uniStr)
				&& (p != Tcl_UniCharToLower(*uniStr))) {
			    uniStr++;
			}
		    } else {
			while (*uniStr && (p != *uniStr)) {
			    uniStr++;
			}
		    }
		}
		if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) {
		    return 1;
		}
		if (*uniStr == 0) {
		    return 0;
		}
		uniStr++;
	    }
	}

	/*
	 * Check for a "?" as the next pattern character. It matches any
	 * single character.
	 */

	if (p == '?') {
	    uniPattern++;
	    uniStr++;
	    continue;
	}

	/*
	 * Check for a "[" as the next pattern character. It is followed by a
	 * list of characters that are acceptable, or by a range (two
	 * characters separated by "-").
	 */

	if (p == '[') {
	    int startChar, endChar;

	    uniPattern++;
	    ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
	    uniStr++;
	    while (1) {
		if ((*uniPattern == ']') || (*uniPattern == 0)) {
		    return 0;
		}
		startChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
			: *uniPattern);
		uniPattern++;
		if (*uniPattern == '-') {
		    uniPattern++;
		    if (*uniPattern == 0) {
			return 0;
		    }
		    endChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
			    : *uniPattern);
		    uniPattern++;
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */
			break;
		    }
		} else if (startChar == ch1) {
		    break;
		}
	    }
	    while (*uniPattern != ']') {
		if (*uniPattern == 0) {
		    uniPattern--;
		    break;
		}
		uniPattern++;
	    }
	    uniPattern++;
	    continue;
	}

	/*
	 * If the next pattern character is '\', just strip off the '\' so we
	 * do exact matching on the character that follows.
	 */

	if (p == '\\') {
	    if (*(++uniPattern) == '\0') {
		return 0;
	    }
	}

	/*
	 * There's no special character. Just make sure that the next bytes of
	 * each string match.
	 */

	if (nocase) {
	    if (Tcl_UniCharToLower(*uniStr) !=
		    Tcl_UniCharToLower(*uniPattern)) {
		return 0;
	    }
	} else if (*uniStr != *uniPattern) {
	    return 0;
	}
	uniStr++;
	uniPattern++;
    }
}

#if (TCL_UTF_MAX > 3) && !defined(TCL_NO_DEPRECATED)
int
Tcl_UniCharCaseMatch(
    const unsigned short *uniStr,	/* Unicode String. */
    const unsigned short *uniPattern,
				/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    unsigned short ch1 = 0, p;

    while (1) {
	p = *uniPattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,
	 * we succeeded. If we're at the end of the pattern but not at the end

	/*
	 * Check for a "[" as the next pattern character. It is followed by a
	 * list of characters that are acceptable, or by a range (two
	 * characters separated by "-").
	 */

	if (p == '[') {
	    unsigned short startChar, endChar;

	    uniPattern++;
	    ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
	    uniStr++;
	    while (1) {
		if ((*uniPattern == ']') || (*uniPattern == 0)) {
		    return 0;

	} else if (*uniStr != *uniPattern) {
	    return 0;
	}
	uniStr++;
	uniPattern++;
    }
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * TclUniCharMatch --
 *
 *	See if a particular Unicode string matches a particular pattern.
 *	Allows case insensitivity. This is the Unicode equivalent of the char*

#if TCL_UTF_MAX < 4
int
TclUtfToUCS4(
    const char *src,	/* The UTF-8 string. */
    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented
			 * by the UTF-8 string. */
{
#   undef Tcl_UtfToUniChar
    return Tcl_UtfToUniChar(src, ucs4Ptr);
}

int
TclUniCharToUCS4(
    const Tcl_UniChar *src,	/* The Tcl_UniChar string. */
    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented

    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */

    if (TclHasInternalRep(strObj, &tclUniCharStringType) || (strObj->typePtr == NULL)) {
	Tcl_UniChar *udata, *uptn;

	udata = TclGetUnicodeFromObj_(strObj, &length);
	uptn  = TclGetUnicodeFromObj_(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = Tcl_GetByteArrayFromObj(strObj, &length);
	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

package require tcltests

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} {testobj deprecated} {
    set r 1
    foreach {t} {
	bytearray
	bytecode
	cmdName
	dict
	regexp

} -result 8
test string-4.16.$noComp {string first, normal string vs pure unicode string} -body {
    set s hello
    regexp ll $s m
    # Representation checks are canaries
    run {list [representationpoke $s] [representationpoke $m] \
	[string first $m $s]}
} -match glob -result {{*string 1} {*string 0} 2}
test string-4.17.$noComp {string first, corner case} -body {
    run {string first a aaa 4294967295}
} -result {-1}
test string-4.18.$noComp {string first, corner case} -body {
    run {string first a aaa -1}
} -result {0}
test string-4.19.$noComp {string first, corner case} -body {

catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint utf32 [expr {[string length [format %c 0x10000]] == 1}]

test stringObj-1.1 {string type registration} {testobj deprecated} {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1

test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""

    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 512]
    lappend result [teststringobj set 1 foo]	;# makes existing obj a string
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 512 foo string 2}

test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set 1 test
    teststringobj setlength 1 3
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {3 3 tes}
test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {testobj deprecated} {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj setlength 1 10
    list [teststringobj length 1] [teststringobj length2 1]
} {10 10}
test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set 1 abcdef
    teststringobj append 1 xyzq -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 10 abcdefxyzq}
test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {testobj deprecated} {
    testobj freeallvars
    testobj newobj 1
    teststringobj setlength 1 0
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}

test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} testobj {
    testobj freeallvars
    testintobj set2 1 43
    teststringobj append 1 xyz -1
    teststringobj get 1
} {43xyz}
test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} testobj {
    testobj freeallvars
    teststringobj set 1 {x y }
    teststringobj append 1 bbCCddEE 4
    teststringobj append 1 123 -1
    teststringobj get 1
} {x y bbCC123}
test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set 1 xyz
    teststringobj setlength 1 15
    teststringobj setlength 1 2
    set result {}
    teststringobj append 1 1234567890123 -1
    lappend result [teststringobj length 1] [teststringobj length2 1]
    teststringobj setlength 1 10
    teststringobj append 1 abcdef -1
    lappend result [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {15 15 16 16 xy12345678abcdef}

test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} testobj {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj appendstrings 1 xyz { 1234 } foo
    teststringobj get 1
} {a bxyz 1234 foo}

} {3 abc}
test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj appendstrings 1 { 123 } abcdefg
    list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {testobj utf32 deprecated} {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 123 abcdefg
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 10 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj deprecated} {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {10 10 ab34567890}
test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890x
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {11 11 ab34567890x}
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {testobj deprecated} {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length2 1] [teststringobj get 1]
} {0 {}}
test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
    testobj freeallvars
    teststringobj set2 1 [string replace abc 1 1 d]
    teststringobj appendstrings 1 foo bar soom
    teststringobj get 1
} adcfoobarsoom

test stringObj-7.1 {SetStringFromAny procedure} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set2 1 [list a b]
    teststringobj append 1 x -1
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {4 4 {a bx}}
test stringObj-7.2 {SetStringFromAny procedure, null object} {testobj deprecated} {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 {}
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj get 1]
} {0 0 {}}
test stringObj-7.3 {SetStringFromAny called with non-string obj} testobj {
    set x 2345
    list [incr x] [testobj objtype $x] [string index $x end] \
	    [testobj objtype $x]
} {2346 int 6 string}
test stringObj-7.4 {SetStringFromAny called with string obj} testobj {
    set x "abcdef"
    list [string length $x] [testobj objtype $x] \
	    [string length $x] [testobj objtype $x]
} {6 string 6 string}

test stringObj-8.1 {DupStringInternalRep procedure} {testobj utf32 deprecated} {
    testobj freeallvars
    teststringobj set 1 {}
    teststringobj append 1 abcde -1
    testobj duplicate 1 2
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj maxchars 1] [teststringobj get 1] \
	    [teststringobj length 2] [teststringobj length2 2] \
	    [teststringobj maxchars 2] [teststringobj get 2]
} {5 5 5 abcde 5 5 5 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\xEF\xBF\xAEghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\xAE\xBF\xEF"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
} "string string abc\xEF\xBF\xAEghi\xAE\xBF\xEF abc\xEF\xBF\xAEghi string string"

} -cleanup {
    unset -nocomplain foo
} -result {1 4}

test utf-20.1 {TclUniCharNcmp} utf32 {
    string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0]
} -1
test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} utf32 {
    set one [format %c 0xFFFF]
    set two [format %c 0x10000]
    set first [string compare $one $two]
    string range $one 0 0
    string range $two 0 0
    set second [string compare $one $two]
    expr {($first == $second) ? "agree" : "disagree"}

#
# NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform
# SDK (not expressly needed), run setenv.bat after
# vcvars32.bat according to the instructions for it.  This can also
# turn on the 64-bit compiler, if your SDK has it.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
#	OPTS=msvcrt,noembed,nothreads,pdbs,profile,static,symbols,thrdalloc,time64bit,unchecked,utf16,none
#		Sets special options for the core.  The default is for none.
#		Any combination of the above may be used (comma separated).
#		'none' will over-ride everything to nothing.
#
# 		noembed   = Without this option, the Tcl core library scripts
#			    are embedded into the executable if "static" is
#			    specified in OPTS, or into the DLL otherwise. If

#		symbols   = Adds symbols for step debugging.
#		thrdalloc = Use the thread allocator (shared global free pool).
#		time64bit = Forces a build using 64-bit time_t for 32-bit build
#			    (CRT library should support this).
#		unchecked = Allows a symbols build to not use the debug
#			    enabled runtime (msvcrt.dll not msvcrtd.dll
#			    or libcmt.lib not libcmtd.lib).
#		utf16     = Forces a build using UTF-16 representation internally.
#
#	STATS=compdbg,memdbg,none
#		Sets optional memory and bytecode compiler debugging code added
#		to the core.  The default is for none.  Any combination of the
#		above may be used (comma separated).  'none' will over-ride
#		everything to nothing.
#

# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
#           C runtime, 0 -> use the debug C runtime.
# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
#           configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
#           (CRT library should support this, not needed for Tcl 9.x)
# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended).

# Further, LINKERFLAGS are modified based on above.

# Default values for all the above
STATIC_BUILD	= 0
TCL_THREADS	= 1
DEBUG		= 0
SYMBOLS		= 0

!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif

!if [nmakehlp -f $(OPTS) "utf16"]
!message *** Force UTF-16 internally
TCL_UTF_MAX = 3
!endif
!endif

# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols

OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64=1
!endif

!if "$(TCL_MAJOR_VERSION)" == "8"
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif




# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS  = /D_ATL_XP_TARGETING
!endif
!if "$(TCL_UTF_MAX)" == "3"
OPTDEFINES	= $(OPTDEFINES) /DTCL_UTF_MAX=3
!endif

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \