Tcl Source Code

2013-05-19  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:     Fix for FreeBSD, and remove support for older
	* unix/configure:  FreeBSD versions. Patch by Pietro Cerutti.

2013-05-18  Donal K. Fellows  <[email protected]>

=> tcltest 2.3.5

2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)

2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)

--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---

\fB0\fR otherwise.
.SH "PORTABILITY ISSUES"
.TP
\fBUnix\fR\0\0\0\0\0\0\0
.
These commands always operate using the real user and group identifiers,
not the effective ones. 







.SH EXAMPLES
.PP
This procedure shows how to search for C files in a given directory
that have a correspondingly-named object file in the current
directory:
.PP
.CS

.sp
.VS "TIP 404"
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.VE "TIP 404"
.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR
.BE
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
Text strings are defined in a
.QW "message catalog"

catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
have an even number of elements and is in the form {\fIsrc-string
translate-string\fR ?\fIsrc-string translate-string ...\fR?}
\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
.VE "TIP 404"
.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR
.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale.  The default action is to return

\fIsrc-string\fR.  This procedure can be redefined by the
application, for example to log error messages for each unknown
string.  The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR.  The return value
of \fB::msgcat::mcunknown\fR is used as the return value for the call
to \fB::msgcat::mc\fR.  
.SH "LOCALE SPECIFICATION"
.PP

	case LSEARCH_INLINE:		/* -inline */
	    inlineReturn = 1;
	    break;
	case LSEARCH_INTEGER:		/* -integer */
	    dataType = INTEGER;
	    break;
	case LSEARCH_NOCASE:		/* -nocase */
	    strCmpFn = strcasecmp;
	    noCase = 1;
	    break;
	case LSEARCH_NOT:		/* -not */
	    negatedMatch = 1;
	    break;
	case LSEARCH_REAL:		/* -real */
	    dataType = REAL;

		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {
			    match = (strcasecmp(bytes, patternBytes) == 0);
			} else {
			    match = (memcmp(bytes, patternBytes,
				    (size_t) length) == 0);
			}
		    }
		    break;

int
Tcl_LsortObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int i, j, index, indices, length, nocase = 0, sortMode, indexc;

    int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    SortElement *elementArray, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define NUM_LISTS 30
    SortElement *subList[NUM_LISTS+1];

	    long a;

	    if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done1;
	    }
	    elementArray[i].collationKey.intValue = a;
	} else if (sortInfo.sortMode == SORTMODE_REAL) {
	    double a;

	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
		    &a) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done1;
	    }

	Tcl_SetObjResult(interp, resultPtr);
    }

  done1:
    TclStackFree(interp, elementArray);

  done:
    if (sortInfo.sortMode == SORTMODE_COMMAND) {
	TclDecrRefCount(sortInfo.compareCmdPtr);
	TclDecrRefCount(listObj);
	sortInfo.compareCmdPtr = NULL;
    }
  done2:
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);

{
    int order = 0;

    if (infoPtr->sortMode == SORTMODE_ASCII) {
	order = strcmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
	order = strcasecmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
	order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
	long a, b;

	     * General options.
	     */

	case OPT_LAST:
	    i++;
	    goto finishedOptions;
	case OPT_NOCASE:
	    strCmpFn = strcasecmp;
	    noCase = 1;
	    break;

	    /*
	     * Handle the different switch mode options.
	     */

			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static ClientData	DupForeachInfo(ClientData clientData);
static void		FreeForeachInfo(ClientData clientData);
static void		PrintForeachInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static int		PushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *simpleVarNamePtr, int *isScalarPtr,
			    int line, int *clNext);
static int		CompileEachloopCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr, int collect);
static int		CompileDictEachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr, int collect);


/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);
 */

#define CompileWord(envPtr, tokenPtr, interp, word) \
    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
		(tokenPtr)[1].size), (envPtr));				\
    } else {								\
	envPtr->line = mapPtr->loc[eclIndex].line[word];		\
	envPtr->clNext = mapPtr->loc[eclIndex].next[word];		\
	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
		(envPtr));						\
    }

/*
 * TIP #280: Remember the per-word line information of the current command. An
 * index is used instead of a pointer as recursive compilation may reallocate,
 * i.e. move, the array. This is also the reason to save the nuloc now, it may
 * change during the course of the function.
 *
 * Macro to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
    int eclIndex = mapPtr->nuloc - 1

#define SetLineInformation(word) \
    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])

/*
 * Often want to issue one of two versions of an instruction based on whether
 * the argument will fit in a single byte or not. This makes it much clearer.
 */

#define Emit14Inst(nm,idx,envPtr) \
    if (idx <= 255) {							\
	TclEmitInstInt1(nm##1,idx,envPtr);				\
    } else {								\
	TclEmitInstInt4(nm##4,idx,envPtr);				\
    }

/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
#define TCL_NO_ELEMENT 2	/* Do not push the array element. */

/*
 * The structures below define the AuxData types defined in this file.
 */

const AuxDataType tclForeachInfoType = {
    "ForeachInfo",		/* name */
    DupForeachInfo,		/* dupProc */

    ForeachInfo *infoPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &simpleVarName, &isScalar, 1);
    if (!isScalar) {
	return TCL_ERROR;
    }
    dataTokenPtr = TokenAfter(varTokenPtr);
    literalObj = Tcl_NewObj();
    isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
    isDataValid = (isDataLiteral
	    && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
    isDataEven = (isDataValid && (len & 1) == 0);


















    /*
     * Special case: literal empty value argument is just an "ensure array"
     * operation.
     */

    if (isDataEven && len == 0) {
	if (localIndex >= 0) {
	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
	} else {
	    TclEmitOpcode(  INST_DUP,				envPtr);
	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
	    savedStackDepth = envPtr->currStackDepth;
	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
	    envPtr->currStackDepth = savedStackDepth;
	    TclEmitOpcode(  INST_POP,				envPtr);
	}
	PushLiteral(envPtr, "", 0);
	goto done;
    }

    /*
     * Special case: literal odd-length argument is always an error.
     */

    if (isDataValid && !isDataEven) {
	savedStackDepth = envPtr->currStackDepth;
	PushLiteral(envPtr, "list must have an even number of elements",
		strlen("list must have an even number of elements"));
	PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
		strlen("-errorCode {TCL ARGUMENT FORMAT}"));
	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
	TclEmitInt4(		0,				envPtr);
	envPtr->currStackDepth = savedStackDepth;
	PushLiteral(envPtr, "", 0);
	goto done;
    }

    /*
     * Prepare for the internal foreach.
     */

	 * containing an invalid literal; with valid list literals, we've
	 * already checked (worth it because literals are a very common
	 * use-case with [array set]).
	 */

	TclEmitOpcode(	INST_DUP,				envPtr);
	TclEmitOpcode(	INST_LIST_LENGTH,			envPtr);
	PushLiteral(envPtr, "1", 1);
	TclEmitOpcode(	INST_BITAND,				envPtr);
	offsetFwd = CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
	savedStackDepth = envPtr->currStackDepth;
	PushLiteral(envPtr, "list must have an even number of elements",
		strlen("list must have an even number of elements"));
	PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
		strlen("-errorCode {TCL ARGUMENT FORMAT}"));
	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
	TclEmitInt4(		0,				envPtr);
	envPtr->currStackDepth = savedStackDepth;
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
    }
    Emit14Inst(		INST_STORE_SCALAR, dataVar,		envPtr);

	envPtr->currStackDepth = savedStackDepth;
	TclEmitOpcode(	INST_POP,				envPtr);
    }
    if (!isDataLiteral) {
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		dataVar,			envPtr);
    }
    PushLiteral(envPtr,	"", 0);
  done:
    Tcl_DecrRefCount(literalObj);
    return TCL_OK;
}

int
TclCompileArrayUnsetCmd(

	TclEmitInstInt1(INST_JUMP_FALSE1, 6,			envPtr);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt1(INST_UNSET_STK, 1,			envPtr);
	TclEmitInstInt1(INST_JUMP1, 3,				envPtr);
	envPtr->currStackDepth = savedStackDepth;
	TclEmitOpcode(	INST_POP,				envPtr);
    }
    PushLiteral(envPtr,	"", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileBreakCmd --

    }

    /*
     * Emit a break instruction.
     */

    TclEmitOpcode(INST_BREAK, envPtr);
    PushLiteral(envPtr, "", 0);	/* Evil hack! */
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileCatchCmd --

	 * Special case when neither result nor options are being saved. In
	 * that case, we can skip quite a bit of the command epilogue; all we
	 * have to do is drop the result and push the return code (and, of
	 * course, finish the catch context).
	 */

	TclEmitOpcode(		INST_POP,			envPtr);
	PushLiteral(envPtr, "0", 1);
	TclEmitInstInt1(	INST_JUMP1, 3,			envPtr);
	envPtr->currStackDepth = savedStackDepth;
	ExceptionRangeTarget(envPtr, range, catchOffset);
	TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
	ExceptionRangeEnds(envPtr, range);
	TclEmitOpcode(		INST_END_CATCH,			envPtr);

    }

    /*
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
     * and jump around the "error case" code.
     */

    PushLiteral(envPtr, "0", 1);
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
    /* Stack at this point: ?script? <mark> result TCL_OK */

    /* 
     * Emit the "error case" epilogue. Push the interpreter result and the
     * return code.
     */

    }

    /*
     * Emit a continue instruction.
     */

    TclEmitOpcode(INST_CONTINUE, envPtr);
    PushLiteral(envPtr, "", 0);	/* Evil hack! */
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --

  nonConstant:
    worker = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    if (worker < 0) {
	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    PushLiteral(envPtr,		"", 0);
    Emit14Inst(			INST_STORE_SCALAR, worker,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=1 ; i<parsePtr->numWords ; i+=2) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i+1);

    /*
     * Deal with some special edge cases. Note that in the case with one
     * argument, the only thing to do is to verify the dict-ness.
     */

    if (parsePtr->numWords < 2) {
	PushLiteral(envPtr, "", 0);
	return TCL_OK;
    } else if (parsePtr->numWords == 2) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
	return TCL_OK;

    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			workerIndex,		envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			infoIndex,		envPtr);
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);


    return TCL_OK;
}

int
TclCompileDictForCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */

     * Preparation complete; issue instructions. Note that this code issues
     * fixed-sized jumps. That simplifies things a lot!
     *
     * First up, initialize the accumulator dictionary if needed.
     */

    if (collect == TCL_EACH_COLLECT) {
	PushLiteral(envPtr, "", 0);
	Emit14Inst(	INST_STORE_SCALAR, collectVar,		envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
    }

    /*
     * Get the dictionary and start the iteration. No catching of errors at
     * this point.

    TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
	    envPtr->codeStart + endTargetOffset);
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(	INST_LOAD_SCALAR, collectVar,		envPtr);
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    return TCL_OK;
}

int
TclCompileDictUpdateCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */

		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in LVT with empty body.
		 */

		PushLiteral(envPtr, "", 0);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	} else {
	    if (gotPath) {
		/*
		 * Case: Path into dict in non-simple var with empty body.
		 */

		tokenPtr = varTokenPtr;
		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i-1);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in non-simple var with empty body.
		 */

		CompileWord(envPtr, varTokenPtr, interp, 0);
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	}
	envPtr->currStackDepth = savedStackDepth + 1;
	return TCL_OK;
    }

    /*

	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else {
	Emit14Inst(		INST_LOAD_SCALAR, dictVar,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Now the body of the [dict with].

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (parsePtr->numWords > 3) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }

    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    messageTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushLiteral(envPtr, "-code error -level 0", 20);
    CompileWord(envPtr, messageTokenPtr, interp, 1);
    TclEmitOpcode(INST_RETURN_STK, envPtr);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

/*

    ExceptionRangeTarget(envPtr, nextRange, breakOffset);

    /*
     * The for command's result is an empty string.
     */

    envPtr->currStackDepth = savedStackDepth;
    PushLiteral(envPtr, "", 0);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

    }

    /*
     * Create temporary variable to capture return values from loop body.
     */
     
    if (collect == TCL_EACH_COLLECT) {
	PushLiteral(envPtr, "", 0);
	Emit14Inst(		INST_STORE_SCALAR, collectVar,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    envPtr->currStackDepth = savedStackDepth;
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(		INST_LOAD_SCALAR, collectVar,	envPtr);
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
    } else {
	PushLiteral(envPtr, "", 0);
    }
    envPtr->currStackDepth = savedStackDepth + 1;

  done:
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	if (varvList[loopIndex] != NULL) {
	    ckfree(varvList[loopIndex]);

	/*
	 * EVIL HACK! Force there to be a string representation in the case
	 * where there's just a "%s" in the format; case covered by the test
	 * format-20.1 (and it is horrible...)
	 */

	TclEmitOpcode(INST_DUP, envPtr);
	PushLiteral(envPtr, "", 0);
	TclEmitOpcode(INST_STR_EQ, envPtr);
	TclEmitOpcode(INST_POP, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name is
 *	necessary (append, lappend, set).
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
PushVarName(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *simpleVarNamePtr,	/* Must not be NULL. */
    int *isScalarPtr,		/* Must not be NULL. */

	if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
	    if (elNameChars) {
		envPtr->line = line;
		envPtr->clNext = clNext;
		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
			envPtr);
	    } else {
		PushLiteral(envPtr, "", 0);
	    }
	}
    } else {
	/*
	 * The var name isn't simple: compile and push it.
	 */

 */

static void		CompileReturnInternal(CompileEnv *envPtr,
			    unsigned char op, int code, int level,
			    Tcl_Obj *returnOpts);
static int		IndexTailVarIfKnown(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);
static int		PushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *simpleVarNamePtr, int *isScalarPtr,
			    int line, int *clNext);

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);
 */

#define CompileWord(envPtr, tokenPtr, interp, word) \
    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
		(tokenPtr)[1].size), (envPtr));				\
    } else {								\
	envPtr->line = mapPtr->loc[eclIndex].line[word];		\
	envPtr->clNext = mapPtr->loc[eclIndex].next[word];		\
	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
		(envPtr));						\
    }

/*
 * TIP #280: Remember the per-word line information of the current command. An
 * index is used instead of a pointer as recursive compilation may reallocate,
 * i.e. move, the array. This is also the reason to save the nuloc now, it may
 * change during the course of the function.
 *
 * Macro to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
    int eclIndex = mapPtr->nuloc - 1

#define SetLineInformation(word) \
    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])

/*
 * Often want to issue one of two versions of an instruction based on whether
 * the argument will fit in a single byte or not. This makes it much clearer.
 */

#define Emit14Inst(nm,idx,envPtr) \
    if (idx <= 255) {							\
	TclEmitInstInt1(nm##1,idx,envPtr);				\
    } else {								\
	TclEmitInstInt4(nm##4,idx,envPtr);				\
    }

/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
#define TCL_NO_ELEMENT 2	/* Do not push the array element. */

/*
 *----------------------------------------------------------------------
 *
 * TclCompileGlobalCmd --
 *
 *	Procedure called to compile the "global" command.

	return TCL_ERROR;
    }

    /*
     * Push the namespace
     */

    PushLiteral(envPtr, "::", 2);

    /*
     * Loop over the variables.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {

    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIfCmd --

	}
    } else {
	/*
	 * No else clause: the "if" command's result is an empty string.
	 */

	if (compileScripts) {
	    PushLiteral(envPtr, "", 0);
	}
    }

    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

    Tcl_Obj *listObj, *objPtr;

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushLiteral(envPtr, "", 0);
	return TCL_OK;
    }

    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

     * is worth trying to do that given current knowledge.
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (guaranteedDropAll) {
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	PushLiteral(envPtr, "", 0);
    } else {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx1,	envPtr);
	TclEmitInt4(		idx2,				envPtr);
    }
    return TCL_OK;
}


    /*
     * Now we can compile using the same strategy as [namespace code]'s normal
     * implementation does internally. Note that we can't bind the namespace
     * name directly here, because TclOO plays complex games with namespaces;
     * the value needs to be determined at runtime for safety.
     */

    PushLiteral(envPtr,		"::namespace",		11);
    PushLiteral(envPtr,		"inscope",		7);
    TclEmitOpcode(		INST_NS_CURRENT,	envPtr);
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitInstInt4(		INST_LIST, 4,		envPtr);
    return TCL_OK;
}

int

    int off;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushLiteral(envPtr, "0", 1);
    PushLiteral(envPtr, "::", 2);
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
    off = CurrentOffset(envPtr);
    PushLiteral(envPtr, "1", 1);
    TclEmitOpcode(	INST_SUB,			envPtr);
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    TclEmitOpcode(	INST_STR_INDEX,			envPtr);
    PushLiteral(envPtr, ":", 1);
    TclEmitOpcode(	INST_STR_EQ,			envPtr);
    off = off - CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP_TRUE1, off,		envPtr);
    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
    return TCL_OK;
}

    }

    /*
     * Take care; only add 2 to found index if the string was actually found.
     */

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushLiteral(envPtr, "::", 2);
    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
    TclEmitOpcode(	INST_DUP,			envPtr);
    PushLiteral(envPtr, "0", 1);
    TclEmitOpcode(	INST_GE,			envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
    PushLiteral(envPtr, "2", 1);
    TclEmitOpcode(	INST_ADD,			envPtr);
    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
    PushLiteral(envPtr, "end", 3);
    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceUpvarCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */

    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

int
TclCompileNamespaceWhichCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command

	}

	if (len == 0) {
	    /*
	     * The semantics of regexp are always match on re == "".
	     */

	    PushLiteral(envPtr, "1", 1);
	    return TCL_OK;
	}

	/*
	 * Attempt to convert pattern to glob.  If successful, push the
	 * converted pattern as a literal.
	 */

     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int level, code, objc, size, status = TCL_OK;
    int numWords = parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    int savedStackDepth = envPtr->currStackDepth;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    DefineLineInformation;	/* TIP #280 */

    /*
     * Check for special case which can always be compiled:
     *	    return -options <opts> <msg>

	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);

	CompileWord(envPtr, optsTokenPtr, interp, 2);
	CompileWord(envPtr, msgTokenPtr,  interp, 3);
	TclEmitOpcode(INST_RETURN_STK, envPtr);
	envPtr->currStackDepth = savedStackDepth + 1;
	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    if (explicitResult) {
	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
    } else {
	/*
	 * No explict result argument, so default result is empty string.
	 */

	PushLiteral(envPtr, "", 0);
    }

    /*
     * Check for optimization: When [return] is in a proc, and there's no
     * enclosing [catch], and there are no return options, then the INST_DONE
     * instruction is equivalent, and may be more efficient.
     */

	    /*
	     * ... and there is no enclosing catch. Issue the maximally
	     * efficient exit instruction.
	     */

	    Tcl_DecrRefCount(returnOpts);
	    TclEmitOpcode(INST_DONE, envPtr);
	    envPtr->currStackDepth = savedStackDepth;
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {
	Tcl_DecrRefCount(returnOpts);
	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */

    CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;

  issueRuntimeReturn:
    /*
     * Assemble the option dictionary (as a list as that's good enough).
     */

    /*
     * Push the result.
     */

    if (explicitResult) {
	CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
    } else {
	PushLiteral(envPtr, "", 0);
    }

    /*
     * Issue the RETURN itself.
     */

    TclEmitOpcode(INST_RETURN_STK, envPtr);
    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,

	    CompileWord(envPtr, tokenPtr, interp, 1);
	    otherTokenPtr = TokenAfter(tokenPtr);
	    i = 4;
	} else {
	    if (!(numWords%2)) {
		return TCL_ERROR;
	    }
	    PushLiteral(envPtr, "1", 1);
	    otherTokenPtr = tokenPtr;
	    i = 3;
	}
    } else {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileVariableCmd --

	}
    }

    /*
     * Set the result to empty
     */

    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * IndexTailVarIfKnown --

     */

    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name is
 *	necessary (append, lappend, set).
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
PushVarName(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *simpleVarNamePtr,	/* Must not be NULL. */
    int *isScalarPtr,		/* Must not be NULL. */
    int line,			/* Line the token starts on. */
    int *clNext)		/* Reference to offset of next hidden cont.
				 * line. */
{
    register const char *p;
    const char *name, *elName;
    register int i, n;
    Tcl_Token *elemTokenPtr = NULL;
    int nameChars, elNameChars, simpleVarName, localIndex;
    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    simpleVarName = 0;
    name = elName = NULL;
    nameChars = elNameChars = 0;
    localIndex = -1;

    /*
     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
     * curly braces surround the variable name. This really matters for array
     * elements to handle things like
     *    set {x($foo)} 5
     * which raises an undefined var error if we are not careful here.
     */

    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
	    (varTokenPtr->start[0] != '{')) {
	/*
	 * A simple variable name. Divide it up into "name" and "elName"
	 * strings. If it is not a local variable, look it up at runtime.
	 */

	simpleVarName = 1;

	name = varTokenPtr[1].start;
	nameChars = varTokenPtr[1].size;
	if (name[nameChars-1] == ')') {
	    /*
	     * last char is ')' => potential array reference.
	     */

	    for (i=0,p=name ; i<nameChars ; i++,p++) {
		if (*p == '(') {
		    elName = p + 1;
		    elNameChars = nameChars - i - 2;
		    nameChars = i;
		    break;
		}
	    }

	    if ((elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = elNameChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = 1;
	    }
	}
    } else if (((n = varTokenPtr->numComponents) > 1)
	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
	    && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
	/*
	 * Check for parentheses inside first token.
	 */

	simpleVarName = 0;
	for (i = 0, p = varTokenPtr[1].start;
		i < varTokenPtr[1].size; i++, p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    int remainingChars;

	    /*
	     * Check the last token: if it is just ')', do not count it.
	     * Otherwise, remove the ')' and flag so that it is restored at
	     * the end.
	     */

	    if (varTokenPtr[n].size == 1) {
		n--;
	    } else {
		varTokenPtr[n].size--;
		removedParen = n;
	    }

	    name = varTokenPtr[1].start;
	    nameChars = p - varTokenPtr[1].start;
	    elName = p + 1;
	    remainingChars = (varTokenPtr[2].start - p) - 1;
	    elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;

	    if (remainingChars) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */

		memcpy(elemTokenPtr+1, varTokenPtr+2,
			(n-1) * sizeof(Tcl_Token));
	    } else {
		/*
		 * Use the already available tokens.
		 */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;
	    }
	}
    }

    if (simpleVarName) {
	/*
	 * See whether name has any namespace separators (::'s).
	 */

	int hasNsQualifiers = 0;

	for (i = 0, p = name;  i < nameChars;  i++, p++) {
	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
		hasNsQualifiers = 1;
		break;
	    }
	}

	/*
	 * Look up the var name's index in the array of local vars in the proc
	 * frame. If retrieving the var's value and it doesn't already exist,
	 * push its name and look it up at runtime.
	 */

	if (!hasNsQualifiers) {
	    localIndex = TclFindCompiledLocal(name, nameChars,
		    1, envPtr);
	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
		/*
		 * We'll push the name.
		 */

		localIndex = -1;
	    }
	}
	if (localIndex < 0) {
	    PushLiteral(envPtr, name, nameChars);
	}

	/*
	 * Compile the element script, if any, and only if not inhibited. [Bug
	 * 3600328]
	 */

	if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
	    if (elNameChars) {
		envPtr->line = line;
		envPtr->clNext = clNext;
		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
			envPtr);
	    } else {
		PushLiteral(envPtr, "", 0);
	    }
	}
    } else {
	/*
	 * The var name isn't simple: compile and push it.
	 */

	envPtr->line = line;
	envPtr->clNext = clNext;
	CompileTokens(envPtr, varTokenPtr, interp);
    }

    if (removedParen) {
	varTokenPtr[removedParen].size++;
    }
    if (allocedTokens) {
	TclStackFree(interp, elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 */

static ClientData	DupJumptableInfo(ClientData clientData);
static void		FreeJumptableInfo(ClientData clientData);
static void		PrintJumptableInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static int		PushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *simpleVarNamePtr, int *isScalarPtr,
			    int line, int *clNext);
static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, const char *identity,
			    int instruction, CompileEnv *envPtr);
static int		CompileComparisonOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,

			    Tcl_Token *finallyToken);
static int		IssueTryInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    int numHandlers, int *matchCodes,
			    Tcl_Obj **matchClauses, int *resultVarIndices,
			    int *optionVarIndices, Tcl_Token **handlerTokens);

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);
 */

#define CompileWord(envPtr, tokenPtr, interp, word) \
    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
		(tokenPtr)[1].size), (envPtr));				\
    } else {								\
	envPtr->line = mapPtr->loc[eclIndex].line[word];		\
	envPtr->clNext = mapPtr->loc[eclIndex].next[word];		\
	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
		(envPtr));						\
    }

/*
 * TIP #280: Remember the per-word line information of the current command. An
 * index is used instead of a pointer as recursive compilation may reallocate,
 * i.e. move, the array. This is also the reason to save the nuloc now, it may
 * change during the course of the function.
 *
 * Macro to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
    int eclIndex = mapPtr->nuloc - 1

#define SetLineInformation(word) \
    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])

/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*
 * The structures below define the AuxData types defined in this file.
 */

const AuxDataType tclJumptableInfoType = {
    "JumptableInfo",		/* name */
    DupJumptableInfo,		/* dupProc */

#define OP14(name,val1,val2) \
    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define BODY(token,index) \
    SetLineInformation((index));CompileBody(envPtr,(token),interp)
#define PUSH(str) \
    PushLiteral(envPtr,(str),strlen(str))
#define JUMP(var,name) \
    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
#define FIXJUMP(var) \
    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define LOAD(idx) \
    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \

     * is possible to get to an INST_CONCAT1 or INST_DONE without enough
     * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
     * identifying a script that could trigger this case.
     */

    tokenPtr = parse.tokenPtr;
    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
	PushLiteral(envPtr, "", 0);
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	int length, literal, catchRange, breakJump;
	char buf[TCL_UTF_MAX];

	 * computations for stack depth requirements have been decrementing
	 * for every one.  However, we know that every branch actually taken
	 * only encounters some of those instructions.  No branch passes
	 * through them all.  So, we now have a stack requirements estimate
	 * that is too low.  Here we manually fix that up.
	 */

	TclAdjustStackDepth(5, envPtr);

	/* OK destination */
	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
	}
	if (count > 1) {

		    if (bodyToken[i]->size == 0) {
			/*
			 * The semantics of regexps are that they always match
			 * when the RE == "".
			 */

			PushLiteral(envPtr, "1", 1);
			break;
		    }

		    /*
		     * Attempt to convert pattern to glob. If successful, push
		     * the converted pattern.
		     */

     * clause (in which case it will already be gone due to the code at the
     * start of processing an arm, guaranteed) and make the result of the
     * command an empty string.
     */

    if (!foundDefault) {
	OP(	POP);
	PushLiteral(envPtr, "", 0);
    }

    /*
     * Do jump fixups for arms that were executed. First, fill in the jumps of
     * all jumps that don't point elsewhere to point to here.
     */

     * now.
     */

    if (!foundDefault) {
	envPtr->currStackDepth = savedStackDepth;
	TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
		envPtr->codeStart+jumpToDefault+1);
	PushLiteral(envPtr, "", 0);
    }

    /*
     * No more instructions to be issued; everything that needs to jump to the
     * end of the command is fixed up at this point.
     */

    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PUSH(				buf);
	OP(				EQ);
	JUMP(notCodeJumpSource,		JUMP_FALSE4);
	if (matchClauses[i]) {

	    Tcl_ListObjLength(NULL, matchClauses[i], &len);

	    /*
	     * Match the errorcode according to try/trap rules.
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    PUSH(			TclGetString(matchClauses[i]));

	    OP(				STR_EQ);
	    JUMP(notECJumpSource,	JUMP_FALSE4);
	} else {
	    notECJumpSource = -1; /* LINT */
	}
	OP(				POP);

	addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
	forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    sprintf(buf, "%d", matchCodes[i]);
	    OP(				DUP);
	    PUSH(			buf);
	    OP(				EQ);
	    JUMP(notCodeJumpSource,	JUMP_FALSE4);
	    if (matchClauses[i]) {

		Tcl_ListObjLength(NULL, matchClauses[i], &len);

		/*
		 * Match the errorcode according to try/trap rules.
		 */

		LOAD(			optionsVar);
		PUSH(			"-errorcode");
		OP4(			DICT_GET, 1);
		TclAdjustStackDepth(-1, envPtr);
		OP44(			LIST_RANGE_IMM, 0, len-1);
		PUSH(			TclGetString(matchClauses[i]));

		OP(			STR_EQ);
		JUMP(notECJumpSource,	JUMP_FALSE4);
	    } else {
		notECJumpSource = -1; /* LINT */
	    }

	    /*

	    } else {
		OP14(	UNSET_ARRAY, flags, localIndex);
	    }
	}

	varTokenPtr = TokenAfter(varTokenPtr);
    }
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileWhileCmd --

    /*
     * The while command's result is an empty string.
     */

  pushResult:
    envPtr->currStackDepth = savedStackDepth;
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileYieldCmd --

    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
	return TCL_ERROR;
    }

    if (parsePtr->numWords == 1) {
	PushLiteral(envPtr, "", 0);
    } else {
	DefineLineInformation;	/* TIP #280 */
	Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);

	CompileWord(envPtr, valueTokenPtr, interp, 1);
    }
    OP(		YIELD);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name is
 *	necessary (append, lappend, set).
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
PushVarName(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *simpleVarNamePtr,	/* Must not be NULL. */
    int *isScalarPtr,		/* Must not be NULL. */
    int line,			/* Line the token starts on. */
    int *clNext)		/* Reference to offset of next hidden cont.
				 * line. */
{
    register const char *p;
    const char *name, *elName;
    register int i, n;
    Tcl_Token *elemTokenPtr = NULL;
    int nameChars, elNameChars, simpleVarName, localIndex;
    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    simpleVarName = 0;
    name = elName = NULL;
    nameChars = elNameChars = 0;
    localIndex = -1;

    /*
     * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether
     * curly braces surround the variable name. This really matters for array
     * elements to handle things like
     *    set {x($foo)} 5
     * which raises an undefined var error if we are not careful here.
     */

    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
	    (varTokenPtr->start[0] != '{')) {
	/*
	 * A simple variable name. Divide it up into "name" and "elName"
	 * strings. If it is not a local variable, look it up at runtime.
	 */

	simpleVarName = 1;

	name = varTokenPtr[1].start;
	nameChars = varTokenPtr[1].size;
	if (name[nameChars-1] == ')') {
	    /*
	     * last char is ')' => potential array reference.
	     */

	    for (i=0,p=name ; i<nameChars ; i++,p++) {
		if (*p == '(') {
		    elName = p + 1;
		    elNameChars = nameChars - i - 2;
		    nameChars = i;
		    break;
		}
	    }

	    if ((elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = elNameChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = 1;
	    }
	}
    } else if (((n = varTokenPtr->numComponents) > 1)
	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
	    && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
	/*
	 * Check for parentheses inside first token.
	 */

	simpleVarName = 0;
	for (i = 0, p = varTokenPtr[1].start;
		i < varTokenPtr[1].size; i++, p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    int remainingChars;

	    /*
	     * Check the last token: if it is just ')', do not count it.
	     * Otherwise, remove the ')' and flag so that it is restored at
	     * the end.
	     */

	    if (varTokenPtr[n].size == 1) {
		n--;
	    } else {
		varTokenPtr[n].size--;
		removedParen = n;
	    }

	    name = varTokenPtr[1].start;
	    nameChars = p - varTokenPtr[1].start;
	    elName = p + 1;
	    remainingChars = (varTokenPtr[2].start - p) - 1;
	    elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2;

	    if (remainingChars) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */

		memcpy(elemTokenPtr+1, varTokenPtr+2,
			(n-1) * sizeof(Tcl_Token));
	    } else {
		/*
		 * Use the already available tokens.
		 */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;
	    }
	}
    }

    if (simpleVarName) {
	/*
	 * See whether name has any namespace separators (::'s).
	 */

	int hasNsQualifiers = 0;

	for (i = 0, p = name;  i < nameChars;  i++, p++) {
	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
		hasNsQualifiers = 1;
		break;
	    }
	}

	/*
	 * Look up the var name's index in the array of local vars in the proc
	 * frame. If retrieving the var's value and it doesn't already exist,
	 * push its name and look it up at runtime.
	 */

	if (!hasNsQualifiers) {
	    localIndex = TclFindCompiledLocal(name, nameChars,
		    1, envPtr);
	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
		/*
		 * We'll push the name.
		 */

		localIndex = -1;
	    }
	}
	if (localIndex < 0) {
	    PushLiteral(envPtr, name, nameChars);
	}

	/*
	 * Compile the element script, if any.
	 */

	if (elName != NULL) {
	    if (elNameChars) {
		envPtr->line = line;
		envPtr->clNext = clNext;
		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
			envPtr);
	    } else {
		PushLiteral(envPtr, "", 0);
	    }
	}
    } else {
	/*
	 * The var name isn't simple: compile and push it.
	 */

	envPtr->line = line;
	envPtr->clNext = clNext;
	CompileTokens(envPtr, varTokenPtr, interp);
    }

    if (removedParen) {
	varTokenPtr[removedParen].size++;
    }
    if (allocedTokens) {
	TclStackFree(interp, elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileUnaryOpCmd --
 *
 *	Utility routine to compile the unary operator commands.

    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords < 3) {
	PushLiteral(envPtr, "1", 1);
    } else if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	TclEmitOpcode(instruction, envPtr);
    } else if (envPtr->procPtr == NULL) {

    int words;

    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, "1", 1);
	words++;
    }
    while (--words > 1) {
	TclEmitOpcode(INST_EXPON, envPtr);
    }
    return TCL_OK;
}

	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }
    if (parsePtr->numWords == 2) {
	PushLiteral(envPtr, "1.0", 3);
    }
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (words <= 3) {
	TclEmitOpcode(INST_DIV, envPtr);

 * topmost stack elements.
 *
 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

const InstructionDesc const tclInstructionTable[] = {
    /* Name	      Bytes stackEffect #Opnds  Operand types */
    {"done",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
	/* Push object at ByteCode objArray[op1] */
    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
	/* Push object at ByteCode objArray[op4] */

	/* List containment: push [lsearch stktop stknext]>=0) */
    {"listNotIn",	  1,	-1,	   0,	{OPERAND_NONE}},
	/* List negated containment: push [lsearch stktop stknext]<0) */

    {"pushReturnOpts",	  1,	+1,	   0,	{OPERAND_NONE}},
	/* Push the interpreter's return option dictionary as an object on the
	 * stack. */
    {"returnStk",	  1,	-2,	   0,	{OPERAND_NONE}},
	/* Compiled [return]; options and result are on the stack, code and
	 * level are in the options. */

    {"dictGet",		  5,	INT_MIN,   1,	{OPERAND_UINT4}},
	/* The top op4 words (min 1) are a key path into the dictionary just
	 * below the keys on the stack, and all those values are replaced by
	 * the value read out of that key-path (like [dict get]).

#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);





MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
			    char *bytes, int length, int flags);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

 *			    Tcl_Interp *interp);
 */

#define CompileTokens(envPtr, tokenPtr, interp) \
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr));
/*
 * Convenience macro for use when pushing literals. The ANSI C "prototype" for
 * this macro is:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, int length);


 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))



/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TclDStringAppendToken(dsPtr, tokenPtr) \
    Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
#define TclRegisterDStringLiteral(envPtr, dsPtr) \
    TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
	    Tcl_DStringLength(dsPtr), /*flags*/ 0)





























































/*
 * DTrace probe macros (NOPs if DTrace support is not enabled).
 */

/*
 * Define the following macros to enable debug logging of the DTrace proc,
 * cmd, and inst probes. Note that this does _not_ require a platform with

    /*
     * Get a temporary filename to use, first to copy the file into, and then
     * to load.
     */

    copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);



    Tcl_IncrRefCount(copyToPtr);

    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
	/*
	 * We already know we can't use Tcl_FSLoadFile from this filesystem,
	 * and we must avoid a possible infinite loop. Try to delete the file

MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);

MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY

	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}









































/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToUpper --
 *
 *	Compute the uppercase equivalent of the given Unicode character.

#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.5.1

namespace eval msgcat {
    namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
	    mcunknown mcflset mcflmset

    # Records the current locale as passed to mclocale
    variable Locale ""

	return
    }
    #
    # On Windows or Cygwin, try to set locale depending on registry
    # settings, or fall back on locale of "C".
    #

    # First check registry value LocalName present from Windows Vista



    # which contains the local string as RFC5646, composed of:
    # [a-z]{2,3} : language
    # -[a-z]{4}  : script (optional, translated by table Latn->latin)
    # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
    # (-.*)* : variant, extension, private use (optional, not used)
    # Those are translated to local strings.
    # Examples: de-CH -> de_ch, sr-Latn-CS -> sr_cs@latin, es-419 -> es
    #
    set key {HKEY_CURRENT_USER\Control Panel\International}

    if {![catch {registry get $key LocaleName} localeName]
	    && [regexp {^([a-z]{2,3})(?:-([a-z]{4}))?(?:-([a-z]{2}))?(?:-.+)?$}\
	    [string tolower $localeName] match locale script territory]} {
	if {"" ne $territory} {
	    append locale _ $territory
	}
	set modifierDict [dict create latn latin cyrl cyrillic]
	if {[dict exists $modifierDict $script]} {
	    append locale @ [dict get $modifierDict $script]
	}
	if {![catch {mclocale [ConvertLocale $locale]}]} {
	    return
	}
    }


    # then check key locale which contains a numerical language ID
    if {[catch {
	set locale [registry get $key "locale"]
    }]} {
	mclocale C
	return
    }
    #

if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded msgcat 1.5.1 [list source [file join $dir msgcat.tcl]]

} [list ! ` AA c CC]
test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
    lsort -ascii -nocase {d e c b a d35 d300 100 20}
} {100 20 a b c d d300 d35 e}
test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
    lsort -ascii -nocase {d E c B a D35 d300 100 20}
} {100 20 a B c d d300 D35 E}










test cmdIL-5.1 {lsort with list style index} {
    lsort -ascii -decreasing -index {0 1} {
	{{Jim Alpha} 20000410}
	{{Joe Bravo} 19990320}
	{{Jacky Charlie} 19390911}
    }

	@echo "Installing package http 2.8.7 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.7.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.5.1 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.1.tm;
	@echo "Installing package tcltest 2.3.5 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.5.tm;

	@echo "Installing package platform 1.0.12 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

DefaultTempDir(void)
{
    const char *dir;
    struct stat buf;

    dir = getenv("TMPDIR");
    if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
	    && access(dir, W_OK)) {
	return dir;
    }

#ifdef P_tmpdir
    dir = P_tmpdir;
    if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) {
	return dir;
    }
#endif

    /*
     * Assume that the default location ("/tmp" if not overridden) is always
     * an existing writable directory; we've no recovery mechanism if it

	@echo "Installing package http 2.8.7 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.7.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.5.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.1.tm;
	@echo "Installing package tcltest 2.3.5 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.5.tm;
	@echo "Installing package platform 1.0.12 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";