new subtree for tcl/tk

1 files changed, 0 insertions, 4533 deletions

diff --git a/tcl8.6/generic/tclCmdIL.c b/tcl8.6/generic/tclCmdIL.c
deleted file mode 100644
index 0a1b4fe..0000000
--- a/tcl8.6/generic/tclCmdIL.c
+++ /dev/null
@@ -1,4533 +0,0 @@
-/*
- * tclCmdIL.c --
- *
- *	This file contains the top-level command routines for most of the Tcl
- *	built-in commands whose names begin with the letters I through L. It
- *	contains only commands in the generic core (i.e., those that don't
- *	depend much upon UNIX facilities).
- *
- * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1993-1997 Lucent Technologies.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2005 Donal K. Fellows.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-#include "tclRegexp.h"
-
-/*
- * During execution of the "lsort" command, structures of the following type
- * are used to arrange the objects being sorted into a collection of linked
- * lists.
- */
-
-typedef struct SortElement {
-    union {			/* The value that we sorting by. */
-	const char *strValuePtr;
-	Tcl_WideInt wideValue;
-	double doubleValue;
-	Tcl_Obj *objValuePtr;
-    } collationKey;
-    union {			/* Object being sorted, or its index. */
-	Tcl_Obj *objPtr;
-	int index;
-    } payload;
-    struct SortElement *nextPtr;/* Next element in the list, or NULL for end
-				 * of list. */
-} SortElement;
-
-/*
- * These function pointer types are used with the "lsearch" and "lsort"
- * commands to facilitate the "-nocase" option.
- */
-
-typedef int (*SortStrCmpFn_t) (const char *, const char *);
-typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
-
-/*
- * The "lsort" command needs to pass certain information down to the function
- * that compares two list elements, and the comparison function needs to pass
- * success or failure information back up to the top-level "lsort" command.
- * The following structure is used to pass this information.
- */
-
-typedef struct SortInfo {
-    int isIncreasing;		/* Nonzero means sort in increasing order. */
-    int sortMode;		/* The sort mode. One of SORTMODE_* values
-				 * defined below. */
-    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
-				 * SORTMODE_COMMAND. Pre-initialized to hold
-				 * base of command. */
-    int *indexv;		/* If the -index option was specified, this
-				 * holds the indexes contained in the list
-				 * supplied as an argument to that option.
-				 * NULL if no indexes supplied, and points to
-				 * singleIndex field when only one
-				 * supplied. */
-    int indexc;			/* Number of indexes in indexv array. */
-    int singleIndex;		/* Static space for common index case. */
-    int unique;
-    int numElements;
-    Tcl_Interp *interp;		/* The interpreter in which the sort is being
-				 * done. */
-    int resultCode;		/* Completion code for the lsort command. If
-				 * an error occurs during the sort this is
-				 * changed from TCL_OK to TCL_ERROR. */
-} SortInfo;
-
-/*
- * The "sortMode" field of the SortInfo structure can take on any of the
- * following values.
- */
-
-#define SORTMODE_ASCII		0
-#define SORTMODE_INTEGER	1
-#define SORTMODE_REAL		2
-#define SORTMODE_COMMAND	3
-#define SORTMODE_DICTIONARY	4
-#define SORTMODE_ASCII_NC	8
-
-/*
- * Magic values for the index field of the SortInfo structure. Note that the
- * index "end-1" will be translated to SORTIDX_END-1, etc.
- */
-
-#define SORTIDX_NONE	-1	/* Not indexed; use whole value. */
-#define SORTIDX_END	-2	/* Indexed from end. */
-
-/*
- * Forward declarations for procedures defined in this file:
- */
-
-static int		DictionaryCompare(const char *left, const char *right);
-static Tcl_NRPostProc	IfConditionCallback;
-static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-/* TIP #348 - New 'info' subcommand 'errorstack' */
-static int		InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-/* TIP #280 - New 'info' subcommand 'frame' */
-static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoNameOfExecutableCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
-			    SortInfo *infoPtr);
-static int		SortCompare(SortElement *firstPtr, SortElement *second,
-			    SortInfo *infoPtr);
-static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
-			    SortInfo *infoPtr);
-
-/*
- * Array of values describing how to implement each standard subcommand of the
- * "info" command.
- */
-
-static const EnsembleImplMap defaultInfoMap[] = {
-    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
-    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
-    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
-    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
-    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
-    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
-    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
-    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
-    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
-    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {NULL, NULL, NULL, NULL, NULL, 0}
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_IfObjCmd --
- *
- *	This procedure is invoked to process the "if" Tcl command. See the
- *	user documentation for details on what it does.
- *
- *	With the bytecode compiler, this procedure is only called when a
- *	command name is computed at runtime, and is "if" or the name to which
- *	"if" was renamed: e.g., "set z if; $z 1 {puts foo}"
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_IfObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRIfObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *boolObj;
-
-    if (objc <= 1) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"wrong # args: no expression after \"%s\" argument",
-		TclGetString(objv[0])));
-	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * At this point, objv[1] refers to the main expression to test. The
-     * arguments after the expression must be "then" (optional) and a script
-     * to execute if the expression is true.
-     */
-
-    TclNewObj(boolObj);
-    Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
-	    (ClientData) objv, INT2PTR(1), boolObj);
-    return Tcl_NRExprObj(interp, objv[1], boolObj);
-}
-
-static int
-IfConditionCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    int objc = PTR2INT(data[0]);
-    Tcl_Obj *const *objv = data[1];
-    int i = PTR2INT(data[2]);
-    Tcl_Obj *boolObj = data[3];
-    int value, thenScriptIndex = 0;
-    const char *clause;
-
-    if (result != TCL_OK) {
-	TclDecrRefCount(boolObj);
-	return result;
-    }
-    if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
-	TclDecrRefCount(boolObj);
-	return TCL_ERROR;
-    }
-    TclDecrRefCount(boolObj);
-
-    while (1) {
-	i++;
-	if (i >= objc) {
-	    goto missingScript;
-	}
-	clause = TclGetString(objv[i]);
-	if ((i < objc) && (strcmp(clause, "then") == 0)) {
-	    i++;
-	}
-	if (i >= objc) {
-	    goto missingScript;
-	}
-	if (value) {
-	    thenScriptIndex = i;
-	    value = 0;
-	}
-
-	/*
-	 * The expression evaluated to false. Skip the command, then see if
-	 * there is an "else" or "elseif" clause.
-	 */
-
-	i++;
-	if (i >= objc) {
-	    if (thenScriptIndex) {
-		/*
-		 * TIP #280. Make invoking context available to branch.
-		 */
-
-		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-			iPtr->cmdFramePtr, thenScriptIndex);
-	    }
-	    return TCL_OK;
-	}
-	clause = TclGetString(objv[i]);
-	if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) {
-	    break;
-	}
-	i++;
-
-	/*
-	 * At this point in the loop, objv and objc refer to an expression to
-	 * test, either for the main expression or an expression following an
-	 * "elseif". The arguments after the expression must be "then"
-	 * (optional) and a script to execute if the expression is true.
-	 */
-
-	if (i >= objc) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "wrong # args: no expression after \"%s\" argument",
-		    clause));
-	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-	    return TCL_ERROR;
-	}
-	if (!thenScriptIndex) {
-	    TclNewObj(boolObj);
-	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
-		    INT2PTR(i), boolObj);
-	    return Tcl_NRExprObj(interp, objv[i], boolObj);
-	}
-    }
-
-    /*
-     * Couldn't find a "then" or "elseif" clause to execute. Check now for an
-     * "else" clause. We know that there's at least one more argument when we
-     * get here.
-     */
-
-    if (strcmp(clause, "else") == 0) {
-	i++;
-	if (i >= objc) {
-	    goto missingScript;
-	}
-    }
-    if (i < objc - 1) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"wrong # args: extra words after \"else\" clause in \"if\" command",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-	return TCL_ERROR;
-    }
-    if (thenScriptIndex) {
-	/*
-	 * TIP #280. Make invoking context available to branch/else.
-	 */
-
-	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-		iPtr->cmdFramePtr, thenScriptIndex);
-    }
-    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
-
-  missingScript:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "wrong # args: no script following \"%s\" argument",
-	    TclGetString(objv[i-1])));
-    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_IncrObjCmd --
- *
- *	This procedure is invoked to process the "incr" Tcl command. See the
- *	user documentation for details on what it does.
- *
- *	With the bytecode compiler, this procedure is only called when a
- *	command name is computed at runtime, and is "incr" or the name to
- *	which "incr" was renamed: e.g., "set z incr; $z i -1"
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_IncrObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *newValuePtr, *incrPtr;
-
-    if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
-	return TCL_ERROR;
-    }
-
-    if (objc == 3) {
-	incrPtr = objv[2];
-    } else {
-	incrPtr = Tcl_NewIntObj(1);
-    }
-    Tcl_IncrRefCount(incrPtr);
-    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
-	    incrPtr, TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(incrPtr);
-
-    if (newValuePtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Set the interpreter's object result to refer to the variable's new
-     * value object.
-     */
-
-    Tcl_SetObjResult(interp, newValuePtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitInfoCmd --
- *
- *	This function is called to create the "info" Tcl command. See the user
- *	documentation for details on what it does.
- *
- * Results:
- *	Handle for the info command, or NULL on failure.
- *
- * Side effects:
- *	none
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-TclInitInfoCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
-{
-    return TclMakeEnsemble(interp, "info", defaultInfoMap);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoArgsCmd --
- *
- *	Called to implement the "info args" command that returns the argument
- *	list for a procedure. Handles the following syntax:
- *
- *	    info args procName
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoArgsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    register Interp *iPtr = (Interp *) interp;
-    const char *name;
-    Proc *procPtr;
-    CompiledLocal *localPtr;
-    Tcl_Obj *listObjPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname");
-	return TCL_ERROR;
-    }
-
-    name = TclGetString(objv[1]);
-    procPtr = TclFindProc(iPtr, name);
-    if (procPtr == NULL) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"\"%s\" isn't a procedure", name));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Build a return list containing the arguments.
-     */
-
-    listObjPtr = Tcl_NewListObj(0, NULL);
-    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
-	    localPtr = localPtr->nextPtr) {
-	if (TclIsVarArgument(localPtr)) {
-	    Tcl_ListObjAppendElement(interp, listObjPtr,
-		    Tcl_NewStringObj(localPtr->name, -1));
-	}
-    }
-    Tcl_SetObjResult(interp, listObjPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoBodyCmd --
- *
- *	Called to implement the "info body" command that returns the body for
- *	a procedure. Handles the following syntax:
- *
- *	    info body procName
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoBodyCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    register Interp *iPtr = (Interp *) interp;
-    const char *name;
-    Proc *procPtr;
-    Tcl_Obj *bodyPtr, *resultPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname");
-	return TCL_ERROR;
-    }
-
-    name = TclGetString(objv[1]);
-    procPtr = TclFindProc(iPtr, name);
-    if (procPtr == NULL) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"\"%s\" isn't a procedure", name));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Here we used to return procPtr->bodyPtr, except when the body was
-     * bytecompiled - in that case, the return was a copy of the body's string
-     * rep. In order to better isolate the implementation details of the
-     * compiler/engine subsystem, we now always return a copy of the string
-     * rep. It is important to return a copy so that later manipulations of
-     * the object do not invalidate the internal rep.
-     */
-
-    bodyPtr = procPtr->bodyPtr;
-    if (bodyPtr->bytes == NULL) {
-	/*
-	 * The string rep might not be valid if the procedure has never been
-	 * run before. [Bug #545644]
-	 */
-
-	TclGetString(bodyPtr);
-    }
-    resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoCmdCountCmd --
- *
- *	Called to implement the "info cmdcount" command that returns the
- *	number of commands that have been executed. Handles the following
- *	syntax:
- *
- *	    info cmdcount
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoCmdCountCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoCommandsCmd --
- *
- *	Called to implement the "info commands" command that returns the list
- *	of commands in the interpreter that match an optional pattern. The
- *	pattern, if any, consists of an optional sequence of namespace names
- *	separated by "::" qualifiers, which is followed by a glob-style
- *	pattern that restricts which commands are returned. Handles the
- *	following syntax:
- *
- *	    info commands ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoCommandsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *cmdName, *pattern;
-    const char *simplePattern;
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Namespace *nsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-    Tcl_Command cmd;
-    int i;
-
-    /*
-     * Get the pattern and find the "effective namespace" in which to list
-     * commands.
-     */
-
-    if (objc == 1) {
-	simplePattern = NULL;
-	nsPtr = currNsPtr;
-	specificNsInPattern = 0;
-    } else if (objc == 2) {
-	/*
-	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
-	 * was found while parsing the pattern, return it. Otherwise, if the
-	 * namespace wasn't found, just leave nsPtr NULL: we will return an
-	 * empty list since no commands there can be found.
-	 */
-
-	Namespace *dummy1NsPtr, *dummy2NsPtr;
-
-	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
-		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
-
-	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
-	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
-	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Exit as quickly as possible if we couldn't find the namespace.
-     */
-
-    if (nsPtr == NULL) {
-	return TCL_OK;
-    }
-
-    /*
-     * Scan through the effective namespace's command table and create a list
-     * with all commands that match the pattern. If a specific namespace was
-     * requested in the pattern, qualify the command names with the namespace
-     * name.
-     */
-
-    listPtr = Tcl_NewListObj(0, NULL);
-
-    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
-	/*
-	 * Special case for when the pattern doesn't include any of glob's
-	 * special characters. This lets us avoid scans of any hash tables.
-	 */
-
-	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
-	if (entryPtr != NULL) {
-	    if (specificNsInPattern) {
-		cmd = Tcl_GetHashValue(entryPtr);
-		elemObjPtr = Tcl_NewObj();
-		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
-	    } else {
-		cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
-		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-	    }
-	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-	    Tcl_SetObjResult(interp, listPtr);
-	    return TCL_OK;
-	}
-	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-	    Tcl_HashTable *tablePtr = NULL;	/* Quell warning. */
-
-	    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
-		Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
-
-		if (pathNsPtr == NULL) {
-		    continue;
-		}
-		tablePtr = &pathNsPtr->cmdTable;
-		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
-		if (entryPtr != NULL) {
-		    break;
-		}
-	    }
-	    if (entryPtr == NULL) {
-		tablePtr = &globalNsPtr->cmdTable;
-		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
-	    }
-	    if (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
-		Tcl_ListObjAppendElement(interp, listPtr,
-			Tcl_NewStringObj(cmdName, -1));
-		Tcl_SetObjResult(interp, listPtr);
-		return TCL_OK;
-	    }
-	}
-    } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
-	/*
-	 * The pattern is non-trivial, but either there is no explicit path or
-	 * there is an explicit namespace in the pattern. In both cases, the
-	 * old matching scheme is perfect.
-	 */
-
-	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	while (entryPtr != NULL) {
-	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
-	    if ((simplePattern == NULL)
-		    || Tcl_StringMatch(cmdName, simplePattern)) {
-		if (specificNsInPattern) {
-		    cmd = Tcl_GetHashValue(entryPtr);
-		    elemObjPtr = Tcl_NewObj();
-		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
-		} else {
-		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-		}
-		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-	    }
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-
-	/*
-	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern, then add in all
-	 * global :: commands that match the simple pattern. Of course, we add
-	 * in only those commands that aren't hidden by a command in the
-	 * effective namespace.
-	 */
-
-	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
-	    while (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
-		if ((simplePattern == NULL)
-			|| Tcl_StringMatch(cmdName, simplePattern)) {
-		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
-			Tcl_ListObjAppendElement(interp, listPtr,
-				Tcl_NewStringObj(cmdName, -1));
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-	}
-    } else {
-	/*
-	 * The pattern is non-trivial (can match more than one command name),
-	 * there is an explicit path, and there is no explicit namespace in
-	 * the pattern. This means that we have to traverse the path to
-	 * discover all the commands defined.
-	 */
-
-	Tcl_HashTable addedCommandsTable;
-	int isNew;
-	int foundGlobal = (nsPtr == globalNsPtr);
-
-	/*
-	 * We keep a hash of the objects already added to the result list.
-	 */
-
-	Tcl_InitObjHashTable(&addedCommandsTable);
-
-	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	while (entryPtr != NULL) {
-	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
-	    if ((simplePattern == NULL)
-		    || Tcl_StringMatch(cmdName, simplePattern)) {
-		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		(void) Tcl_CreateHashEntry(&addedCommandsTable,
-			elemObjPtr, &isNew);
-	    }
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-
-	/*
-	 * Search the path next.
-	 */
-
-	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
-	    Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
-
-	    if (pathNsPtr == NULL) {
-		continue;
-	    }
-	    if (pathNsPtr == globalNsPtr) {
-		foundGlobal = 1;
-	    }
-	    entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
-	    while (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
-		if ((simplePattern == NULL)
-			|| Tcl_StringMatch(cmdName, simplePattern)) {
-		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
-			    elemObjPtr, &isNew);
-		    if (isNew) {
-			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		    } else {
-			TclDecrRefCount(elemObjPtr);
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-	}
-
-	/*
-	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern, then add in all
-	 * global :: commands that match the simple pattern. Of course, we add
-	 * in only those commands that aren't hidden by a command in the
-	 * effective namespace.
-	 */
-
-	if (!foundGlobal) {
-	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
-	    while (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
-		if ((simplePattern == NULL)
-			|| Tcl_StringMatch(cmdName, simplePattern)) {
-		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-		    if (Tcl_FindHashEntry(&addedCommandsTable,
-			    (char *) elemObjPtr) == NULL) {
-			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		    } else {
-			TclDecrRefCount(elemObjPtr);
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-	}
-
-	Tcl_DeleteHashTable(&addedCommandsTable);
-    }
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoCompleteCmd --
- *
- *	Called to implement the "info complete" command that determines
- *	whether a string is a complete Tcl command. Handles the following
- *	syntax:
- *
- *	    info complete command
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoCompleteCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "command");
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    TclObjCommandComplete(objv[1])));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoDefaultCmd --
- *
- *	Called to implement the "info default" command that returns the
- *	default value for a procedure argument. Handles the following syntax:
- *
- *	    info default procName arg varName
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoDefaultCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    const char *procName, *argName;
-    Proc *procPtr;
-    CompiledLocal *localPtr;
-    Tcl_Obj *valueObjPtr;
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
-	return TCL_ERROR;
-    }
-
-    procName = TclGetString(objv[1]);
-    argName = TclGetString(objv[2]);
-
-    procPtr = TclFindProc(iPtr, procName);
-    if (procPtr == NULL) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"\"%s\" isn't a procedure", procName));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
-		NULL);
-	return TCL_ERROR;
-    }
-
-    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
-	    localPtr = localPtr->nextPtr) {
-	if (TclIsVarArgument(localPtr)
-		&& (strcmp(argName, localPtr->name) == 0)) {
-	    if (localPtr->defValuePtr != NULL) {
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
-			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
-		if (valueObjPtr == NULL) {
-		    return TCL_ERROR;
-		}
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-	    } else {
-		Tcl_Obj *nullObjPtr = Tcl_NewObj();
-
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
-			nullObjPtr, TCL_LEAVE_ERR_MSG);
-		if (valueObjPtr == NULL) {
-		    return TCL_ERROR;
-		}
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-	    }
-	    return TCL_OK;
-	}
-    }
-
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "procedure \"%s\" doesn't have an argument \"%s\"",
-	    procName, argName));
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoErrorStackCmd --
- *
- *	Called to implement the "info errorstack" command that returns information
- *	about the last error's call stack. Handles the following syntax:
- *
- *	    info errorstack ?interp?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoErrorStackCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Interp *target;
-    Interp *iPtr;
-
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
-	return TCL_ERROR;
-    }
-
-    target = interp;
-    if (objc == 2) {
-	target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
-	if (target == NULL) {
-	    return TCL_ERROR;
-	}
-    }
-
-    iPtr = (Interp *) target;
-    Tcl_SetObjResult(interp, iPtr->errorStack);
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInfoExistsCmd --
- *
- *	Called to implement the "info exists" command that determines whether
- *	a variable exists. Handles the following syntax:
- *
- *	    info exists varName
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclInfoExistsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *varName;
-    Var *varPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName");
-	return TCL_ERROR;
-    }
-
-    varName = TclGetString(objv[1]);
-    varPtr = TclVarTraceExists(interp, varName);
-
-    Tcl_SetObjResult(interp,
-	    Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoFrameCmd --
- *	TIP #280
- *
- *	Called to implement the "info frame" command that returns the location
- *	of either the currently executing command, or its caller. Handles the
- *	following syntax:
- *
- *		info frame ?number?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoFrameCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    int level, code = TCL_OK;
-    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-    int topLevel = 0;
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-	return TCL_ERROR;
-    }
-
-    while (corPtr) {
-	while (*cmdFramePtrPtr) {
-	    topLevel++;
-	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
-	}
-	if (corPtr->caller.cmdFramePtr) {
-	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
-	}
-	corPtr = corPtr->callerEEPtr->corPtr;
-    }
-    topLevel += (*cmdFramePtrPtr)->level;
-
-    if (topLevel != iPtr->cmdFramePtr->level) {
-	framePtr = iPtr->cmdFramePtr;
-	while (framePtr) {
-	    framePtr->level = topLevel--;
-	    framePtr = framePtr->nextPtr;
-	}
-	if (topLevel) {
-	    Tcl_Panic("Broken frame level calculation");
-	}
-	topLevel = iPtr->cmdFramePtr->level;
-    }
-
-    if (objc == 1) {
-	/*
-	 * Just "info frame".
-	 */
-
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
-	goto done;
-    }
-
-    /*
-     * We've got "info frame level" and must parse the level first.
-     */
-
-    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    if ((level > topLevel) || (level <= - topLevel)) {
-    levelError:
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"bad level \"%s\"", TclGetString(objv[1])));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
-		TclGetString(objv[1]), NULL);
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Let us convert to relative so that we know how many levels to go back
-     */
-
-    if (level > 0) {
-	level -= topLevel;
-    }
-
-    framePtr = iPtr->cmdFramePtr;
-    while (++level <= 0) {
-	framePtr = framePtr->nextPtr;
-	if (!framePtr) {
-	    goto levelError;
-	}
-    }
-
-    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
-
-  done:
-    cmdFramePtrPtr = &iPtr->cmdFramePtr;
-    corPtr = iPtr->execEnvPtr->corPtr;
-    while (corPtr) {
-	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
-
-	if (endPtr) {
-	    if (*cmdFramePtrPtr == endPtr) {
-		*cmdFramePtrPtr = NULL;
-	    } else {
-		CmdFrame *runPtr = *cmdFramePtrPtr;
-
-		while (runPtr->nextPtr != endPtr) {
-		    runPtr->level -= endPtr->level;
-		    runPtr = runPtr->nextPtr;
-		}
-		runPtr->level = 1;
-		runPtr->nextPtr = NULL;
-	    }
-	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
-	}
-	corPtr = corPtr->callerEEPtr->corPtr;
-    }
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInfoFrame --
- *
- *	Core of InfoFrameCmd, returns TIP280 dict for a given frame.
- *
- * Results:
- *	Returns TIP280 dict.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclInfoFrame(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CmdFrame *framePtr)		/* Frame to get info for. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *tmpObj;
-    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
-				 * the dict. */
-    int lc = 0;
-    /*
-     * This array is indexed by the TCL_LOCATION_... values, except
-     * for _LAST.
-     */
-    static const char *const typeString[TCL_LOCATION_LAST] = {
-	"eval", "eval", "eval", "precompiled", "source", "proc"
-    };
-    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
-    int needsFree = -1;
-
-    /*
-     * Pull the information and construct the dictionary to return, as list.
-     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
-     */
-
-#define ADD_PAIR(name, value) \
-	TclNewLiteralStringObj(tmpObj, name); \
-	lv[lc++] = tmpObj; \
-	lv[lc++] = (value)
-
-    switch (framePtr->type) {
-    case TCL_LOCATION_EVAL:
-	/*
-	 * Evaluation, dynamic script. Type, line, cmd, the latter through
-	 * str.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	if (framePtr->line) {
-	    ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
-	} else {
-	    ADD_PAIR("line", Tcl_NewIntObj(1));
-	}
-	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
-	break;
-
-    case TCL_LOCATION_PREBC:
-	/*
-	 * Precompiled. Result contains the type as signal, nothing else.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	break;
-
-    case TCL_LOCATION_BC: {
-	/*
-	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
-	 */
-
-	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-
-	*fPtr = *framePtr;
-
-	/*
-	 * Note:
-	 * Type BC => f.data.eval.path	  is not used.
-	 *	      f.data.tebc.codePtr is used instead.
-	 */
-
-	TclGetSrcInfoForPc(fPtr);
-
-	/*
-	 * Now filled: cmd.str.(cmd,len), line
-	 * Possibly modified: type, path!
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
-	if (fPtr->line) {
-	    ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
-	}
-
-	if (fPtr->type == TCL_LOCATION_SOURCE) {
-	    ADD_PAIR("file", fPtr->data.eval.path);
-
-	    /*
-	     * Death of reference by TclGetSrcInfoForPc.
-	     */
-
-	    Tcl_DecrRefCount(fPtr->data.eval.path);
-	}
-
-	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
-	if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
-	    needsFree = lc - 1;
-	}
-	TclStackFree(interp, fPtr);
-	break;
-    }
-
-    case TCL_LOCATION_SOURCE:
-	/*
-	 * Evaluation of a script file.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
-	ADD_PAIR("file", framePtr->data.eval.path);
-
-	/*
-	 * Refcount framePtr->data.eval.path goes up when lv is converted into
-	 * the result list object.
-	 */
-
-	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
-	break;
-
-    case TCL_LOCATION_PROC:
-	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
-	break;
-    }
-
-    /*
-     * 'proc'. Common to all frame types. Conditional on having an associated
-     * Procedure CallFrame.
-     */
-
-    if (procPtr != NULL) {
-	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
-
-	if (namePtr) {
-	    Tcl_Obj *procNameObj;
-
-	    /*
-	     * This is a regular command.
-	     */
-
-	    TclNewObj(procNameObj);
-	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
-		    procNameObj);
-	    ADD_PAIR("proc", procNameObj);
-	} else if (procPtr->cmdPtr->clientData) {
-	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
-	    int i;
-
-	    /*
-	     * This is a non-standard command. Luckily, it's told us how to
-	     * render extra information about its frame.
-	     */
-
-	    for (i=0 ; i<efiPtr->length ; i++) {
-		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
-		if (efiPtr->fields[i].proc) {
-		    lv[lc++] =
-			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
-		} else {
-		    lv[lc++] = efiPtr->fields[i].clientData;
-		}
-	    }
-	}
-    }
-
-    /*
-     * 'level'. Common to all frame types. Conditional on having an associated
-     * _visible_ CallFrame.
-     */
-
-    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
-	CallFrame *current = framePtr->framePtr;
-	CallFrame *top = iPtr->varFramePtr;
-	CallFrame *idx;
-
-	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
-	    if (idx == current) {
-		int c = framePtr->framePtr->level;
-		int t = iPtr->varFramePtr->level;
-
-		ADD_PAIR("level", Tcl_NewIntObj(t - c));
-		break;
-	    }
-	}
-    }
-
-    tmpObj = Tcl_NewListObj(lc, lv);
-    if (needsFree >= 0) {
-	Tcl_DecrRefCount(lv[needsFree]);
-    }
-    return tmpObj;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoFunctionsCmd --
- *
- *	Called to implement the "info functions" command that returns the list
- *	of math functions matching an optional pattern. Handles the following
- *	syntax:
- *
- *	    info functions ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoFunctionsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *script;
-    int code;
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    script = Tcl_NewStringObj(
-"	    ::apply [::list {{pattern *}} {\n"
-"		::set cmds {}\n"
-"		::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n"
-"		    ::lappend cmds [::namespace tail $cmd]\n"
-"		}\n"
-"		::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n"
-"		    ::set cmd [::namespace tail $cmd]\n"
-"		    ::if {$cmd ni $cmds} {\n"
-"			::lappend cmds $cmd\n"
-"		    }\n"
-"		}\n"
-"		::return $cmds\n"
-"	    } [::namespace current]] ", -1);
-
-    if (objc == 2) {
-	Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1]));
-
-	Tcl_AppendObjToObj(script, arg);
-	Tcl_DecrRefCount(arg);
-    }
-
-    Tcl_IncrRefCount(script);
-    code = Tcl_EvalObjEx(interp, script, 0);
-
-    Tcl_DecrRefCount(script);
-
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoHostnameCmd --
- *
- *	Called to implement the "info hostname" command that returns the host
- *	name. Handles the following syntax:
- *
- *	    info hostname
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoHostnameCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *name;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    name = Tcl_GetHostName();
-    if (name) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
-	return TCL_OK;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-	    "unable to determine name of host", -1));
-    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoLevelCmd --
- *
- *	Called to implement the "info level" command that returns information
- *	about the call stack. Handles the following syntax:
- *
- *	    info level ?number?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLevelCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (objc == 1) {		/* Just "info level" */
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
-	return TCL_OK;
-    }
-
-    if (objc == 2) {
-	int level;
-	CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
-
-	if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (level <= 0) {
-	    if (iPtr->varFramePtr == rootFramePtr) {
-		goto levelError;
-	    }
-	    level += iPtr->varFramePtr->level;
-	}
-	for (framePtr=iPtr->varFramePtr ; framePtr!=rootFramePtr;
-		framePtr=framePtr->callerVarPtr) {
-	    if (framePtr->level == level) {
-		break;
-	    }
-	}
-	if (framePtr == rootFramePtr) {
-	    goto levelError;
-	}
-
-	Tcl_SetObjResult(interp,
-		Tcl_NewListObj(framePtr->objc, framePtr->objv));
-	return TCL_OK;
-    }
-
-    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-    return TCL_ERROR;
-
-  levelError:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "bad level \"%s\"", TclGetString(objv[1])));
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
-	    TclGetString(objv[1]), NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoLibraryCmd --
- *
- *	Called to implement the "info library" command that returns the
- *	library directory for the Tcl installation. Handles the following
- *	syntax:
- *
- *	    info library
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLibraryCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *libDirName;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
-    if (libDirName != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
-	return TCL_OK;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-	    "no library has been specified for Tcl", -1));
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoLoadedCmd --
- *
- *	Called to implement the "info loaded" command that returns the
- *	packages that have been loaded into an interpreter. Handles the
- *	following syntax:
- *
- *	    info loaded ?interp?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoLoadedCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *interpName;
-
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
-	return TCL_ERROR;
-    }
-
-    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
-	interpName = NULL;
-    } else {			/* Get pkgs just in specified interp. */
-	interpName = TclGetString(objv[1]);
-    }
-    return TclGetLoadedPackages(interp, interpName);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoNameOfExecutableCmd --
- *
- *	Called to implement the "info nameofexecutable" command that returns
- *	the name of the binary file running this application. Handles the
- *	following syntax:
- *
- *	    info nameofexecutable
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoNameOfExecutableCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoPatchLevelCmd --
- *
- *	Called to implement the "info patchlevel" command that returns the
- *	default value for an argument to a procedure. Handles the following
- *	syntax:
- *
- *	    info patchlevel
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoPatchLevelCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *patchlevel;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
-	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
-    if (patchlevel != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoProcsCmd --
- *
- *	Called to implement the "info procs" command that returns the list of
- *	procedures in the interpreter that match an optional pattern. The
- *	pattern, if any, consists of an optional sequence of namespace names
- *	separated by "::" qualifiers, which is followed by a glob-style
- *	pattern that restricts which commands are returned. Handles the
- *	following syntax:
- *
- *	    info procs ?pattern?
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoProcsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *cmdName, *pattern;
-    const char *simplePattern;
-    Namespace *nsPtr;
-#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-#endif
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_Obj *listPtr, *elemObjPtr;
-    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-    register Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Command *cmdPtr, *realCmdPtr;
-
-    /*
-     * Get the pattern and find the "effective namespace" in which to list
-     * procs.
-     */
-
-    if (objc == 1) {
-	simplePattern = NULL;
-	nsPtr = currNsPtr;
-	specificNsInPattern = 0;
-    } else if (objc == 2) {
-	/*
-	 * From the pattern, get the effective namespace and the simple
-	 * pattern (no namespace qualifiers or ::'s) at the end. If an error
-	 * was found while parsing the pattern, return it. Otherwise, if the
-	 * namespace wasn't found, just leave nsPtr NULL: we will return an
-	 * empty list since no commands there can be found.
-	 */
-
-	Namespace *dummy1NsPtr, *dummy2NsPtr;
-
-	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
-		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
-
-	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
-	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
-	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-
-    if (nsPtr == NULL) {
-	return TCL_OK;
-    }
-
-    /*
-     * Scan through the effective namespace's command table and create a list
-     * with all procs that match the pattern. If a specific namespace was
-     * requested in the pattern, qualify the command names with the namespace
-     * name.
-     */
-
-    listPtr = Tcl_NewListObj(0, NULL);
-#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
-    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
-	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
-	if (entryPtr != NULL) {
-	    cmdPtr = Tcl_GetHashValue(entryPtr);
-
-	    if (!TclIsProc(cmdPtr)) {
-		realCmdPtr = (Command *)
-			TclGetOriginalCommand((Tcl_Command) cmdPtr);
-		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
-		    goto simpleProcOK;
-		}
-	    } else {
-	    simpleProcOK:
-		if (specificNsInPattern) {
-		    elemObjPtr = Tcl_NewObj();
-		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
-			    elemObjPtr);
-		} else {
-		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);
-		}
-		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-	    }
-	}
-    } else
-#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
-    {
-	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	while (entryPtr != NULL) {
-	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
-	    if ((simplePattern == NULL)
-		    || Tcl_StringMatch(cmdName, simplePattern)) {
-		cmdPtr = Tcl_GetHashValue(entryPtr);
-
-		if (!TclIsProc(cmdPtr)) {
-		    realCmdPtr = (Command *)
-			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
-		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
-			goto procOK;
-		    }
-		} else {
-		procOK:
-		    if (specificNsInPattern) {
-			elemObjPtr = Tcl_NewObj();
-			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
-				elemObjPtr);
-		    } else {
-			elemObjPtr = Tcl_NewStringObj(cmdName, -1);
-		    }
-		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-		}
-	    }
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-
-	/*
-	 * If the effective namespace isn't the global :: namespace, and a
-	 * specific namespace wasn't requested in the pattern, then add in all
-	 * global :: procs that match the simple pattern. Of course, we add in
-	 * only those procs that aren't hidden by a proc in the effective
-	 * namespace.
-	 */
-
-#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
-	/*
-	 * If "info procs" worked like "info commands", returning the commands
-	 * also seen in the global namespace, then you would include this
-	 * code. As this could break backwards compatibilty with 8.0-8.2, we
-	 * decided not to "fix" it in 8.3, leaving the behavior slightly
-	 * different.
-	 */
-
-	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
-	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
-	    while (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
-		if ((simplePattern == NULL)
-			|| Tcl_StringMatch(cmdName, simplePattern)) {
-		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
-			cmdPtr = Tcl_GetHashValue(entryPtr);
-			realCmdPtr = (Command *) TclGetOriginalCommand(
-				(Tcl_Command) cmdPtr);
-
-			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
-				&& TclIsProc(realCmdPtr))) {
-			    Tcl_ListObjAppendElement(interp, listPtr,
-				    Tcl_NewStringObj(cmdName, -1));
-			}
-		    }
-		}
-		entryPtr = Tcl_NextHashEntry(&search);
-	    }
-	}
-#endif
-    }
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoScriptCmd --
- *
- *	Called to implement the "info script" command that returns the script
- *	file that is currently being evaluated. Handles the following syntax:
- *
- *	    info script ?newName?
- *
- *	If newName is specified, it will set that as the internal name.
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message. It may change the internal
- *	script filename.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoScriptCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
-	return TCL_ERROR;
-    }
-
-    if (objc == 2) {
-	if (iPtr->scriptFile != NULL) {
-	    Tcl_DecrRefCount(iPtr->scriptFile);
-	}
-	iPtr->scriptFile = objv[1];
-	Tcl_IncrRefCount(iPtr->scriptFile);
-    }
-    if (iPtr->scriptFile != NULL) {
-	Tcl_SetObjResult(interp, iPtr->scriptFile);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoSharedlibCmd --
- *
- *	Called to implement the "info sharedlibextension" command that returns
- *	the file extension used for shared libraries. Handles the following
- *	syntax:
- *
- *	    info sharedlibextension
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoSharedlibCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-#ifdef TCL_SHLIB_EXT
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1));
-#endif
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InfoTclVersionCmd --
- *
- *	Called to implement the "info tclversion" command that returns the
- *	version number for this Tcl library. Handles the following syntax:
- *
- *	    info tclversion
- *
- * Results:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
- *
- * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-InfoTclVersionCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *version;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
-	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
-    if (version != NULL) {
-	Tcl_SetObjResult(interp, version);
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_JoinObjCmd --
- *
- *	This procedure is invoked to process the "join" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_JoinObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
-{
-    int listLen, i;
-    Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
-
-    if ((objc < 2) || (objc > 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make sure the list argument is a list object and get its length and a
-     * pointer to its array of element pointers.
-     */
-
-    if (TclListObjGetElements(interp, objv[1], &listLen,
-	    &elemPtrs) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
-    Tcl_IncrRefCount(joinObjPtr);
-
-    resObjPtr = Tcl_NewObj();
-    for (i = 0;  i < listLen;  i++) {
-	if (i > 0) {
-	    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
-	}
-	Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
-    }
-    Tcl_DecrRefCount(joinObjPtr);
-    Tcl_SetObjResult(interp, resObjPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LassignObjCmd --
- *
- *	This object-based procedure is invoked to process the "lassign" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LassignObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *listCopyPtr;
-    Tcl_Obj **listObjv;		/* The contents of the list. */
-    int listObjc;		/* The length of the list. */
-    int code = TCL_OK;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
-	return TCL_ERROR;
-    }
-
-    listCopyPtr = TclListObjCopy(interp, objv[1]);
-    if (listCopyPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
-
-    objc -= 2;
-    objv += 2;
-    while (code == TCL_OK && objc > 0 && listObjc > 0) {
-	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    code = TCL_ERROR;
-	}
-	objc--;
-	listObjc--;
-    }
-
-    if (code == TCL_OK && objc > 0) {
-	Tcl_Obj *emptyObj;
-
-	TclNewObj(emptyObj);
-	Tcl_IncrRefCount(emptyObj);
-	while (code == TCL_OK && objc-- > 0) {
-	    if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
-		    TCL_LEAVE_ERR_MSG) == NULL) {
-		code = TCL_ERROR;
-	    }
-	}
-	Tcl_DecrRefCount(emptyObj);
-    }
-
-    if (code == TCL_OK && listObjc > 0) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
-    }
-
-    Tcl_DecrRefCount(listCopyPtr);
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LindexObjCmd --
- *
- *	This object-based procedure is invoked to process the "lindex" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LindexObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-
-    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * If objc==3, then objv[2] may be either a single index or a list of
-     * indices: go to TclLindexList to determine which. If objc>=4, or
-     * objc==2, then objv[2 .. objc-2] are all single indices and processed as
-     * such in TclLindexFlat.
-     */
-
-    if (objc == 3) {
-	elemPtr = TclLindexList(interp, objv[1], objv[2]);
-    } else {
-	elemPtr = TclLindexFlat(interp, objv[1], objc-2, objv+2);
-    }
-
-    /*
-     * Set the interpreter's object result to the last element extracted.
-     */
-
-    if (elemPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, elemPtr);
-    Tcl_DecrRefCount(elemPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LinsertObjCmd --
- *
- *	This object-based procedure is invoked to process the "linsert" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A new Tcl list object formed by inserting zero or more elements into a
- *	list.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LinsertObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    register int objc,		/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *listPtr;
-    int index, len, result;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
-	return TCL_ERROR;
-    }
-
-    result = TclListObjLength(interp, objv[1], &len);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    /*
-     * Get the index. "end" is interpreted to be the index after the last
-     * element, such that using it will cause any inserted elements to be
-     * appended to the list.
-     */
-
-    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (index > len) {
-	index = len;
-    }
-
-    /*
-     * If the list object is unshared we can modify it directly. Otherwise we
-     * create a copy to modify: this is "copy on write".
-     */
-
-    listPtr = objv[1];
-    if (Tcl_IsShared(listPtr)) {
-	listPtr = TclListObjCopy(NULL, listPtr);
-    }
-
-    if ((objc == 4) && (index == len)) {
-	/*
-	 * Special case: insert one element at the end of the list.
-	 */
-
-	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
-    } else {
-	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
-		(objc-3), &(objv[3]))) {
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Set the interpreter's object result.
-     */
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ListObjCmd --
- *
- *	This procedure is invoked to process the "list" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ListObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    register int objc,		/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* The argument objects. */
-{
-    /*
-     * If there are no list elements, the result is an empty object.
-     * Otherwise set the interpreter's result object to be a list object.
-     */
-
-    if (objc > 1) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LlengthObjCmd --
- *
- *	This object-based procedure is invoked to process the "llength" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LlengthObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* Argument objects. */
-{
-    int listLen, result;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list");
-	return TCL_ERROR;
-    }
-
-    result = TclListObjLength(interp, objv[1], &listLen);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    /*
-     * Set the interpreter's object result to an integer object holding the
-     * length.
-     */
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LrangeObjCmd --
- *
- *	This procedure is invoked to process the "lrange" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LrangeObjCmd(
-    ClientData notUsed,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* Argument objects. */
-{
-    Tcl_Obj **elemPtrs;
-    int listLen, first, last, result;
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
-	return TCL_ERROR;
-    }
-
-    result = TclListObjLength(interp, objv[1], &listLen);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
-	    &first);
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (first < 0) {
-	first = 0;
-    }
-
-    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
-	    &last);
-    if (result != TCL_OK) {
-	return result;
-    }
-    if (last >= listLen) {
-	last = listLen - 1;
-    }
-
-    if (first > last) {
-	/*
-	 * Returning an empty list is easy.
-	 */
-
-	return TCL_OK;
-    }
-
-    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    if (Tcl_IsShared(objv[1]) ||
-	    ((ListRepPtr(objv[1])->refCount > 1))) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
-		&elemPtrs[first]));
-    } else {
-	/*
-	 * In-place is possible.
-	 */
-
-	if (last < (listLen - 1)) {
-	    Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
-		    0, NULL);
-	}
-
-	/*
-	 * This one is not conditioned on (first > 0) in order to preserve the
-	 * string-canonizing effect of [lrange 0 end].
-	 */
-
-	Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
-	Tcl_SetObjResult(interp, objv[1]);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LrepeatObjCmd --
- *
- *	This procedure is invoked to process the "lrepeat" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl object result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LrepeatObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    register int objc,		/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* The argument objects. */
-{
-    int elementCount, i, totalElems;
-    Tcl_Obj *listPtr, **dataArray = NULL;
-
-    /*
-     * Check arguments for legality:
-     *		lrepeat count ?value ...?
-     */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
-	return TCL_ERROR;
-    }
-    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
-	return TCL_ERROR;
-    }
-    if (elementCount < 0) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"bad count \"%d\": must be integer >= 0", elementCount));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
-		NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Skip forward to the interesting arguments now we've finished parsing.
-     */
-
-    objc -= 2;
-    objv += 2;
-
-    /* Final sanity check. Do not exceed limits on max list length. */
-
-    if (elementCount && objc > LIST_MAX/elementCount) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	return TCL_ERROR;
-    }
-    totalElems = objc * elementCount;
-
-    /*
-     * Get an empty list object that is allocated large enough to hold each
-     * init value elementCount times.
-     */
-
-    listPtr = Tcl_NewListObj(totalElems, NULL);
-    if (totalElems) {
-	List *listRepPtr = ListRepPtr(listPtr);
-
-	listRepPtr->elemCount = elementCount*objc;
-	dataArray = &listRepPtr->elements;
-    }
-
-    /*
-     * Set the elements. Note that we handle the common degenerate case of a
-     * single value being repeated separately to permit the compiler as much
-     * room as possible to optimize a loop that might be run a very large
-     * number of times.
-     */
-
-    CLANG_ASSERT(dataArray || totalElems == 0 );
-    if (objc == 1) {
-	register Tcl_Obj *tmpPtr = objv[0];
-
-	tmpPtr->refCount += elementCount;
-	for (i=0 ; i<elementCount ; i++) {
-	    dataArray[i] = tmpPtr;
-	}
-    } else {
-	int j, k = 0;
-
-	for (i=0 ; i<elementCount ; i++) {
-	    for (j=0 ; j<objc ; j++) {
-		Tcl_IncrRefCount(objv[j]);
-		dataArray[k++] = objv[j];
-	    }
-	}
-    }
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LreplaceObjCmd --
- *
- *	This object-based procedure is invoked to process the "lreplace" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A new Tcl list object formed by replacing zero or more elements of a
- *	list.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LreplaceObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    register Tcl_Obj *listPtr;
-    int first, last, listLen, numToDelete, result;
-
-    if (objc < 4) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"list first last ?element ...?");
-	return TCL_ERROR;
-    }
-
-    result = TclListObjLength(interp, objv[1], &listLen);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    /*
-     * Get the first and last indexes. "end" is interpreted to be the index
-     * for the last element, such that using it will cause that element to be
-     * included for deletion.
-     */
-
-    result = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    if (first < 0) {
-	first = 0;
-    }
-
-    /*
-     * Complain if the user asked for a start element that is greater than the
-     * list length. This won't ever trigger for the "end-*" case as that will
-     * be properly constrained by TclGetIntForIndex because we use listLen-1
-     * (to allow for replacing the last elem).
-     */
-
-    if ((first > listLen) && (listLen > 0)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"list doesn't contain element %s", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
-		NULL);
-	return TCL_ERROR;
-    }
-    if (last >= listLen) {
-	last = listLen - 1;
-    }
-    if (first <= last) {
-	numToDelete = last - first + 1;
-    } else {
-	numToDelete = 0;
-    }
-
-    /*
-     * If the list object is unshared we can modify it directly, otherwise we
-     * create a copy to modify: this is "copy on write".
-     */
-
-    listPtr = objv[1];
-    if (Tcl_IsShared(listPtr)) {
-	listPtr = TclListObjCopy(NULL, listPtr);
-    }
-
-    /*
-     * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
-     * objc == 4. In this case, the list value of listPtr is not changed (no
-     * elements are removed or added), but by making the call we are assured
-     * we end up with a list in canonical form. Resist any temptation to
-     * optimize this case away.
-     */
-
-    if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
-	    objc-4, objv+4)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Set the interpreter's object result.
-     */
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LreverseObjCmd --
- *
- *	This procedure is invoked to process the "lreverse" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LreverseObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
-{
-    Tcl_Obj **elemv;
-    int elemc, i, j;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list");
-	return TCL_ERROR;
-    }
-    if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * If the list is empty, just return it. [Bug 1876793]
-     */
-
-    if (!elemc) {
-	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
-    }
-
-    if (Tcl_IsShared(objv[1])
-	    || (ListRepPtr(objv[1])->refCount > 1)) {	/* Bug 1675044 */
-	Tcl_Obj *resultObj, **dataArray;
-	List *listRepPtr;
-
-	resultObj = Tcl_NewListObj(elemc, NULL);
-	listRepPtr = ListRepPtr(resultObj);
-	listRepPtr->elemCount = elemc;
-	dataArray = &listRepPtr->elements;
-
-	for (i=0,j=elemc-1 ; i<elemc ; i++,j--) {
-	    dataArray[j] = elemv[i];
-	    Tcl_IncrRefCount(elemv[i]);
-	}
-
-	Tcl_SetObjResult(interp, resultObj);
-    } else {
-
-	/*
-	 * Not shared, so swap "in place". This relies on Tcl_LOGE above
-	 * returning a pointer to the live array of Tcl_Obj values.
-	 */
-
-	for (i=0,j=elemc-1 ; i<j ; i++,j--) {
-	    Tcl_Obj *tmp = elemv[i];
-
-	    elemv[i] = elemv[j];
-	    elemv[j] = tmp;
-	}
-	TclInvalidateStringRep(objv[1]);
-	Tcl_SetObjResult(interp, objv[1]);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LsearchObjCmd --
- *
- *	This procedure is invoked to process the "lsearch" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LsearchObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
-{
-    const char *bytes, *patternBytes;
-    int i, match, index, result, listc, length, elemLen, bisect;
-    int dataType, isIncreasing, lower, upper, offset;
-    Tcl_WideInt patWide, objWide;
-    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
-    double patDouble, objDouble;
-    SortInfo sortInfo;
-    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
-    SortStrCmpFn_t strCmpFn = strcmp;
-    Tcl_RegExp regexp = NULL;
-    static const char *const options[] = {
-	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
-	"-exact",   "-glob",    "-increasing", "-index",
-	"-inline",  "-integer", "-nocase",     "-not",
-	"-real",    "-regexp",  "-sorted",     "-start",
-	"-subindices", NULL
-    };
-    enum options {
-	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING,
-	LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
-	LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
-	LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
-	LSEARCH_START, LSEARCH_SUBINDICES
-    };
-    enum datatypes {
-	ASCII, DICTIONARY, INTEGER, REAL
-    };
-    enum modes {
-	EXACT, GLOB, REGEXP, SORTED
-    };
-    enum modes mode;
-
-    mode = GLOB;
-    dataType = ASCII;
-    isIncreasing = 1;
-    allMatches = 0;
-    inlineReturn = 0;
-    returnSubindices = 0;
-    negatedMatch = 0;
-    bisect = 0;
-    listPtr = NULL;
-    startPtr = NULL;
-    offset = 0;
-    noCase = 0;
-    sortInfo.compareCmdPtr = NULL;
-    sortInfo.isIncreasing = 1;
-    sortInfo.sortMode = 0;
-    sortInfo.interp = interp;
-    sortInfo.resultCode = TCL_OK;
-    sortInfo.indexv = NULL;
-    sortInfo.indexc = 0;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
-	return TCL_ERROR;
-    }
-
-    for (i = 1; i < objc-2; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
-		!= TCL_OK) {
-	    if (startPtr != NULL) {
-		Tcl_DecrRefCount(startPtr);
-	    }
-	    result = TCL_ERROR;
-	    goto done;
-	}
-	switch ((enum options) index) {
-	case LSEARCH_ALL:		/* -all */
-	    allMatches = 1;
-	    break;
-	case LSEARCH_ASCII:		/* -ascii */
-	    dataType = ASCII;
-	    break;
-	case LSEARCH_BISECT:		/* -bisect */
-	    mode = SORTED;
-	    bisect = 1;
-	    break;
-	case LSEARCH_DECREASING:	/* -decreasing */
-	    isIncreasing = 0;
-	    sortInfo.isIncreasing = 0;
-	    break;
-	case LSEARCH_DICTIONARY:	/* -dictionary */
-	    dataType = DICTIONARY;
-	    break;
-	case LSEARCH_EXACT:		/* -increasing */
-	    mode = EXACT;
-	    break;
-	case LSEARCH_GLOB:		/* -glob */
-	    mode = GLOB;
-	    break;
-	case LSEARCH_INCREASING:	/* -increasing */
-	    isIncreasing = 1;
-	    sortInfo.isIncreasing = 1;
-	    break;
-	case LSEARCH_INLINE:		/* -inline */
-	    inlineReturn = 1;
-	    break;
-	case LSEARCH_INTEGER:		/* -integer */
-	    dataType = INTEGER;
-	    break;
-	case LSEARCH_NOCASE:		/* -nocase */
-	    strCmpFn = TclUtfCasecmp;
-	    noCase = 1;
-	    break;
-	case LSEARCH_NOT:		/* -not */
-	    negatedMatch = 1;
-	    break;
-	case LSEARCH_REAL:		/* -real */
-	    dataType = REAL;
-	    break;
-	case LSEARCH_REGEXP:		/* -regexp */
-	    mode = REGEXP;
-	    break;
-	case LSEARCH_SORTED:		/* -sorted */
-	    mode = SORTED;
-	    break;
-	case LSEARCH_SUBINDICES:	/* -subindices */
-	    returnSubindices = 1;
-	    break;
-	case LSEARCH_START:		/* -start */
-	    /*
-	     * If there was a previous -start option, release its saved index
-	     * because it will either be replaced or there will be an error.
-	     */
-
-	    if (startPtr != NULL) {
-		Tcl_DecrRefCount(startPtr);
-	    }
-	    if (i > objc-4) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"missing starting index", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		result = TCL_ERROR;
-		goto done;
-	    }
-	    i++;
-	    if (objv[i] == objv[objc - 2]) {
-		/*
-		 * Take copy to prevent shimmering problems. Note that it does
-		 * not matter if the index obj is also a component of the list
-		 * being searched. We only need to copy where the list and the
-		 * index are one-and-the-same.
-		 */
-
-		startPtr = Tcl_DuplicateObj(objv[i]);
-	    } else {
-		startPtr = objv[i];
-		Tcl_IncrRefCount(startPtr);
-	    }
-	    break;
-	case LSEARCH_INDEX: {		/* -index */
-	    Tcl_Obj **indices;
-	    int j;
-
-	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
-	    }
-	    if (i > objc-4) {
-		if (startPtr != NULL) {
-		    Tcl_DecrRefCount(startPtr);
-		}
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-index\" option must be followed by list index",
-			-1));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		return TCL_ERROR;
-	    }
-
-	    /*
-	     * Store the extracted indices for processing by sublist
-	     * extraction. Note that we don't do this using objects because
-	     * that has shimmering problems.
-	     */
-
-	    i++;
-	    if (TclListObjGetElements(interp, objv[i],
-		    &sortInfo.indexc, &indices) != TCL_OK) {
-		if (startPtr != NULL) {
-		    Tcl_DecrRefCount(startPtr);
-		}
-		return TCL_ERROR;
-	    }
-	    switch (sortInfo.indexc) {
-	    case 0:
-		sortInfo.indexv = NULL;
-		break;
-	    case 1:
-		sortInfo.indexv = &sortInfo.singleIndex;
-		break;
-	    default:
-		sortInfo.indexv =
-			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
-	    }
-
-	    /*
-	     * Fill the array by parsing each index. We don't know whether
-	     * their scale is sensible yet, but we at least perform the
-	     * syntactic check here.
-	     */
-
-	    for (j=0 ; j<sortInfo.indexc ; j++) {
-		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
-			&sortInfo.indexv[j]) != TCL_OK) {
-		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (-index option item number %d)", j));
-		    result = TCL_ERROR;
-		    goto done;
-		}
-	    }
-	    break;
-	}
-	}
-    }
-
-    /*
-     * Subindices only make sense if asked for with -index option set.
-     */
-
-    if (returnSubindices && sortInfo.indexc==0) {
-	if (startPtr != NULL) {
-	    Tcl_DecrRefCount(startPtr);
-	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"-subindices cannot be used without -index option", -1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
-		"BAD_OPTION_MIX", NULL);
-	return TCL_ERROR;
-    }
-
-    if (bisect && (allMatches || negatedMatch)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"-bisect is not compatible with -all or -not", -1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
-		"BAD_OPTION_MIX", NULL);
-	return TCL_ERROR;
-    }
-
-    if (mode == REGEXP) {
-	/*
-	 * We can shimmer regexp/list if listv[i] == pattern, so get the
-	 * regexp rep before the list rep. First time round, omit the interp
-	 * and hope that the compilation will succeed. If it fails, we'll
-	 * recompile in "expensive" mode with a place to put error messages.
-	 */
-
-	regexp = Tcl_GetRegExpFromObj(NULL, objv[objc - 1],
-		TCL_REG_ADVANCED | TCL_REG_NOSUB |
-		(noCase ? TCL_REG_NOCASE : 0));
-	if (regexp == NULL) {
-	    /*
-	     * Failed to compile the RE. Try again without the TCL_REG_NOSUB
-	     * flag in case the RE had sub-expressions in it [Bug 1366683]. If
-	     * this fails, an error message will be left in the interpreter.
-	     */
-
-	    regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
-		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
-	}
-
-	if (regexp == NULL) {
-	    if (startPtr != NULL) {
-		Tcl_DecrRefCount(startPtr);
-	    }
-	    result = TCL_ERROR;
-	    goto done;
-	}
-    }
-
-    /*
-     * Make sure the list argument is a list object and get its length and a
-     * pointer to its array of element pointers.
-     */
-
-    result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
-    if (result != TCL_OK) {
-	if (startPtr != NULL) {
-	    Tcl_DecrRefCount(startPtr);
-	}
-	goto done;
-    }
-
-    /*
-     * Get the user-specified start offset.
-     */
-
-    if (startPtr) {
-	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
-	Tcl_DecrRefCount(startPtr);
-	if (result != TCL_OK) {
-	    goto done;
-	}
-	if (offset < 0) {
-	    offset = 0;
-	}
-
-	/*
-	 * If the search started past the end of the list, we just return a
-	 * "did not match anything at all" result straight away. [Bug 1374778]
-	 */
-
-	if (offset > listc-1) {
-	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
-	    }
-	    if (allMatches || inlineReturn) {
-		Tcl_ResetResult(interp);
-	    } else {
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
-	    }
-	    return TCL_OK;
-	}
-    }
-
-    patObj = objv[objc - 1];
-    patternBytes = NULL;
-    if (mode == EXACT || mode == SORTED) {
-	switch ((enum datatypes) dataType) {
-	case ASCII:
-	case DICTIONARY:
-	    patternBytes = TclGetStringFromObj(patObj, &length);
-	    break;
-	case INTEGER:
-	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
-	    if (result != TCL_OK) {
-		goto done;
-	    }
-
-	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
-	     */
-
-	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
-	    break;
-	case REAL:
-	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
-	    if (result != TCL_OK) {
-		goto done;
-	    }
-
-	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
-	     */
-
-	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
-	    break;
-	}
-    } else {
-	patternBytes = TclGetStringFromObj(patObj, &length);
-    }
-
-    /*
-     * Set default index value to -1, indicating failure; if we find the item
-     * in the course of our search, index will be set to the correct value.
-     */
-
-    index = -1;
-    match = 0;
-
-    if (mode == SORTED && !allMatches && !negatedMatch) {
-	/*
-	 * If the data is sorted, we can do a more intelligent search. Note
-	 * that there is no point in being smart when -all was specified; in
-	 * that case, we have to look at all items anyway, and there is no
-	 * sense in doing this when the match sense is inverted.
-	 */
-
-	lower = offset - 1;
-	upper = listc;
-	while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
-	    i = (lower + upper)/2;
-	    if (sortInfo.indexc != 0) {
-		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
-		if (sortInfo.resultCode != TCL_OK) {
-		    result = sortInfo.resultCode;
-		    goto done;
-		}
-	    } else {
-		itemPtr = listv[i];
-	    }
-	    switch ((enum datatypes) dataType) {
-	    case ASCII:
-		bytes = TclGetString(itemPtr);
-		match = strCmpFn(patternBytes, bytes);
-		break;
-	    case DICTIONARY:
-		bytes = TclGetString(itemPtr);
-		match = DictionaryCompare(patternBytes, bytes);
-		break;
-	    case INTEGER:
-		result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
-		if (result != TCL_OK) {
-		    goto done;
-		}
-		if (patWide == objWide) {
-		    match = 0;
-		} else if (patWide < objWide) {
-		    match = -1;
-		} else {
-		    match = 1;
-		}
-		break;
-	    case REAL:
-		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
-		if (result != TCL_OK) {
-		    goto done;
-		}
-		if (patDouble == objDouble) {
-		    match = 0;
-		} else if (patDouble < objDouble) {
-		    match = -1;
-		} else {
-		    match = 1;
-		}
-		break;
-	    }
-	    if (match == 0) {
-		/*
-		 * Normally, binary search is written to stop when it finds a
-		 * match. If there are duplicates of an element in the list,
-		 * our first match might not be the first occurance.
-		 * Consider: 0 0 0 1 1 1 2 2 2
-		 *
-		 * To maintain consistancy with standard lsearch semantics, we
-		 * must find the leftmost occurance of the pattern in the
-		 * list. Thus we don't just stop searching here. This
-		 * variation means that a search always makes log n
-		 * comparisons (normal binary search might "get lucky" with an
-		 * early comparison).
-		 *
-		 * In bisect mode though, we want the last of equals.
-		 */
-
-		index = i;
-		if (bisect) {
-		    lower = i;
-		} else {
-		    upper = i;
-		}
-	    } else if (match > 0) {
-		if (isIncreasing) {
-		    lower = i;
-		} else {
-		    upper = i;
-		}
-	    } else {
-		if (isIncreasing) {
-		    upper = i;
-		} else {
-		    lower = i;
-		}
-	    }
-	}
-	if (bisect && index < 0) {
-	    index = lower;
-	}
-    } else {
-	/*
-	 * We need to do a linear search, because (at least one) of:
-	 *   - our matcher can only tell equal vs. not equal
-	 *   - our matching sense is negated
-	 *   - we're building a list of all matched items
-	 */
-
-	if (allMatches) {
-	    listPtr = Tcl_NewListObj(0, NULL);
-	}
-	for (i = offset; i < listc; i++) {
-	    match = 0;
-	    if (sortInfo.indexc != 0) {
-		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
-		if (sortInfo.resultCode != TCL_OK) {
-		    if (listPtr != NULL) {
-			Tcl_DecrRefCount(listPtr);
-		    }
-		    result = sortInfo.resultCode;
-		    goto done;
-		}
-	    } else {
-		itemPtr = listv[i];
-	    }
-
-	    switch (mode) {
-	    case SORTED:
-	    case EXACT:
-		switch ((enum datatypes) dataType) {
-		case ASCII:
-		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
-		    if (length == elemLen) {
-			/*
-			 * This split allows for more optimal compilation of
-			 * memcmp/strcasecmp.
-			 */
-
-			if (noCase) {
-			    match = (TclUtfCasecmp(bytes, patternBytes) == 0);
-			} else {
-			    match = (memcmp(bytes, patternBytes,
-				    (size_t) length) == 0);
-			}
-		    }
-		    break;
-
-		case DICTIONARY:
-		    bytes = TclGetString(itemPtr);
-		    match = (DictionaryCompare(bytes, patternBytes) == 0);
-		    break;
-
-		case INTEGER:
-		    result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
-		    if (result != TCL_OK) {
-			if (listPtr != NULL) {
-			    Tcl_DecrRefCount(listPtr);
-			}
-			goto done;
-		    }
-		    match = (objWide == patWide);
-		    break;
-
-		case REAL:
-		    result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
-		    if (result != TCL_OK) {
-			if (listPtr) {
-			    Tcl_DecrRefCount(listPtr);
-			}
-			goto done;
-		    }
-		    match = (objDouble == patDouble);
-		    break;
-		}
-		break;
-
-	    case GLOB:
-		match = Tcl_StringCaseMatch(TclGetString(itemPtr),
-			patternBytes, noCase);
-		break;
-
-	    case REGEXP:
-		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
-		if (match < 0) {
-		    Tcl_DecrRefCount(patObj);
-		    if (listPtr != NULL) {
-			Tcl_DecrRefCount(listPtr);
-		    }
-		    result = TCL_ERROR;
-		    goto done;
-		}
-		break;
-	    }
-
-	    /*
-	     * Invert match condition for -not.
-	     */
-
-	    if (negatedMatch) {
-		match = !match;
-	    }
-	    if (!match) {
-		continue;
-	    }
-	    if (!allMatches) {
-		index = i;
-		break;
-	    } else if (inlineReturn) {
-		/*
-		 * Note that these appends are not expected to fail.
-		 */
-
-		if (returnSubindices && (sortInfo.indexc != 0)) {
-		    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
-		} else {
-		    itemPtr = listv[i];
-		}
-		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
-	    } else if (returnSubindices) {
-		int j;
-
-		itemPtr = Tcl_NewIntObj(i);
-		for (j=0 ; j<sortInfo.indexc ; j++) {
-		    Tcl_ListObjAppendElement(interp, itemPtr,
-			    Tcl_NewIntObj(sortInfo.indexv[j]));
-		}
-		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
-	    } else {
-		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
-	    }
-	}
-    }
-
-    /*
-     * Return everything or a single value.
-     */
-
-    if (allMatches) {
-	Tcl_SetObjResult(interp, listPtr);
-    } else if (!inlineReturn) {
-	if (returnSubindices) {
-	    int j;
-
-	    itemPtr = Tcl_NewIntObj(index);
-	    for (j=0 ; j<sortInfo.indexc ; j++) {
-		Tcl_ListObjAppendElement(interp, itemPtr,
-			Tcl_NewIntObj(sortInfo.indexv[j]));
-	    }
-	    Tcl_SetObjResult(interp, itemPtr);
-	} else {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
-	}
-    } else if (index < 0) {
-	/*
-	 * Is this superfluous? The result should be a blank object by
-	 * default...
-	 */
-
-	Tcl_SetObjResult(interp, Tcl_NewObj());
-    } else {
-	Tcl_SetObjResult(interp, listv[index]);
-    }
-    result = TCL_OK;
-
-    /*
-     * Cleanup the index list array.
-     */
-
-  done:
-    if (sortInfo.indexc > 1) {
-	TclStackFree(interp, sortInfo.indexv);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LsetObjCmd --
- *
- *	This procedure is invoked to process the "lset" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LsetObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
-{
-    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
-    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
-
-    /*
-     * Check parameter count.
-     */
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"listVar ?index? ?index ...? value");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Look up the list variable's value.
-     */
-
-    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
-    if (listPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Substitute the value in the value. Return either the value or else an
-     * unshared copy of it.
-     */
-
-    if (objc == 4) {
-	finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
-    } else {
-	finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
-		objv[objc-1]);
-    }
-
-    /*
-     * If substitution has failed, bail out.
-     */
-
-    if (finalValuePtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Finally, update the variable so that traces fire.
-     */
-
-    listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
-	    TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(finalValuePtr);
-    if (listPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Return the new value of the variable as the interpreter result.
-     */
-
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LsortObjCmd --
- *
- *	This procedure is invoked to process the "lsort" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-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, indexc;
-    int sortMode = SORTMODE_ASCII;
-    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];
-				/* This array holds pointers to temporary
-				 * lists built during the merge sort. Element
-				 * i of the array holds a list of length
-				 * 2**i. */
-    static const char *const switches[] = {
-	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-indices", "-integer", "-nocase", "-real", "-stride",
-	"-unique", NULL
-    };
-    enum Lsort_Switches {
-	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
-	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
-	LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse arguments to set up the mode for the sort.
-     */
-
-    sortInfo.isIncreasing = 1;
-    sortInfo.sortMode = SORTMODE_ASCII;
-    sortInfo.indexv = NULL;
-    sortInfo.indexc = 0;
-    sortInfo.unique = 0;
-    sortInfo.interp = interp;
-    sortInfo.resultCode = TCL_OK;
-    cmdPtr = NULL;
-    indices = 0;
-    group = 0;
-    groupSize = 1;
-    groupOffset = 0;
-    indexPtr = NULL;
-    for (i = 1; i < objc-1; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
-		&index) != TCL_OK) {
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
-	}
-	switch ((enum Lsort_Switches) index) {
-	case LSORT_ASCII:
-	    sortInfo.sortMode = SORTMODE_ASCII;
-	    break;
-	case LSORT_COMMAND:
-	    if (i == objc-2) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-command\" option must be followed "
-			"by comparison command", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    sortInfo.sortMode = SORTMODE_COMMAND;
-	    cmdPtr = objv[i+1];
-	    i++;
-	    break;
-	case LSORT_DECREASING:
-	    sortInfo.isIncreasing = 0;
-	    break;
-	case LSORT_DICTIONARY:
-	    sortInfo.sortMode = SORTMODE_DICTIONARY;
-	    break;
-	case LSORT_INCREASING:
-	    sortInfo.isIncreasing = 1;
-	    break;
-	case LSORT_INDEX: {
-	    int indexc, dummy;
-	    Tcl_Obj **indexv;
-
-	    if (i == objc-2) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-index\" option must be followed by list index",
-			-1));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
-		    &indexv) != TCL_OK) {
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-
-	    /*
-	     * Check each of the indices for syntactic correctness. Note that
-	     * we do not store the converted values here because we do not
-	     * know if this is the only -index option yet and so we can't
-	     * allocate any space; that happens after the scan through all the
-	     * options is done.
-	     */
-
-	    for (j=0 ; j<indexc ; j++) {
-		if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
-			&dummy) != TCL_OK) {
-		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (-index option item number %d)", j));
-		    sortInfo.resultCode = TCL_ERROR;
-		    goto done2;
-		}
-	    }
-	    indexPtr = objv[i+1];
-	    i++;
-	    break;
-	}
-	case LSORT_INTEGER:
-	    sortInfo.sortMode = SORTMODE_INTEGER;
-	    break;
-	case LSORT_NOCASE:
-	    nocase = 1;
-	    break;
-	case LSORT_REAL:
-	    sortInfo.sortMode = SORTMODE_REAL;
-	    break;
-	case LSORT_UNIQUE:
-	    sortInfo.unique = 1;
-	    break;
-	case LSORT_INDICES:
-	    indices = 1;
-	    break;
-	case LSORT_STRIDE:
-	    if (i == objc-2) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-stride\" option must be "
-			"followed by stride length", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    if (groupSize < 2) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"stride length must be at least 2", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
-			"BADSTRIDE", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    group = 1;
-	    i++;
-	    break;
-	}
-    }
-    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
-	sortInfo.sortMode = SORTMODE_ASCII_NC;
-    }
-
-    /*
-     * Now extract the -index list for real, if present. No failures are
-     * expected here; the values are all of the right type or convertible to
-     * it.
-     */
-
-    if (indexPtr) {
-	Tcl_Obj **indexv;
-
-	TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
-	switch (sortInfo.indexc) {
-	case 0:
-	    sortInfo.indexv = NULL;
-	    break;
-	case 1:
-	    sortInfo.indexv = &sortInfo.singleIndex;
-	    break;
-	default:
-	    sortInfo.indexv =
-		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
-	    allocatedIndexVector = 1;	/* Cannot use indexc field, as it
-					 * might be decreased by 1 later. */
-	}
-	for (j=0 ; j<sortInfo.indexc ; j++) {
-	    TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
-		    &sortInfo.indexv[j]);
-	}
-    }
-
-    listObj = objv[objc-1];
-
-    if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	Tcl_Obj *newCommandPtr, *newObjPtr;
-
-	/*
-	 * When sorting using a command, we are reentrant and therefore might
-	 * have the representation of the list being sorted shimmered out from
-	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
-	 * 1675116]
-	 */
-
-	listObj = TclListObjCopy(interp, listObj);
-	if (listObj == NULL) {
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
-	}
-
-	/*
-	 * The existing command is a list. We want to flatten it, append two
-	 * dummy arguments on the end, and replace these arguments later.
-	 */
-
-	newCommandPtr = Tcl_DuplicateObj(cmdPtr);
-	TclNewObj(newObjPtr);
-	Tcl_IncrRefCount(newCommandPtr);
-	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
-		!= TCL_OK) {
-	    TclDecrRefCount(newCommandPtr);
-	    TclDecrRefCount(listObj);
-	    Tcl_IncrRefCount(newObjPtr);
-	    TclDecrRefCount(newObjPtr);
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
-	}
-	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
-	sortInfo.compareCmdPtr = newCommandPtr;
-    }
-
-    sortInfo.resultCode = TclListObjGetElements(interp, listObj,
-	    &length, &listObjPtrs);
-    if (sortInfo.resultCode != TCL_OK || length <= 0) {
-	goto done;
-    }
-
-    /*
-     * Check for sanity when grouping elements of the overall list together
-     * because of the -stride option. [TIP #326]
-     */
-
-    if (group) {
-	if (length % groupSize) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "list size must be a multiple of the stride length",
-		    -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
-		    NULL);
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done;
-	}
-	length = length / groupSize;
-	if (sortInfo.indexc > 0) {
-	    /*
-	     * Use the first value in the list supplied to -index as the
-	     * offset of the element within each group by which to sort.
-	     */
-
-	    groupOffset = sortInfo.indexv[0];
-	    if (groupOffset <= SORTIDX_END) {
-		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
-	    }
-	    if (groupOffset < 0 || groupOffset >= groupSize) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"when used with \"-stride\", the leading \"-index\""
-			" value must be within the group", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
-			"BADINDEX", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done;
-	    }
-	    if (sortInfo.indexc == 1) {
-		sortInfo.indexc = 0;
-		sortInfo.indexv = NULL;
-	    } else {
-		sortInfo.indexc--;
-
-		/*
-		 * Do not shrink the actual memory block used; that doesn't
-		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
-		 */
-
-		for (i = 0; i < sortInfo.indexc; i++) {
-		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
-		}
-	    }
-	}
-    }
-
-    sortInfo.numElements = length;
-
-    indexc = sortInfo.indexc;
-    sortMode = sortInfo.sortMode;
-    if ((sortMode == SORTMODE_ASCII_NC)
-	    || (sortMode == SORTMODE_DICTIONARY)) {
-	/*
-	 * For this function's purpose all string-based modes are equivalent
-	 */
-
-	sortMode = SORTMODE_ASCII;
-    }
-
-    /*
-     * Initialize the sublists. After the following loop, subList[i] will
-     * contain a sorted sublist of length 2**i. Use one extra subList at the
-     * end, always at NULL, to indicate the end of the lists.
-     */
-
-    for (j=0 ; j<=NUM_LISTS ; j++) {
-	subList[j] = NULL;
-    }
-
-    /*
-     * The following loop creates a SortElement for each list element and
-     * begins sorting it into the sublists as it appears.
-     */
-
-    elementArray = TclStackAlloc(interp, length * sizeof(SortElement));
-
-    for (i=0; i < length; i++){
-	idx = groupSize * i + groupOffset;
-	if (indexc) {
-	    /*
-	     * If this is an indexed sort, retrieve the corresponding element
-	     */
-	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
-	    if (sortInfo.resultCode != TCL_OK) {
-		goto done1;
-	    }
-	} else {
-	    indexPtr = listObjPtrs[idx];
-	}
-
-	/*
-	 * Determine the "value" of this object for sorting purposes
-	 */
-
-	if (sortMode == SORTMODE_ASCII) {
-	    elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
-	} else if (sortMode == SORTMODE_INTEGER) {
-	    Tcl_WideInt a;
-
-	    if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
-		sortInfo.resultCode = TCL_ERROR;
-		goto done1;
-	    }
-	    elementArray[i].collationKey.wideValue = a;
-	} else if (sortMode == SORTMODE_REAL) {
-	    double a;
-
-	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
-		    &a) != TCL_OK) {
-		sortInfo.resultCode = TCL_ERROR;
-		goto done1;
-	    }
-	    elementArray[i].collationKey.doubleValue = a;
-	} else {
-	    elementArray[i].collationKey.objValuePtr = indexPtr;
-	}
-
-	/*
-	 * Determine the representation of this element in the result: either
-	 * the objPtr itself, or its index in the original list.
-	 */
-
-	if (indices || group) {
-	    elementArray[i].payload.index = idx;
-	} else {
-	    elementArray[i].payload.objPtr = listObjPtrs[idx];
-	}
-
-	/*
-	 * Merge this element in the pre-existing sublists (and merge together
-	 * sublists when we have two of the same size).
-	 */
-
-	elementArray[i].nextPtr = NULL;
-	elementPtr = &elementArray[i];
-	for (j=0 ; subList[j] ; j++) {
-	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
-	    subList[j] = NULL;
-	}
-	if (j >= NUM_LISTS) {
-	    j = NUM_LISTS-1;
-	}
-	subList[j] = elementPtr;
-    }
-
-    /*
-     * Merge all sublists
-     */
-
-    elementPtr = subList[0];
-    for (j=1 ; j<NUM_LISTS ; j++) {
-	elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
-    }
-
-    /*
-     * Now store the sorted elements in the result list.
-     */
-
-    if (sortInfo.resultCode == TCL_OK) {
-	List *listRepPtr;
-	Tcl_Obj **newArray, *objPtr;
-
-	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
-	listRepPtr = ListRepPtr(resultPtr);
-	newArray = &listRepPtr->elements;
-	if (group) {
-	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
-		idx = elementPtr->payload.index;
-		for (j = 0; j < groupSize; j++) {
-		    if (indices) {
-			objPtr = Tcl_NewIntObj(idx + j - groupOffset);
-			newArray[i++] = objPtr;
-			Tcl_IncrRefCount(objPtr);
-		    } else {
-			objPtr = listObjPtrs[idx + j - groupOffset];
-			newArray[i++] = objPtr;
-			Tcl_IncrRefCount(objPtr);
-		    }
-		}
-	    }
-	} else if (indices) {
-	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
-		objPtr = Tcl_NewIntObj(elementPtr->payload.index);
-		newArray[i++] = objPtr;
-		Tcl_IncrRefCount(objPtr);
-	    }
-	} else {
-	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
-		objPtr = elementPtr->payload.objPtr;
-		newArray[i++] = objPtr;
-		Tcl_IncrRefCount(objPtr);
-	    }
-	}
-	listRepPtr->elemCount = i;
-	Tcl_SetObjResult(interp, resultPtr);
-    }
-
-  done1:
-    TclStackFree(interp, elementArray);
-
-  done:
-    if (sortMode == SORTMODE_COMMAND) {
-	TclDecrRefCount(sortInfo.compareCmdPtr);
-	TclDecrRefCount(listObj);
-	sortInfo.compareCmdPtr = NULL;
-    }
-  done2:
-    if (allocatedIndexVector) {
-	TclStackFree(interp, sortInfo.indexv);
-    }
-    return sortInfo.resultCode;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * MergeLists -
- *
- *	This procedure combines two sorted lists of SortElement structures
- *	into a single sorted list.
- *
- * Results:
- *	The unified list of SortElement structures.
- *
- * Side effects:
- *	If infoPtr->unique is set then infoPtr->numElements may be updated.
- *	Possibly others, if a user-defined comparison command does something
- *	weird.
- *
- * Note:
- *	If infoPtr->unique is set, the merge assumes that there are no
- *	"repeated" elements in each of the left and right lists. In that case,
- *	if any element of the left list is equivalent to one in the right list
- *	it is omitted from the merged list.
- *
- *	This simplified mechanism works because of the special way our
- *	MergeSort creates the sublists to be merged and will fail to eliminate
- *	all repeats in the general case where they are already present in
- *	either the left or right list. A general code would need to skip
- *	adjacent initial repeats in the left and right lists before comparing
- *	their initial elements, at each step.
- *
- *----------------------------------------------------------------------
- */
-
-static SortElement *
-MergeLists(
-    SortElement *leftPtr,	/* First list to be merged; may be NULL. */
-    SortElement *rightPtr,	/* Second list to be merged; may be NULL. */
-    SortInfo *infoPtr)		/* Information needed by the comparison
-				 * operator. */
-{
-    SortElement *headPtr, *tailPtr;
-    int cmp;
-
-    if (leftPtr == NULL) {
-	return rightPtr;
-    }
-    if (rightPtr == NULL) {
-	return leftPtr;
-    }
-    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
-    if (cmp > 0 || (cmp == 0 && infoPtr->unique)) {
-	if (cmp == 0) {
-	    infoPtr->numElements--;
-	    leftPtr = leftPtr->nextPtr;
-	}
-	tailPtr = rightPtr;
-	rightPtr = rightPtr->nextPtr;
-    } else {
-	tailPtr = leftPtr;
-	leftPtr = leftPtr->nextPtr;
-    }
-    headPtr = tailPtr;
-    if (!infoPtr->unique) {
-	while ((leftPtr != NULL) && (rightPtr != NULL)) {
-	    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
-	    if (cmp > 0) {
-		tailPtr->nextPtr = rightPtr;
-		tailPtr = rightPtr;
-		rightPtr = rightPtr->nextPtr;
-	    } else {
-		tailPtr->nextPtr = leftPtr;
-		tailPtr = leftPtr;
-		leftPtr = leftPtr->nextPtr;
-	    }
-	}
-    } else {
-	while ((leftPtr != NULL) && (rightPtr != NULL)) {
-	    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
-	    if (cmp >= 0) {
-		if (cmp == 0) {
-		    infoPtr->numElements--;
-		    leftPtr = leftPtr->nextPtr;
-		}
-		tailPtr->nextPtr = rightPtr;
-		tailPtr = rightPtr;
-		rightPtr = rightPtr->nextPtr;
-	    } else {
-		tailPtr->nextPtr = leftPtr;
-		tailPtr = leftPtr;
-		leftPtr = leftPtr->nextPtr;
-	    }
-	}
-    }
-    if (leftPtr != NULL) {
-	tailPtr->nextPtr = leftPtr;
-    } else {
-	tailPtr->nextPtr = rightPtr;
-    }
-    return headPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SortCompare --
- *
- *	This procedure is invoked by MergeLists to determine the proper
- *	ordering between two elements.
- *
- * Results:
- *	A negative results means the the first element comes before the
- *	second, and a positive results means that the second element should
- *	come first. A result of zero means the two elements are equal and it
- *	doesn't matter which comes first.
- *
- * Side effects:
- *	None, unless a user-defined comparison command does something weird.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SortCompare(
-    SortElement *elemPtr1, SortElement *elemPtr2,
-				/* Values to be compared. */
-    SortInfo *infoPtr)		/* Information passed from the top-level
-				 * "lsort" command. */
-{
-    int order = 0;
-
-    if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(elemPtr1->collationKey.strValuePtr,
-		elemPtr2->collationKey.strValuePtr);
-    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
-	order = TclUtfCasecmp(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) {
-	Tcl_WideInt a, b;
-
-	a = elemPtr1->collationKey.wideValue;
-	b = elemPtr2->collationKey.wideValue;
-	order = ((a >= b) - (a <= b));
-    } else if (infoPtr->sortMode == SORTMODE_REAL) {
-	double a, b;
-
-	a = elemPtr1->collationKey.doubleValue;
-	b = elemPtr2->collationKey.doubleValue;
-	order = ((a >= b) - (a <= b));
-    } else {
-	Tcl_Obj **objv, *paramObjv[2];
-	int objc;
-	Tcl_Obj *objPtr1, *objPtr2;
-
-	if (infoPtr->resultCode != TCL_OK) {
-	    /*
-	     * Once an error has occurred, skip any future comparisons so as
-	     * to preserve the error message in sortInterp->result.
-	     */
-
-	    return 0;
-	}
-
-
-	objPtr1 = elemPtr1->collationKey.objValuePtr;
-	objPtr2 = elemPtr2->collationKey.objValuePtr;
-
-	paramObjv[0] = objPtr1;
-	paramObjv[1] = objPtr2;
-
-	/*
-	 * We made space in the command list for the two things to compare.
-	 * Replace them and evaluate the result.
-	 */
-
-	TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
-	Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
-		2, 2, paramObjv);
-	TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
-		&objc, &objv);
-
-	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
-
-	if (infoPtr->resultCode != TCL_OK) {
-	    Tcl_AddErrorInfo(infoPtr->interp, "\n    (-compare command)");
-	    return 0;
-	}
-
-	/*
-	 * Parse the result of the command.
-	 */
-
-	if (TclGetIntFromObj(infoPtr->interp,
-		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
-	    Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
-		    "-compare command returned non-integer result", -1));
-	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
-		    "COMPARISONFAILED", NULL);
-	    infoPtr->resultCode = TCL_ERROR;
-	    return 0;
-	}
-    }
-    if (!infoPtr->isIncreasing) {
-	order = -order;
-    }
-    return order;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DictionaryCompare
- *
- *	This function compares two strings as if they were being used in an
- *	index or card catalog. The case of alphabetic characters is ignored,
- *	except to break ties. Thus "B" comes before "b" but after "a". Also,
- *	integers embedded in the strings compare in numerical order. In other
- *	words, "x10y" comes after "x9y", not * before it as it would when
- *	using strcmp().
- *
- * Results:
- *	A negative result means that the first element comes before the
- *	second, and a positive result means that the second element should
- *	come first. A result of zero means the two elements are equal and it
- *	doesn't matter which comes first.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DictionaryCompare(
-    const char *left, const char *right)	/* The strings to compare. */
-{
-    Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
-    int diff, zeros;
-    int secondaryDiff = 0;
-
-    while (1) {
-	if (isdigit(UCHAR(*right))		/* INTL: digit */
-		&& isdigit(UCHAR(*left))) {	/* INTL: digit */
-	    /*
-	     * There are decimal numbers embedded in the two strings. Compare
-	     * them as numbers, rather than strings. If one number has more
-	     * leading zeros than the other, the number with more leading
-	     * zeros sorts later, but only as a secondary choice.
-	     */
-
-	    zeros = 0;
-	    while ((*right == '0') && isdigit(UCHAR(right[1]))) {
-		right++;
-		zeros--;
-	    }
-	    while ((*left == '0') && isdigit(UCHAR(left[1]))) {
-		left++;
-		zeros++;
-	    }
-	    if (secondaryDiff == 0) {
-		secondaryDiff = zeros;
-	    }
-
-	    /*
-	     * The code below compares the numbers in the two strings without
-	     * ever converting them to integers. It does this by first
-	     * comparing the lengths of the numbers and then comparing the
-	     * digit values.
-	     */
-
-	    diff = 0;
-	    while (1) {
-		if (diff == 0) {
-		    diff = UCHAR(*left) - UCHAR(*right);
-		}
-		right++;
-		left++;
-		if (!isdigit(UCHAR(*right))) {		/* INTL: digit */
-		    if (isdigit(UCHAR(*left))) {	/* INTL: digit */
-			return 1;
-		    } else {
-			/*
-			 * The two numbers have the same length. See if their
-			 * values are different.
-			 */
-
-			if (diff != 0) {
-			    return diff;
-			}
-			break;
-		    }
-		} else if (!isdigit(UCHAR(*left))) {	/* INTL: digit */
-		    return -1;
-		}
-	    }
-	    continue;
-	}
-
-	/*
-	 * Convert character to Unicode for comparison purposes. If either
-	 * string is at the terminating null, do a byte-wise comparison and
-	 * bail out immediately.
-	 */
-
-	if ((*left != '\0') && (*right != '\0')) {
-	    left += Tcl_UtfToUniChar(left, &uniLeft);
-	    right += Tcl_UtfToUniChar(right, &uniRight);
-
-	    /*
-	     * Convert both chars to lower for the comparison, because
-	     * dictionary sorts are case insensitve. Covert to lower, not
-	     * upper, so chars between Z and a will sort before A (where most
-	     * other interesting punctuations occur).
-	     */
-
-	    uniLeftLower = Tcl_UniCharToLower(uniLeft);
-	    uniRightLower = Tcl_UniCharToLower(uniRight);
-	} else {
-	    diff = UCHAR(*left) - UCHAR(*right);
-	    break;
-	}
-
-	diff = uniLeftLower - uniRightLower;
-	if (diff) {
-	    return diff;
-	}
-	if (secondaryDiff == 0) {
-	    if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
-		secondaryDiff = -1;
-	    } else if (Tcl_UniCharIsUpper(uniRight)
-		    && Tcl_UniCharIsLower(uniLeft)) {
-		secondaryDiff = 1;
-	    }
-	}
-    }
-    if (diff == 0) {
-	diff = secondaryDiff;
-    }
-    return diff;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SelectObjFromSublist --
- *
- *	This procedure is invoked from lsearch and SortCompare. It is used for
- *	implementing the -index option, for the lsort and lsearch commands.
- *
- * Results:
- *	Returns NULL if a failure occurs, and sets the result in the infoPtr.
- *	Otherwise returns the Tcl_Obj* to the item.
- *
- * Side effects:
- *	None.
- *
- * Note:
- *	No reference counting is done, as the result is only used internally
- *	and never passed directly to user code.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-SelectObjFromSublist(
-    Tcl_Obj *objPtr,		/* Obj to select sublist from. */
-    SortInfo *infoPtr)		/* Information passed from the top-level
-				 * "lsearch" or "lsort" command. */
-{
-    int i;
-
-    /*
-     * Quick check for case when no "-index" option is there.
-     */
-
-    if (infoPtr->indexc == 0) {
-	return objPtr;
-    }
-
-    /*
-     * Iterate over the indices, traversing through the nested sublists as we
-     * go.
-     */
-
-    for (i=0 ; i<infoPtr->indexc ; i++) {
-	int listLen, index;
-	Tcl_Obj *currentObj;
-
-	if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return NULL;
-	}
-	index = infoPtr->indexv[i];
-
-	/*
-	 * Adjust for end-based indexing.
-	 */
-
-	if (index < SORTIDX_NONE) {
-	    index += listLen + 1;
-	}
-
-	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
-		&currentObj) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return NULL;
-	}
-	if (currentObj == NULL) {
-	    Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
-		    "element %d missing from sublist \"%s\"",
-		    index, TclGetString(objPtr)));
-	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
-		    "INDEXFAILED", NULL);
-	    infoPtr->resultCode = TCL_ERROR;
-	    return NULL;
-	}
-	objPtr = currentObj;
-    }
-    return objPtr;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * End:
- */