source: downloads/tcl8.5.2/generic/tclBasic.c @ 35

/*
 * tclBasic.c --
 *
 *      Contains the basic facilities for TCL command interpretation,
 *      including interpreter creation and deletion, command creation and
 *      deletion, and command/script execution.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.295 2008/03/14 19:53:10 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
#include <math.h>
#include "tommath.h"

/*
 * Determine whether we're using IEEE floating point
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#   define IEEE_FLOATING_POINT
/* Largest odd integer that can be represented exactly in a double */
#   define MAX_EXACT 9007199254740991.0
#endif

/*
 * The following structure defines the client data for a math function
 * registered with Tcl_CreateMathFunc
 */

typedef struct OldMathFuncData {
    Tcl_MathProc *proc;         /* Handler function */
    int numArgs;                /* Number of args expected */
    Tcl_ValueType *argTypes;    /* Types of the args */
    ClientData clientData;      /* Client data for the handler function */
} OldMathFuncData;

/*
 * Static functions in this file:
 */

static char *   CallCommandTraces(Interp *iPtr, Command *cmdPtr,
                    const char *oldName, const char *newName, int flags);
static int      CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void     DeleteInterpProc(Tcl_Interp *interp);
static void     DeleteOpCmdClientData(ClientData clientData);
static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
                    int numChars, int objc, Tcl_Obj *const objv[]);
static void     ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
static int      OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static void     OldMathFuncDeleteProc(ClientData clientData);
static int      ExprAbsFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprBoolFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprCeilFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprEntierFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprFloorFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprIntFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprRandFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprRoundFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprSrandFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static int      ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
                    int argc, Tcl_Obj *const *objv);
static void     MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
                    int actual, Tcl_Obj *const *objv);
#ifdef USE_DTRACE
static int      DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
                    Tcl_Obj *const objv[]);
#endif

extern TclStubs tclStubs;

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;           /* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;    /* Object-based function for command. */
    CompileProc *compileProc;   /* Function called to compile command. */
    int isSafe;                 /* If non-zero, command will be present in
                                 * safe interpreter. Otherwise it will be
                                 * hidden. */
} CmdInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
     */

    {"append",          Tcl_AppendObjCmd,       TclCompileAppendCmd,    1},
    {"apply",           Tcl_ApplyObjCmd,        NULL,                   1},
    {"array",           Tcl_ArrayObjCmd,        NULL,                   1},
    {"binary",          Tcl_BinaryObjCmd,       NULL,                   1},
    {"break",           Tcl_BreakObjCmd,        TclCompileBreakCmd,     1},
#ifndef EXCLUDE_OBSOLETE_COMMANDS
    {"case",            Tcl_CaseObjCmd,         NULL,                   1},
#endif
    {"catch",           Tcl_CatchObjCmd,        TclCompileCatchCmd,     1},
    {"concat",          Tcl_ConcatObjCmd,       NULL,                   1},
    {"continue",        Tcl_ContinueObjCmd,     TclCompileContinueCmd,  1},
    {"error",           Tcl_ErrorObjCmd,        NULL,                   1},
    {"eval",            Tcl_EvalObjCmd,         NULL,                   1},
    {"expr",            Tcl_ExprObjCmd,         TclCompileExprCmd,      1},
    {"for",             Tcl_ForObjCmd,          TclCompileForCmd,       1},
    {"foreach",         Tcl_ForeachObjCmd,      TclCompileForeachCmd,   1},
    {"format",          Tcl_FormatObjCmd,       NULL,                   1},
    {"global",          Tcl_GlobalObjCmd,       TclCompileGlobalCmd,    1},
    {"if",              Tcl_IfObjCmd,           TclCompileIfCmd,        1},
    {"incr",            Tcl_IncrObjCmd,         TclCompileIncrCmd,      1},
    {"join",            Tcl_JoinObjCmd,         NULL,                   1},
    {"lappend",         Tcl_LappendObjCmd,      TclCompileLappendCmd,   1},
    {"lassign",         Tcl_LassignObjCmd,      TclCompileLassignCmd,   1},
    {"lindex",          Tcl_LindexObjCmd,       TclCompileLindexCmd,    1},
    {"linsert",         Tcl_LinsertObjCmd,      NULL,                   1},
    {"list",            Tcl_ListObjCmd,         TclCompileListCmd,      1},
    {"llength",         Tcl_LlengthObjCmd,      TclCompileLlengthCmd,   1},
    {"lrange",          Tcl_LrangeObjCmd,       NULL,                   1},
    {"lrepeat",         Tcl_LrepeatObjCmd,      NULL,                   1},
    {"lreplace",        Tcl_LreplaceObjCmd,     NULL,                   1},
    {"lreverse",        Tcl_LreverseObjCmd,     NULL,                   1},
    {"lsearch",         Tcl_LsearchObjCmd,      NULL,                   1},
    {"lset",            Tcl_LsetObjCmd,         TclCompileLsetCmd,      1},
    {"lsort",           Tcl_LsortObjCmd,        NULL,                   1},
    {"namespace",       Tcl_NamespaceObjCmd,    TclCompileNamespaceCmd, 1},
    {"package",         Tcl_PackageObjCmd,      NULL,                   1},
    {"proc",            Tcl_ProcObjCmd,         NULL,                   1},
    {"regexp",          Tcl_RegexpObjCmd,       TclCompileRegexpCmd,    1},
    {"regsub",          Tcl_RegsubObjCmd,       NULL,                   1},
    {"rename",          Tcl_RenameObjCmd,       NULL,                   1},
    {"return",          Tcl_ReturnObjCmd,       TclCompileReturnCmd,    1},
    {"scan",            Tcl_ScanObjCmd,         NULL,                   1},
    {"set",             Tcl_SetObjCmd,          TclCompileSetCmd,       1},
    {"split",           Tcl_SplitObjCmd,        NULL,                   1},
    {"subst",           Tcl_SubstObjCmd,        NULL,                   1},
    {"switch",          Tcl_SwitchObjCmd,       TclCompileSwitchCmd,    1},
    {"trace",           Tcl_TraceObjCmd,        NULL,                   1},
    {"unset",           Tcl_UnsetObjCmd,        NULL,                   1},
    {"uplevel",         Tcl_UplevelObjCmd,      NULL,                   1},
    {"upvar",           Tcl_UpvarObjCmd,        TclCompileUpvarCmd,     1},
    {"variable",        Tcl_VariableObjCmd,     TclCompileVariableCmd,  1},
    {"while",           Tcl_WhileObjCmd,        TclCompileWhileCmd,     1},

    /*
     * Commands in the OS-interface. Note that many of these are unsafe.
     */

    {"after",           Tcl_AfterObjCmd,        NULL,                   1},
    {"cd",              Tcl_CdObjCmd,           NULL,                   0},
    {"close",           Tcl_CloseObjCmd,        NULL,                   1},
    {"eof",             Tcl_EofObjCmd,          NULL,                   1},
    {"encoding",        Tcl_EncodingObjCmd,     NULL,                   0},
    {"exec",            Tcl_ExecObjCmd,         NULL,                   0},
    {"exit",            Tcl_ExitObjCmd,         NULL,                   0},
    {"fblocked",        Tcl_FblockedObjCmd,     NULL,                   1},
    {"fconfigure",      Tcl_FconfigureObjCmd,   NULL,                   0},
    {"fcopy",           Tcl_FcopyObjCmd,        NULL,                   1},
    {"file",            Tcl_FileObjCmd,         NULL,                   0},
    {"fileevent",       Tcl_FileEventObjCmd,    NULL,                   1},
    {"flush",           Tcl_FlushObjCmd,        NULL,                   1},
    {"gets",            Tcl_GetsObjCmd,         NULL,                   1},
    {"glob",            Tcl_GlobObjCmd,         NULL,                   0},
    {"load",            Tcl_LoadObjCmd,         NULL,                   0},
    {"open",            Tcl_OpenObjCmd,         NULL,                   0},
    {"pid",             Tcl_PidObjCmd,          NULL,                   1},
    {"puts",            Tcl_PutsObjCmd,         NULL,                   1},
    {"pwd",             Tcl_PwdObjCmd,          NULL,                   0},
    {"read",            Tcl_ReadObjCmd,         NULL,                   1},
    {"seek",            Tcl_SeekObjCmd,         NULL,                   1},
    {"socket",          Tcl_SocketObjCmd,       NULL,                   0},
    {"source",          Tcl_SourceObjCmd,       NULL,                   0},
    {"tell",            Tcl_TellObjCmd,         NULL,                   1},
    {"time",            Tcl_TimeObjCmd,         NULL,                   1},
    {"unload",          Tcl_UnloadObjCmd,       NULL,                   0},
    {"update",          Tcl_UpdateObjCmd,       NULL,                   1},
    {"vwait",           Tcl_VwaitObjCmd,        NULL,                   1},
    {NULL,              NULL,                   NULL,                   0}
};

/*
 * Math functions. All are safe.
 */

typedef struct {
    const char *name;           /* Name of the function. The full name is
                                 * "::tcl::mathfunc::<name>".  */
    Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */
    ClientData clientData;      /* Client data for the function */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",    ExprAbsFunc,    NULL                    },
    { "acos",   ExprUnaryFunc,  (ClientData) acos       },
    { "asin",   ExprUnaryFunc,  (ClientData) asin       },
    { "atan",   ExprUnaryFunc,  (ClientData) atan       },
    { "atan2",  ExprBinaryFunc, (ClientData) atan2      },
    { "bool",   ExprBoolFunc,   NULL                    },
    { "ceil",   ExprCeilFunc,   NULL                    },
    { "cos",    ExprUnaryFunc,  (ClientData) cos        },
    { "cosh",   ExprUnaryFunc,  (ClientData) cosh       },
    { "double", ExprDoubleFunc, NULL                    },
    { "entier", ExprEntierFunc, NULL                    },
    { "exp",    ExprUnaryFunc,  (ClientData) exp        },
    { "floor",  ExprFloorFunc,  NULL                    },
    { "fmod",   ExprBinaryFunc, (ClientData) fmod       },
    { "hypot",  ExprBinaryFunc, (ClientData) hypot      },
    { "int",    ExprIntFunc,    NULL                    },
    { "isqrt",  ExprIsqrtFunc,  NULL                    },
    { "log",    ExprUnaryFunc,  (ClientData) log        },
    { "log10",  ExprUnaryFunc,  (ClientData) log10      },
    { "pow",    ExprBinaryFunc, (ClientData) pow        },
    { "rand",   ExprRandFunc,   NULL                    },
    { "round",  ExprRoundFunc,  NULL                    },
    { "sin",    ExprUnaryFunc,  (ClientData) sin        },
    { "sinh",   ExprUnaryFunc,  (ClientData) sinh       },
    { "sqrt",   ExprSqrtFunc,   NULL                    },
    { "srand",  ExprSrandFunc,  NULL                    },
    { "tan",    ExprUnaryFunc,  (ClientData) tan        },
    { "tanh",   ExprUnaryFunc,  (ClientData) tanh       },
    { "wide",   ExprWideFunc,   NULL                    },
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
 */

typedef struct {
    const char *name;           /* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;    /* Object-based function for command. */
    CompileProc *compileProc;   /* Function called to compile command. */
    union {
        int numArgs;
        int identity;
    } i;
    const char *expected;       /* For error message, what argument(s)
                                 * were expected. */
} OpCmdInfo;
static const OpCmdInfo mathOpCmds[] = {
    { "~",      TclSingleOpCmd,         TclCompileInvertOpCmd,
                /* numArgs */ {1},      "integer"},
    { "!",      TclSingleOpCmd,         TclCompileNotOpCmd,
                /* numArgs */ {1},      "boolean"},
    { "+",      TclVariadicOpCmd,       TclCompileAddOpCmd,
                /* identity */ {0},     NULL},
    { "*",      TclVariadicOpCmd,       TclCompileMulOpCmd,
                /* identity */ {1},     NULL},
    { "&",      TclVariadicOpCmd,       TclCompileAndOpCmd,
                /* identity */ {-1},    NULL},
    { "|",      TclVariadicOpCmd,       TclCompileOrOpCmd,
                /* identity */ {0},     NULL},
    { "^",      TclVariadicOpCmd,       TclCompileXorOpCmd,
                /* identity */ {0},     NULL},
    { "**",     TclVariadicOpCmd,       TclCompilePowOpCmd,
                /* identity */ {1},     NULL},
    { "<<",     TclSingleOpCmd,         TclCompileLshiftOpCmd,
                /* numArgs */ {2},      "integer shift"},
    { ">>",     TclSingleOpCmd,         TclCompileRshiftOpCmd,
                /* numArgs */ {2},      "integer shift"},
    { "%",      TclSingleOpCmd,         TclCompileModOpCmd,
                /* numArgs */ {2},      "integer integer"},
    { "!=",     TclSingleOpCmd,         TclCompileNeqOpCmd,
                /* numArgs */ {2},      "value value"},
    { "ne",     TclSingleOpCmd,         TclCompileStrneqOpCmd,
                /* numArgs */ {2},      "value value"},
    { "in",     TclSingleOpCmd,         TclCompileInOpCmd,
                /* numArgs */ {2},      "value list"},
    { "ni",     TclSingleOpCmd,         TclCompileNiOpCmd,
                /* numArgs */ {2},      "value list"},
    { "-",      TclNoIdentOpCmd,        TclCompileMinusOpCmd,
                /* unused */ {0},       "value ?value ...?"},
    { "/",      TclNoIdentOpCmd,        TclCompileDivOpCmd,
                /* unused */ {0},       "value ?value ...?"},
    { "<",      TclSortingOpCmd,        TclCompileLessOpCmd,
                /* unused */ {0},       NULL},
    { "<=",     TclSortingOpCmd,        TclCompileLeqOpCmd,
                /* unused */ {0},       NULL},
    { ">",      TclSortingOpCmd,        TclCompileGreaterOpCmd,
                /* unused */ {0},       NULL},
    { ">=",     TclSortingOpCmd,        TclCompileGeqOpCmd,
                /* unused */ {0},       NULL},
    { "==",     TclSortingOpCmd,        TclCompileEqOpCmd,
                /* unused */ {0},       NULL},
    { "eq",     TclSortingOpCmd,        TclCompileStreqOpCmd,
                /* unused */ {0},       NULL},
    { NULL,     NULL,                   NULL,
                {0},                    NULL}
};

/*
 * Macros for stack checks. The goal of these macros is to allow the size of
 * the stack to be checked (so preventing overflow) in a *cheap* way. Note
 * that the check needs to be (amortized) cheap since it is on the critical
 * path for recursion.
 */

#if defined(TCL_NO_STACK_CHECK)
/*
 * Stack check disabled: make them noops.
 */

#   define CheckCStack(interp, localIntPtr)     1
#   define GetCStackParams(iPtr)                /* do nothing */
#elif defined(TCL_CROSS_COMPILE)

/*
 * This variable is static and only set *once*, during library initialization.
 * It therefore needs no thread guards.
 */

static int stackGrowsDown = 1;
#   define GetCStackParams(iPtr) \
    stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
#   define CheckCStack(iPtr, localIntPtr) \
    (stackGrowsDown \
            ? ((localIntPtr) > (iPtr)->stackBound) \
            : ((localIntPtr) < (iPtr)->stackBound) \
    )
#else /* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
#   define GetCStackParams(iPtr) \
    TclpGetCStackParams(&((iPtr)->stackBound))
#   ifdef TCL_STACK_GROWS_UP
#       define CheckCStack(iPtr, localIntPtr) \
           (!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
#    else /* TCL_STACK_GROWS_UP */
#       define CheckCStack(iPtr, localIntPtr) \
           ((localIntPtr) > (iPtr)->stackBound)
#    endif /* TCL_STACK_GROWS_UP */
#endif /* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
 *      Create a new TCL command interpreter.
 *
 * Results:
 *      The return value is a token for the interpreter, which may be used in
 *      calls to functions like Tcl_CreateCmd, Tcl_Eval, or Tcl_DeleteInterp.
 *
 * Side effects:
 *      The command interpreter is initialized with the built-in commands and
 *      with the variables documented in tclvars(n).
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_CreateInterp(void)
{
    Interp *iPtr;
    Tcl_Interp *interp;
    Command *cmdPtr;
    const BuiltinFuncDef *builtinFuncPtr;
    const OpCmdInfo *opcmdInfoPtr;
    const CmdInfo *cmdInfoPtr;
    Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
    union {
        char c[sizeof(short)];
        short s;
    } order;
#ifdef TCL_COMPILE_STATS
    ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
    char mathFuncName[32];
    CallFrame *framePtr;
    int result;

    TclInitSubsystems();

    /*
     * Panic if someone updated the CallFrame structure without also updating
     * the Tcl_CallFrame structure (or vice versa).
     */

    if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
        /*NOTREACHED*/
        Tcl_Panic("Tcl_CallFrame and CallFrame are not the same size");
    }

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = (Interp *) ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

    iPtr->result = iPtr->resultSpace;
    iPtr->freeProc = NULL;
    iPtr->errorLine = 0;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->numLevels = 0;
    iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
    iPtr->framePtr = NULL;      /* Initialise as soon as :: is available */
    iPtr->varFramePtr = NULL;   /* Initialise as soon as :: is available */

    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and
     * Proc structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);

    iPtr->activeVarTracePtr = NULL;

    iPtr->returnOpts = NULL;
    iPtr->errorInfo = NULL;
    TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
    Tcl_IncrRefCount(iPtr->eiVar);
    iPtr->errorCode = NULL;
    TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;

    iPtr->rootFramePtr = NULL;  /* Initialise as soon as :: is available */
    iPtr->lookupNsPtr = NULL;

    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
        iPtr->packagePrefer = PKG_PREFER_STABLE;
    } else {
        iPtr->packagePrefer = PKG_PREFER_LATEST;
    }

    iPtr->cmdCount = 0;
    TclInitLiteralTable(&(iPtr->literalTable));
    iPtr->compileEpoch = 0;
    iPtr->compiledProcPtr = NULL;
    iPtr->resolverPtr = NULL;
    iPtr->evalFlags = 0;
    iPtr->scriptFile = NULL;
    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->tracesForbiddingInline = 0;
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;    /* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
                                /* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->resultSpace[0] = 0;
    iPtr->threadId = Tcl_GetCurrentThread();

    /*
     * Initialise the tables for variable traces and searches *before*
     * creating the global ns - so that the trace on errorInfo can be
     * recorded.
     */

    Tcl_InitHashTable(&iPtr->varTraces, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(&iPtr->varSearches, TCL_ONE_WORD_KEYS);

    iPtr->globalNsPtr = NULL;   /* Force creation of global ns below. */
    iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
            NULL, NULL);
    if (iPtr->globalNsPtr == NULL) {
        Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
    }

    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
            (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    if (result != TCL_OK) {
        Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
    }
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;

    /*
     * Initialize support for code compilation and execution. We call
     * TclCreateExecEnv after initializing namespaces since it tries to
     * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
     * variable).
     */

    iPtr->execEnvPtr = TclCreateExecEnv(interp);

    /*
     * TIP #219, Tcl Channel Reflection API support.
     */

    iPtr->chanMsg = NULL;

    /*
     * Initialize the compilation and execution statistics kept for this
     * interpreter.
     */

#ifdef TCL_COMPILE_STATS
    statsPtr = &(iPtr->stats);
    statsPtr->numExecutions = 0;
    statsPtr->numCompilations = 0;
    statsPtr->numByteCodesFreed = 0;
    (void) memset(statsPtr->instructionCount, 0,
            sizeof(statsPtr->instructionCount));

    statsPtr->totalSrcBytes = 0.0;
    statsPtr->totalByteCodeBytes = 0.0;
    statsPtr->currentSrcBytes = 0.0;
    statsPtr->currentByteCodeBytes = 0.0;
    (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
    (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
    (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));

    statsPtr->currentInstBytes = 0.0;
    statsPtr->currentLitBytes = 0.0;
    statsPtr->currentExceptBytes = 0.0;
    statsPtr->currentAuxBytes = 0.0;
    statsPtr->currentCmdMapBytes = 0.0;

    statsPtr->numLiteralsCreated = 0;
    statsPtr->totalLitStringBytes = 0.0;
    statsPtr->currentLitStringBytes = 0.0;
    (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */

    /*
     * Initialise the stub table pointer.
     */

    iPtr->stubTable = &tclStubs;

    /*
     * Initialize the ensemble error message rewriting support.
     */

    iPtr->ensembleRewrite.sourceObjs = NULL;
    iPtr->ensembleRewrite.numRemovedObjs = 0;
    iPtr->ensembleRewrite.numInsertedObjs = 0;

    /*
     * TIP#143: Initialise the resource limit support.
     */

    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko.
     */

#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();

    /*
     * Insure that the stack checking mechanism for this interp is
     * initialized.
     */

    GetCStackParams(iPtr);

    /*
     * Create the core commands. Do it here, rather than calling
     * Tcl_CreateCommand, because it's faster (there's no need to check for a
     * pre-existing command by the same name). If a command has a Tcl_CmdProc
     * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
     * TclInvokeStringCommand. This is an object-based wrapper function that
     * extracts strings, calls the string function, and creates an object for
     * the result. Similarly, if a command has a Tcl_ObjCmdProc but no
     * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
     */

    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL; cmdInfoPtr++) {
        int isNew;
        Tcl_HashEntry *hPtr;

        if ((cmdInfoPtr->objProc == NULL)
                && (cmdInfoPtr->compileProc == NULL)) {
            Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
        }

        hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
                cmdInfoPtr->name, &isNew);
        if (isNew) {
            cmdPtr = (Command *) ckalloc(sizeof(Command));
            cmdPtr->hPtr = hPtr;
            cmdPtr->nsPtr = iPtr->globalNsPtr;
            cmdPtr->refCount = 1;
            cmdPtr->cmdEpoch = 0;
            cmdPtr->compileProc = cmdInfoPtr->compileProc;
            cmdPtr->proc = TclInvokeObjectCommand;
            cmdPtr->clientData = cmdPtr;
            cmdPtr->objProc = cmdInfoPtr->objProc;
            cmdPtr->objClientData = NULL;
            cmdPtr->deleteProc = NULL;
            cmdPtr->deleteData = NULL;
            cmdPtr->flags = 0;
            cmdPtr->importRefPtr = NULL;
            cmdPtr->tracePtr = NULL;
            Tcl_SetHashValue(hPtr, cmdPtr);
        }
    }

    /*
     * Create the "chan", "dict", "info" and "string" ensembles. Note that all
     * these commands (and their subcommands that are not present in the
     * global namespace) are wholly safe.
     */

    TclInitChanCmd(interp);
    TclInitDictCmd(interp);
    TclInitInfoCmd(interp);
    TclInitStringCmd(interp);

    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

    TclClockInit(interp);

    /*
     * Register the built-in functions. This is empty now that they are
     * implemented as commands in the ::tcl::mathfunc namespace.
     */

    /*
     * Register the default [interp bgerror] handler.
     */

    Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
            TclDefaultBgErrorHandlerObjCmd, NULL, NULL);

    /*
     * Create an unsupported command for debugging bytecode.
     */

    Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
            Tcl_DisassembleObjCmd, NULL, NULL);

#ifdef USE_DTRACE
    /*
     * Register the tcl::dtrace command.
     */

    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */

    /*
     * Register the builtin math functions.
     */

    mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    if (mathfuncNSPtr == NULL) {
        Tcl_Panic("Can't create math function namespace");
    }
    strcpy(mathFuncName, "::tcl::mathfunc::");
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
            builtinFuncPtr++) {
        strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
        Tcl_CreateObjCommand(interp, mathFuncName,
                builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
        Tcl_Export(interp, mathfuncNSPtr, builtinFuncPtr->name, 0);
    }

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    mathopNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    if (mathopNSPtr == NULL) {
        Tcl_Panic("can't create math operator namespace");
    }
    (void) Tcl_Export(interp, mathopNSPtr, "*", 1);
    strcpy(mathFuncName, "::tcl::mathop::");
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
        TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
                ckalloc(sizeof(TclOpCmdClientData));

        occdPtr->op = opcmdInfoPtr->name;
        occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
        occdPtr->expected = opcmdInfoPtr->expected;
        strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
        cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
                opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
        if (cmdPtr == NULL) {
            Tcl_Panic("failed to create math operator %s",
                    opcmdInfoPtr->name);
        } else if (opcmdInfoPtr->compileProc != NULL) {
            cmdPtr->compileProc = opcmdInfoPtr->compileProc;
        }
    }

    /*
     * Do Multiple/Safe Interps Tcl init stuff
     */

    TclInterpInit(interp);
    TclSetupEnv(interp);

    /*
     * TIP #59: Make embedded configuration information available.
     */

    TclInitEmbeddedConfigurationInformation(interp);

    /*
     * Compute the byte order of this machine.
     */

    order.s = 1;
    Tcl_SetVar2(interp, "tcl_platform", "byteOrder",
            ((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
            TCL_GLOBAL_ONLY);

    Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
            Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);

    /* TIP #291 */
    Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
            Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);

    /*
     * Set up other variables such as tcl_version and tcl_library
     */

    Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
            TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
            TclPrecTraceProc, NULL);
    TclpSetVariables(interp);

#ifdef TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */

    Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY);
#endif

    /*
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);

#ifdef Tcl_InitStubs
#undef Tcl_InitStubs
#endif
    Tcl_InitStubs(interp, TCL_VERSION, 1);

    if (TclTommath_Init(interp) != TCL_OK) {
        Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
    }

    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = clientData;

    ckfree((char *) occdPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHideUnsafeCommands --
 *
 *      Hides base commands that are not marked as safe from this interpreter.
 *
 * Results:
 *      TCL_OK if it succeeds, TCL_ERROR else.
 *
 * Side effects:
 *      Hides functionality in an interpreter.
 *
 *----------------------------------------------------------------------
 */

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)         /* Hide commands in this interpreter. */
{
    register const CmdInfo *cmdInfoPtr;

    if (interp == NULL) {
        return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
        if (!cmdInfoPtr->isSafe) {
            Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
        }
    }
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *      Arrange for a function to be called before a given interpreter is
 *      deleted. The function is called as soon as Tcl_DeleteInterp is called;
 *      if Tcl_CallWhenDeleted is called on an interpreter that has already
 *      been deleted, the function will be called when the last Tcl_Release is
 *      done on the interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      When Tcl_DeleteInterp is invoked to delete interp, proc will be
 *      invoked. See the manual entry for details.
 *
 *--------------------------------------------------------------
 */

void
Tcl_CallWhenDeleted(
    Tcl_Interp *interp,         /* Interpreter to watch. */
    Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
                                 * to be deleted. */
    ClientData clientData)      /* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
            Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_DontCallWhenDeleted --
 *
 *      Cancel the arrangement for a function to be called when a given
 *      interpreter is deleted.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If proc and clientData were previously registered as a callback via
 *      Tcl_CallWhenDeleted, they are unregistered. If they weren't previously
 *      registered then nothing happens.
 *
 *--------------------------------------------------------------
 */

void
Tcl_DontCallWhenDeleted(
    Tcl_Interp *interp,         /* Interpreter to watch. */
    Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
                                 * to be deleted. */
    ClientData clientData)      /* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTablePtr;
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    AssocData *dPtr;

    hTablePtr = iPtr->assocData;
    if (hTablePtr == NULL) {
        return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
            hPtr = Tcl_NextHashEntry(&hSearch)) {
        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
        if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
            ckfree((char *) dPtr);
            Tcl_DeleteHashEntry(hPtr);
            return;
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetAssocData --
 *
 *      Creates a named association between user-specified data, a delete
 *      function and this interpreter. If the association already exists the
 *      data is overwritten with the new data. The delete function will be
 *      invoked when the interpreter is deleted.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Sets the associated data, creates the association if needed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetAssocData(
    Tcl_Interp *interp,         /* Interpreter to associate with. */
    const char *name,           /* Name for association. */
    Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to
                                 * be deleted. */
    ClientData clientData)      /* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
        dPtr = Tcl_GetHashValue(hPtr);
    } else {
        dPtr = (AssocData *) ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteAssocData --
 *
 *      Deletes a named association of user-specified data with the specified
 *      interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Deletes the association.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteAssocData(
    Tcl_Interp *interp,         /* Interpreter to associate with. */
    const char *name)           /* Name of association. */
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;

    if (iPtr->assocData == NULL) {
        return;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
        return;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
        dPtr->proc(dPtr->clientData, interp);
    }
    ckfree((char *) dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --
 *
 *      Returns the client data associated with this name in the specified
 *      interpreter.
 *
 * Results:
 *      The client data in the AssocData record denoted by the named
 *      association, or NULL.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_GetAssocData(
    Tcl_Interp *interp,         /* Interpreter associated with. */
    const char *name,           /* Name of association. */
    Tcl_InterpDeleteProc **procPtr)
                                /* Pointer to place to store address of
                                 * current deletion callback. */
{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;

    if (iPtr->assocData == NULL) {
        return NULL;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
        return NULL;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    if (procPtr != NULL) {
        *procPtr = dPtr->proc;
    }
    return dPtr->clientData;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpDeleted --
 *
 *      Returns nonzero if the interpreter has been deleted with a call to
 *      Tcl_DeleteInterp.
 *
 * Results:
 *      Nonzero if the interpreter is deleted, zero otherwise.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_InterpDeleted(
    Tcl_Interp *interp)
{
    return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteInterp --
 *
 *      Ensures that the interpreter will be deleted eventually. If there are
 *      no Tcl_Preserve calls in effect for this interpreter, it is deleted
 *      immediately, otherwise the interpreter is deleted when the last
 *      Tcl_Preserve is matched by a call to Tcl_Release. In either case, the
 *      function runs the currently registered deletion callbacks.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The interpreter is marked as deleted. The caller may still use it
 *      safely if there are calls to Tcl_Preserve in effect for the
 *      interpreter, but further calls to Tcl_Eval etc in this interpreter
 *      will fail.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteInterp(
    Tcl_Interp *interp)         /* Token for command interpreter (returned by
                                 * a previous call to Tcl_CreateInterp). */
{
    Interp *iPtr = (Interp *) interp;

    /*
     * If the interpreter has already been marked deleted, just punt.
     */

    if (iPtr->flags & DELETED) {
        return;
    }

    /*
     * Mark the interpreter as deleted. No further evals will be allowed.
     * Increase the compileEpoch as a signal to compiled bytecodes.
     */

    iPtr->flags |= DELETED;
    iPtr->compileEpoch++;

    /*
     * Ensure that the interpreter is eventually deleted.
     */

    Tcl_EventuallyFree(interp, (Tcl_FreeProc *) DeleteInterpProc);
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteInterpProc --
 *
 *      Helper function to delete an interpreter. This function is called when
 *      the last call to Tcl_Preserve on this interpreter is matched by a call
 *      to Tcl_Release. The function cleans up all resources used in the
 *      interpreter and calls all currently registered interpreter deletion
 *      callbacks.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Whatever the interpreter deletion callbacks do. Frees resources used
 *      by the interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteInterpProc(
    Tcl_Interp *interp)         /* Interpreter to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *hTablePtr;
    ResolverScheme *resPtr, *nextResPtr;

    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
     */

    if (iPtr->numLevels > 0) {
        Tcl_Panic("DeleteInterpProc called with active evals");
    }

    /*
     * The interpreter should already be marked deleted; otherwise how did we
     * get here?
     */

    if (!(iPtr->flags & DELETED)) {
        Tcl_Panic("DeleteInterpProc called on interpreter not marked deleted");
    }

    /*
     * TIP #219, Tcl Channel Reflection API. Discard a leftover state.
     */

    if (iPtr->chanMsg != NULL) {
        Tcl_DecrRefCount(iPtr->chanMsg);
        iPtr->chanMsg = NULL;
    }

    /*
     * Shut down all limit handler callback scripts that call back into this
     * interpreter. Then eliminate all limit handlers for this interpreter.
     */

    TclRemoveScriptLimitCallbacks(interp);
    TclLimitRemoveAllHandlers(interp);

    /*
     * Dismantle the namespace here, before we clear the assocData. If any
     * background errors occur here, they will be deleted below.
     *
     * Dismantle the namespace after freeing the iPtr->handle so that each
     * bytecode releases its literals without caring to update the literal
     * table, as it will be freed later in this function without further use.
     */

    TclCleanupLiteralTable(interp, &(iPtr->literalTable));
    TclHandleFree(iPtr->handle);
    TclTeardownNamespace(iPtr->globalNsPtr);

    /*
     * Delete all the hidden commands.
     */

    hTablePtr = iPtr->hiddenCmdTablePtr;
    if (hTablePtr != NULL) {
        /*
         * Non-pernicious deletion. The deletion callbacks will not be allowed
         * to create any new hidden or non-hidden commands.
         * Tcl_DeleteCommandFromToken() will remove the entry from the
         * hiddenCmdTablePtr.
         */

        hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
        for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
            Tcl_DeleteCommandFromToken(interp,
                    (Tcl_Command) Tcl_GetHashValue(hPtr));
        }
        Tcl_DeleteHashTable(hTablePtr);
        ckfree((char *) hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
        AssocData *dPtr;

        hTablePtr = iPtr->assocData;
        iPtr->assocData = NULL;
        for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
                hPtr != NULL;
                hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
            dPtr = Tcl_GetHashValue(hPtr);
            Tcl_DeleteHashEntry(hPtr);
            if (dPtr->proc != NULL) {
                dPtr->proc(dPtr->clientData, interp);
            }
            ckfree((char *) dPtr);
        }
        Tcl_DeleteHashTable(hTablePtr);
        ckfree((char *) hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if (iPtr->framePtr != iPtr->rootFramePtr) {
        Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    ckfree((char *) iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;
    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
    interp->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
        Tcl_DecrRefCount(iPtr->errorCode);
        iPtr->errorCode = NULL;
    }
    Tcl_DecrRefCount(iPtr->eiVar);
    if (iPtr->errorInfo) {
        Tcl_DecrRefCount(iPtr->errorInfo);
        iPtr->errorInfo = NULL;
    }
    if (iPtr->returnOpts) {
        Tcl_DecrRefCount(iPtr->returnOpts);
    }
    if (iPtr->appendResult != NULL) {
        ckfree(iPtr->appendResult);
        iPtr->appendResult = NULL;
    }
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
        Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
        TclDeleteExecEnv(iPtr->execEnvPtr);
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
        nextResPtr = resPtr->nextPtr;
        ckfree(resPtr->name);
        ckfree((char *) resPtr);
        resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */

    TclDeleteLiteralTable(interp, &(iPtr->literalTable));

    /*
     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
     * contents.
     */

    {
        Tcl_HashEntry *hPtr;
        Tcl_HashSearch hSearch;
        int i;

        for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
                hPtr != NULL;
                hPtr = Tcl_NextHashEntry(&hSearch)) {
            CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);

            if (cfPtr->type == TCL_LOCATION_SOURCE) {
                Tcl_DecrRefCount(cfPtr->data.eval.path);
            }
            ckfree((char *) cfPtr->line);
            ckfree((char *) cfPtr);
            Tcl_DeleteHashEntry(hPtr);
        }
        Tcl_DeleteHashTable(iPtr->linePBodyPtr);
        ckfree((char *) iPtr->linePBodyPtr);
        iPtr->linePBodyPtr = NULL;

        /*
         * See also tclCompile.c, TclCleanupByteCode
         */

        for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
                hPtr != NULL;
                hPtr = Tcl_NextHashEntry(&hSearch)) {
            ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr);

            if (eclPtr->type == TCL_LOCATION_SOURCE) {
                Tcl_DecrRefCount(eclPtr->path);
            }
            for (i=0; i< eclPtr->nuloc; i++) {
                ckfree((char *) eclPtr->loc[i].line);
            }

            if (eclPtr->loc != NULL) {
                ckfree((char *) eclPtr->loc);
            }

            ckfree((char *) eclPtr);
            Tcl_DeleteHashEntry(hPtr);
        }
        Tcl_DeleteHashTable(iPtr->lineBCPtr);
        ckfree((char *) iPtr->lineBCPtr);
        iPtr->lineBCPtr = NULL;
    }

    Tcl_DeleteHashTable(&iPtr->varTraces);
    Tcl_DeleteHashTable(&iPtr->varSearches);

    ckfree((char *) iPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *
 *      Makes a command hidden so that it cannot be invoked from within an
 *      interpreter, only from within an ancestor.
 *
 * Results:
 *      A standard Tcl result; also leaves a message in the interp's result if
 *      an error occurs.
 *
 * Side effects:
 *      Removes a command from the command table and create an entry into the
 *      hidden command table under the specified token name.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_HideCommand(
    Tcl_Interp *interp,         /* Interpreter in which to hide command. */
    const char *cmdName,        /* Name of command to hide. */
    const char *hiddenCmdToken) /* Token name of the to-be-hidden command. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Command cmd;
    Command *cmdPtr;
    Tcl_HashTable *hiddenCmdTablePtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->flags & DELETED) {
        /*
         * The interpreter is being deleted. Do not create any new structures,
         * because it is not safe to modify the interpreter.
         */

        return TCL_ERROR;
    }

    /*
     * Disallow hiding of commands that are currently in a namespace or
     * renaming (as part of hiding) into a namespace (because the current
     * implementation with a single global table and the needed uniqueness of
     * names cause problems with namespaces).
     *
     * We don't need to check for "::" in cmdName because the real check is on
     * the nsPtr below.
     *
     * hiddenCmdToken is just a string which is not interpreted in any way. It
     * may contain :: but the string is not interpreted as a namespace
     * qualifier command name. Thus, hiding foo::bar to foo::bar and then
     * trying to expose or invoke ::foo::bar will NOT work; but if the
     * application always uses the same strings it will get consistent
     * behaviour.
     *
     * But as we currently limit ourselves to the global namespace only for
     * the source, in order to avoid potential confusion, lets prevent "::" in
     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
        Tcl_AppendResult(interp,
                "cannot use namespace qualifiers in hidden command"
                " token (rename)", NULL);
        return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of
     * the command must be given if using namespaces.
     */

    cmd = Tcl_FindCommand(interp, cmdName, NULL,
            /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
    if (cmd == (Tcl_Command) NULL) {
        return TCL_ERROR;
    }
    cmdPtr = (Command *) cmd;

    /*
     * Check that the command is really in global namespace
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
        Tcl_AppendResult(interp, "can only hide global namespace commands"
                " (use rename then hide)", NULL);
        return TCL_ERROR;
    }

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
        hiddenCmdTablePtr = (Tcl_HashTable *)
                ckalloc((unsigned) sizeof(Tcl_HashTable));
        Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
        iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
        Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
                "\" already exists", NULL);
        return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a specialy set apart name
     * table. Changes here and in TclRenameCommand must be kept in synch until
     * the common parts are actually factorized out.
     */

    /*
     * Remove the hash entry for the command from the interpreter command
     * table. This is like deleting the command, so bump its command epoch;
     * this invalidates any cached references that point to the command.
     */

    if (cmdPtr->hPtr != NULL) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = NULL;
        cmdPtr->cmdEpoch++;
    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);

    /*
     * Now link the hash table entry with the command structure. We ensured
     * above that the nsPtr was right.
     */

    cmdPtr->hPtr = hPtr;
    Tcl_SetHashValue(hPtr, cmdPtr);

    /*
     * If the command being hidden has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-hidden command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
     * compilation epoch doesn't match is recompiled.
     */

    if (cmdPtr->compileProc != NULL) {
        iPtr->compileEpoch++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExposeCommand --
 *
 *      Makes a previously hidden command callable from inside the interpreter
 *      instead of only by its ancestors.
 *
 * Results:
 *      A standard Tcl result. If an error occurs, a message is left in the
 *      interp's result.
 *
 * Side effects:
 *      Moves commands from one hash table to another.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ExposeCommand(
    Tcl_Interp *interp,         /* Interpreter in which to make command
                                 * callable. */
    const char *hiddenCmdToken, /* Name of hidden command. */
    const char *cmdName)        /* Name of to-be-exposed command. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr;
    Namespace *nsPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *hiddenCmdTablePtr;
    int isNew;

    if (iPtr->flags & DELETED) {
        /*
         * The interpreter is being deleted. Do not create any new structures,
         * because it is not safe to modify the interpreter.
         */

        return TCL_ERROR;
    }

    /*
     * Check that we have a regular name for the command (that the user is not
     * trying to do an expose and a rename (to another namespace) at the same
     * time).
     */

    if (strstr(cmdName, "::") != NULL) {
        Tcl_AppendResult(interp, "cannot expose to a namespace "
                "(use expose to toplevel, then rename)", NULL);
        return TCL_ERROR;
    }

    /*
     * Get the command from the hidden command table:
     */

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
        hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
                "\"", NULL);
        return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand() but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
        /*
         * This case is theoritically impossible, we might rather Tcl_Panic()
         * than 'nicely' erroring out ?
         */

        Tcl_AppendResult(interp,
                "trying to expose a non global command name space command",
                NULL);
        return TCL_ERROR;
    }

    /*
     * This is the global table.
     */

    nsPtr = cmdPtr->nsPtr;

    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
        Tcl_AppendResult(interp, "exposed command \"", cmdName,
                "\" already exists", NULL);
        return TCL_ERROR;
    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(nsPtr);

    /*
     * Remove the hash entry for the command from the interpreter hidden
     * command table.
     */

    if (cmdPtr->hPtr != NULL) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = NULL;
    }

    /*
     * Now link the hash table entry with the command structure. This is like
     * creating a new command, so deal with any shadowing of commands in the
     * global namespace.
     */

    cmdPtr->hPtr = hPtr;

    Tcl_SetHashValue(hPtr, cmdPtr);

    /*
     * Not needed as we are only in the global namespace (but would be needed
     * again if we supported namespace command hiding)
     *
     * TclResetShadowedCmdRefs(interp, cmdPtr);
     */

    /*
     * If the command being exposed has a compile function, increment
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled assuming the
     * command is hidden. This field is checked in Tcl_EvalObj and
     * ObjInterpProc, and code whose compilation epoch doesn't match is
     * recompiled.
     */

    if (cmdPtr->compileProc != NULL) {
        iPtr->compileEpoch++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateCommand --
 *
 *      Define a new command in a command table.
 *
 * Results:
 *      The return value is a token for the command, which can be used in
 *      future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *      If a command named cmdName already exists for interp, it is deleted.
 *      In the future, when cmdName is seen as the name of a command by
 *      Tcl_Eval, proc will be called. To support the bytecode interpreter,
 *      the command is created with a wrapper Tcl_ObjCmdProc
 *      (TclInvokeStringCommand) that eventially calls proc. When the command
 *      is deleted from the table, deleteProc will be called. See the manual
 *      entry for details on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateCommand(
    Tcl_Interp *interp,         /* Token for command interpreter returned by a
                                 * previous call to Tcl_CreateInterp. */
    const char *cmdName,        /* Name of command. If it contains namespace
                                 * qualifiers, the new command is put in the
                                 * specified namespace; otherwise it is put in
                                 * the global namespace. */
    Tcl_CmdProc *proc,          /* Function to associate with cmdName. */
    ClientData clientData,      /* Arbitrary value passed to string proc. */
    Tcl_CmdDeleteProc *deleteProc)
                                /* If not NULL, gives a function to call when
                                 * this command is deleted. */
{
    Interp *iPtr = (Interp *) interp;
    ImportRef *oldRefPtr = NULL;
    Namespace *nsPtr, *dummy1, *dummy2;
    Command *cmdPtr, *refCmdPtr;
    Tcl_HashEntry *hPtr;
    const char *tail;
    int isNew;
    ImportedCmdData *dataPtr;

    if (iPtr->flags & DELETED) {
        /*
         * The interpreter is being deleted. Don't create any new commands;
         * it's not safe to muck with the interpreter anymore.
         */

        return (Tcl_Command) NULL;
    }

    /*
     * Determine where the command should reside. If its name contains
     * namespace qualifiers, we put it in the specified namespace; otherwise,
     * we always put it in the global namespace.
     */

    if (strstr(cmdName, "::") != NULL) {
        TclGetNamespaceForQualName(interp, cmdName, NULL,
                TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
        if ((nsPtr == NULL) || (tail == NULL)) {
            return (Tcl_Command) NULL;
        }
    } else {
        nsPtr = iPtr->globalNsPtr;
        tail = cmdName;
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    if (!isNew) {
        /*
         * Command already exists. Delete the old one. Be careful to preserve
         * any existing import links so we can restore them down below. That
         * way, you can redefine a command and its import status will remain
         * intact.
         */

        cmdPtr = Tcl_GetHashValue(hPtr);
        oldRefPtr = cmdPtr->importRefPtr;
        cmdPtr->importRefPtr = NULL;

        Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
        if (!isNew) {
            /*
             * If the deletion callback recreated the command, just throw away
             * the new command (if we try to delete it again, we could get
             * stuck in an infinite loop).
             */

             ckfree((char *) Tcl_GetHashValue(hPtr));
        }
    } else {
        /*
         * The list of command exported from the namespace might have changed.
         * However, we do not need to recompute this just yet; next time we
         * need the info will be soon enough.
         */

        TclInvalidateNsCmdLookup(nsPtr);
        TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *) ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
    cmdPtr->objClientData = cmdPtr;
    cmdPtr->proc = proc;
    cmdPtr->clientData = clientData;
    cmdPtr->deleteProc = deleteProc;
    cmdPtr->deleteData = clientData;
    cmdPtr->flags = 0;
    cmdPtr->importRefPtr = NULL;
    cmdPtr->tracePtr = NULL;

    /*
     * Plug in any existing import references found above. Be sure to update
     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
        cmdPtr->importRefPtr = oldRefPtr;
        while (oldRefPtr != NULL) {
            refCmdPtr = oldRefPtr->importedCmdPtr;
            dataPtr = refCmdPtr->objClientData;
            dataPtr->realCmdPtr = cmdPtr;
            oldRefPtr = oldRefPtr->nextPtr;
        }
    }

    /*
     * We just created a command, so in its namespace and all of its parent
     * namespaces, it may shadow global commands with the same name. If any
     * shadowed commands are found, invalidate all cached command references
     * in the affected namespaces.
     */

    TclResetShadowedCmdRefs(interp, cmdPtr);
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateObjCommand --
 *
 *      Define a new object-based command in a command table.
 *
 * Results:
 *      The return value is a token for the command, which can be used in
 *      future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *      If no command named "cmdName" already exists for interp, one is
 *      created. Otherwise, if a command does exist, then if the object-based
 *      Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
 *      was called previously for the same command and just set its
 *      Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
 *      command.
 *
 *      In the future, during bytecode evaluation when "cmdName" is seen as
 *      the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *      Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *      the table, deleteProc will be called. See the manual entry for details
 *      on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateObjCommand(
    Tcl_Interp *interp,         /* Token for command interpreter (returned by
                                 * previous call to Tcl_CreateInterp). */
    const char *cmdName,        /* Name of command. If it contains namespace
                                 * qualifiers, the new command is put in the
                                 * specified namespace; otherwise it is put in
                                 * the global namespace. */
    Tcl_ObjCmdProc *proc,       /* Object-based function to associate with
                                 * name. */
    ClientData clientData,      /* Arbitrary value to pass to object
                                 * function. */
    Tcl_CmdDeleteProc *deleteProc)
                                /* If not NULL, gives a function to call when
                                 * this command is deleted. */
{
    Interp *iPtr = (Interp *) interp;
    ImportRef *oldRefPtr = NULL;
    Namespace *nsPtr, *dummy1, *dummy2;
    Command *cmdPtr, *refCmdPtr;
    Tcl_HashEntry *hPtr;
    const char *tail;
    int isNew;
    ImportedCmdData *dataPtr;

    if (iPtr->flags & DELETED) {
        /*
         * The interpreter is being deleted. Don't create any new commands;
         * it's not safe to muck with the interpreter anymore.
         */

        return (Tcl_Command) NULL;
    }

    /*
     * Determine where the command should reside. If its name contains
     * namespace qualifiers, we put it in the specified namespace; otherwise,
     * we always put it in the global namespace.
     */

    if (strstr(cmdName, "::") != NULL) {
        TclGetNamespaceForQualName(interp, cmdName, NULL,
                TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
        if ((nsPtr == NULL) || (tail == NULL)) {
            return (Tcl_Command) NULL;
        }
    } else {
        nsPtr = iPtr->globalNsPtr;
        tail = cmdName;
    }

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
    TclInvalidateNsPath(nsPtr);
    if (!isNew) {
        cmdPtr = Tcl_GetHashValue(hPtr);

        /*
         * Command already exists. If its object-based Tcl_ObjCmdProc is
         * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the
         * argument "proc". Otherwise, we delete the old command.
         */

        if (cmdPtr->objProc == TclInvokeStringCommand) {
            cmdPtr->objProc = proc;
            cmdPtr->objClientData = clientData;
            cmdPtr->deleteProc = deleteProc;
            cmdPtr->deleteData = clientData;
            return (Tcl_Command) cmdPtr;
        }

        /*
         * Otherwise, we delete the old command. Be careful to preserve any
         * existing import links so we can restore them down below. That way,
         * you can redefine a command and its import status will remain
         * intact.
         */

        oldRefPtr = cmdPtr->importRefPtr;
        cmdPtr->importRefPtr = NULL;

        Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
        if (!isNew) {
            /*
             * If the deletion callback recreated the command, just throw away
             * the new command (if we try to delete it again, we could get
             * stuck in an infinite loop).
             */

             ckfree(Tcl_GetHashValue(hPtr));
        }
    } else {
        /*
         * The list of command exported from the namespace might have changed.
         * However, we do not need to recompute this just yet; next time we
         * need the info will be soon enough.
         */

        TclInvalidateNsCmdLookup(nsPtr);
    }
    cmdPtr = (Command *) ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
    cmdPtr->deleteProc = deleteProc;
    cmdPtr->deleteData = clientData;
    cmdPtr->flags = 0;
    cmdPtr->importRefPtr = NULL;
    cmdPtr->tracePtr = NULL;

    /*
     * Plug in any existing import references found above. Be sure to update
     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
        cmdPtr->importRefPtr = oldRefPtr;
        while (oldRefPtr != NULL) {
            refCmdPtr = oldRefPtr->importedCmdPtr;
            dataPtr = refCmdPtr->objClientData;
            dataPtr->realCmdPtr = cmdPtr;
            oldRefPtr = oldRefPtr->nextPtr;
        }
    }

    /*
     * We just created a command, so in its namespace and all of its parent
     * namespaces, it may shadow global commands with the same name. If any
     * shadowed commands are found, invalidate all cached command references
     * in the affected namespaces.
     */

    TclResetShadowedCmdRefs(interp, cmdPtr);
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeStringCommand --
 *
 *      "Wrapper" Tcl_ObjCmdProc used to call an existing string-based
 *      Tcl_CmdProc if no object-based function exists for a command. A
 *      pointer to this function is stored as the Tcl_ObjCmdProc in a Command
 *      structure. It simply turns around and calls the string Tcl_CmdProc in
 *      the Command structure.
 *
 * Results:
 *      A standard Tcl object result value.
 *
 * Side effects:
 *      Besides those side effects of the called Tcl_CmdProc,
 *      TclInvokeStringCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */

int
TclInvokeStringCommand(
    ClientData clientData,      /* Points to command's Command structure. */
    Tcl_Interp *interp,         /* Current interpreter. */
    register int objc,          /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    Command *cmdPtr = clientData;
    int i, result;
    const char **argv = (const char **)
            TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));

    for (i = 0;  i < objc;  i++) {
        argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command's string-based Tcl_CmdProc.
     */

    result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);

    TclStackFree(interp, (void *) argv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeObjectCommand --
 *
 *      "Wrapper" Tcl_CmdProc used to call an existing object-based
 *      Tcl_ObjCmdProc if no string-based function exists for a command. A
 *      pointer to this function is stored as the Tcl_CmdProc in a Command
 *      structure. It simply turns around and calls the object Tcl_ObjCmdProc
 *      in the Command structure.
 *
 * Results:
 *      A standard Tcl string result value.
 *
 * Side effects:
 *      Besides those side effects of the called Tcl_CmdProc,
 *      TclInvokeStringCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */

int
TclInvokeObjectCommand(
    ClientData clientData,      /* Points to command's Command structure. */
    Tcl_Interp *interp,         /* Current interpreter. */
    int argc,                   /* Number of arguments. */
    register const char **argv) /* Argument strings. */
{
    Command *cmdPtr = (Command *) clientData;
    Tcl_Obj *objPtr;
    int i, length, result;
    Tcl_Obj **objv = (Tcl_Obj **)
            TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));

    for (i = 0;  i < argc;  i++) {
        length = strlen(argv[i]);
        TclNewStringObj(objPtr, argv[i], length);
        Tcl_IncrRefCount(objPtr);
        objv[i] = objPtr;
    }

    /*
     * Invoke the command's object-based Tcl_ObjCmdProc.
     */

    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);

    /*
     * Move the interpreter's object result to the string result, then reset
     * the object result.
     */

    (void) Tcl_GetStringResult(interp);

    /*
     * Decrement the ref counts for the argument objects created above, then
     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0;  i < argc;  i++) {
        objPtr = objv[i];
        Tcl_DecrRefCount(objPtr);
    }
    TclStackFree(interp, objv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclRenameCommand --
 *
 *      Called to give an existing Tcl command a different name. Both the old
 *      command name and the new command name can have "::" namespace
 *      qualifiers. If the new command has a different namespace context, the
 *      command will be moved to that namespace and will execute in the
 *      context of that new namespace.
 *
 *      If the new command name is NULL or the null string, the command is
 *      deleted.
 *
 * Results:
 *      Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *      If anything goes wrong, an error message is returned in the
 *      interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

int
TclRenameCommand(
    Tcl_Interp *interp,         /* Current interpreter. */
    const char *oldName,        /* Existing command name. */
    const char *newName)        /* New command name. */
{
    Interp *iPtr = (Interp *) interp;
    const char *newTail;
    Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
    Tcl_Command cmd;
    Command *cmdPtr;
    Tcl_HashEntry *hPtr, *oldHPtr;
    int isNew, result;
    Tcl_Obj *oldFullName;
    Tcl_DString newFullName;

    /*
     * Find the existing command. An error is returned if cmdName can't be
     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
        Tcl_AppendResult(interp, "can't ",
                ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
                " \"", oldName, "\": command doesn't exist", NULL);
        return TCL_ERROR;
    }
    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.
     */

    if ((newName == NULL) || (*newName == '\0')) {
        Tcl_DeleteCommandFromToken(interp, cmd);
        result = TCL_OK;
        goto done;
    }

    /*
     * Make sure that the destination command does not already exist. The
     * rename operation is like creating a command, so we should automatically
     * create the containing namespaces just like Tcl_CreateCommand would.
     */

    TclGetNamespaceForQualName(interp, newName, NULL,
            TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);

    if ((newNsPtr == NULL) || (newTail == NULL)) {
        Tcl_AppendResult(interp, "can't rename to \"", newName,
                "\": bad command name", NULL);
        result = TCL_ERROR;
        goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
        Tcl_AppendResult(interp, "can't rename to \"", newName,
                 "\": command already exists", NULL);
        result = TCL_ERROR;
        goto done;
    }

    /*
     * Warning: any changes done in the code here are likely to be needed in
     * Tcl_HideCommand() code too (until the common parts are extracted out).
     * - dl
     */

    /*
     * Put the command in the new namespace so we can check for an alias loop.
     * Since we are adding a new command to a namespace, we must handle any
     * shadowing of the global commands that this might create.
     */

    oldHPtr = cmdPtr->hPtr;
    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &isNew);
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = newNsPtr;
    TclResetShadowedCmdRefs(interp, cmdPtr);

    /*
     * Now check for an alias loop. If we detect one, put everything back the
     * way it was and report the error.
     */

    result = TclPreventAliasLoop(interp, interp, (Tcl_Command) cmdPtr);
    if (result != TCL_OK) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = oldHPtr;
        cmdPtr->nsPtr = cmdNsPtr;
        goto done;
    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough. These might refer to the same variable,
     * but that's no big deal.
     */

    TclInvalidateNsCmdLookup(cmdNsPtr);
    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);

    /*
     * Script for rename traces can delete the command "oldName". Therefore
     * increment the reference count for cmdPtr so that it's Command structure
     * is freed only towards the end of this function by calling
     * TclCleanupCommand.
     *
     * The trace function needs to get a fully qualified name for old and new
     * commands [Tcl bug #651271], or else there's no way for the trace
     * function to get the namespace from which the old command is being
     * renamed!
     */

    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
        Tcl_DStringAppend(&newFullName, "::", 2);
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
            Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

    /*
     * The new command name is okay, so remove the command from its current
     * namespace. This is like deleting the command, so bump the cmdEpoch to
     * invalidate any cached references to the command.
     */

    Tcl_DeleteHashEntry(oldHPtr);
    cmdPtr->cmdEpoch++;

    /*
     * If the command being renamed has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled for the
     * now-renamed command.
     */

    if (cmdPtr->compileProc != NULL) {
        iPtr->compileEpoch++;
    }

    /*
     * Now free the Command structure, if the "oldName" command has been
     * deleted by invocation of rename traces.
     */

    TclCleanupCommandMacro(cmdPtr);
    result = TCL_OK;

  done:
    TclDecrRefCount(oldFullName);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetCommandInfo --
 *
 *      Modifies various information about a Tcl command. Note that this
 *      function will not change a command's namespace; use TclRenameCommand
 *      to do that. Also, the isNativeObjectProc member of *infoPtr is
 *      ignored.
 *
 * Results:
 *      If cmdName exists in interp, then the information at *infoPtr is
 *      stored with the command in place of the current information and 1 is
 *      returned. If the command doesn't exist then 0 is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetCommandInfo(
    Tcl_Interp *interp,         /* Interpreter in which to look for
                                 * command. */
    const char *cmdName,        /* Name of desired command. */
    const Tcl_CmdInfo *infoPtr) /* Where to find information to store in the
                                 * command. */
{
    Tcl_Command cmd;

    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
    return Tcl_SetCommandInfoFromToken(cmd, infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetCommandInfoFromToken --
 *
 *      Modifies various information about a Tcl command. Note that this
 *      function will not change a command's namespace; use TclRenameCommand
 *      to do that. Also, the isNativeObjectProc member of *infoPtr is
 *      ignored.
 *
 * Results:
 *      If cmdName exists in interp, then the information at *infoPtr is
 *      stored with the command in place of the current information and 1 is
 *      returned. If the command doesn't exist then 0 is returned.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;            /* Internal representation of the command */

    if (cmd == (Tcl_Command) NULL) {
        return 0;
    }

    /*
     * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
     */

    cmdPtr = (Command *) cmd;
    cmdPtr->proc = infoPtr->proc;
    cmdPtr->clientData = infoPtr->clientData;
    if (infoPtr->objProc == NULL) {
        cmdPtr->objProc = TclInvokeStringCommand;
        cmdPtr->objClientData = cmdPtr;
    } else {
        cmdPtr->objProc = infoPtr->objProc;
        cmdPtr->objClientData = infoPtr->objClientData;
    }
    cmdPtr->deleteProc = infoPtr->deleteProc;
    cmdPtr->deleteData = infoPtr->deleteData;
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandInfo --
 *
 *      Returns various information about a Tcl command.
 *
 * Results:
 *      If cmdName exists in interp, then *infoPtr is modified to hold
 *      information about cmdName and 1 is returned. If the command doesn't
 *      exist then 0 is returned and *infoPtr isn't modified.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetCommandInfo(
    Tcl_Interp *interp,         /* Interpreter in which to look for
                                 * command. */
    const char *cmdName,        /* Name of desired command. */
    Tcl_CmdInfo *infoPtr)       /* Where to store information about
                                 * command. */
{
    Tcl_Command cmd;

    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
    return Tcl_GetCommandInfoFromToken(cmd, infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandInfoFromToken --
 *
 *      Returns various information about a Tcl command.
 *
 * Results:
 *      Copies information from the command identified by 'cmd' into a
 *      caller-supplied structure and returns 1. If the 'cmd' is NULL, leaves
 *      the structure untouched and returns 0.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetCommandInfoFromToken(
    Tcl_Command cmd,
    Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;            /* Internal representation of the command */

    if (cmd == (Tcl_Command) NULL) {
        return 0;
    }

    /*
     * Set isNativeObjectProc 1 if objProc was registered by a call to
     * Tcl_CreateObjCommand. Otherwise set it to 0.
     */

    cmdPtr = (Command *) cmd;
    infoPtr->isNativeObjectProc =
            (cmdPtr->objProc != TclInvokeStringCommand);
    infoPtr->objProc = cmdPtr->objProc;
    infoPtr->objClientData = cmdPtr->objClientData;
    infoPtr->proc = cmdPtr->proc;
    infoPtr->clientData = cmdPtr->clientData;
    infoPtr->deleteProc = cmdPtr->deleteProc;
    infoPtr->deleteData = cmdPtr->deleteData;
    infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;

    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandName --
 *
 *      Given a token returned by Tcl_CreateCommand, this function returns the
 *      current name of the command (which may have changed due to renaming).
 *
 * Results:
 *      The return value is the name of the given command.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetCommandName(
    Tcl_Interp *interp,         /* Interpreter containing the command. */
    Tcl_Command command)        /* Token for command returned by a previous
                                 * call to Tcl_CreateCommand. The command must
                                 * not have been deleted. */
{
    Command *cmdPtr = (Command *) command;

    if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
        /*
         * This should only happen if command was "created" after the
         * interpreter began to be deleted, so there isn't really any command.
         * Just return an empty string.
         */

        return "";
    }

    return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFullName --
 *
 *      Given a token returned by, e.g., Tcl_CreateCommand or Tcl_FindCommand,
 *      this function appends to an object the command's full name, qualified
 *      by a sequence of parent namespace names. The command's fully-qualified
 *      name may have changed due to renaming.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The command's fully-qualified name is appended to the string
 *      representation of objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_GetCommandFullName(
    Tcl_Interp *interp,         /* Interpreter containing the command. */
    Tcl_Command command,        /* Token for command returned by a previous
                                 * call to Tcl_CreateCommand. The command must
                                 * not have been deleted. */
    Tcl_Obj *objPtr)            /* Points to the object onto which the
                                 * command's full name is appended. */

{
    Interp *iPtr = (Interp *) interp;
    register Command *cmdPtr = (Command *) command;
    char *name;

    /*
     * Add the full name of the containing namespace, followed by the "::"
     * separator, and the command name.
     */

    if (cmdPtr != NULL) {
        if (cmdPtr->nsPtr != NULL) {
            Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
            if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
                Tcl_AppendToObj(objPtr, "::", 2);
            }
        }
        if (cmdPtr->hPtr != NULL) {
            name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
            Tcl_AppendToObj(objPtr, name, -1);
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteCommand --
 *
 *      Remove the given command from the given interpreter.
 *
 * Results:
 *      0 is returned if the command was deleted successfully. -1 is returned
 *      if there didn't exist a command by that name.
 *
 * Side effects:
 *      cmdName will no longer be recognized as a valid command for interp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DeleteCommand(
    Tcl_Interp *interp,         /* Token for command interpreter (returned by
                                 * a previous Tcl_CreateInterp call). */
    const char *cmdName)        /* Name of command to remove. */
{
    Tcl_Command cmd;

    /*
     * Find the desired command and delete it.
     */

    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
    if (cmd == (Tcl_Command) NULL) {
        return -1;
    }
    return Tcl_DeleteCommandFromToken(interp, cmd);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteCommandFromToken --
 *
 *      Removes the given command from the given interpreter. This function
 *      resembles Tcl_DeleteCommand, but takes a Tcl_Command token instead of
 *      a command name for efficiency.
 *
 * Results:
 *      0 is returned if the command was deleted successfully. -1 is returned
 *      if there didn't exist a command by that name.
 *
 * Side effects:
 *      The command specified by "cmd" will no longer be recognized as a valid
 *      command for "interp".
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DeleteCommandFromToken(
    Tcl_Interp *interp,         /* Token for command interpreter returned by a
                                 * previous call to Tcl_CreateInterp. */
    Tcl_Command cmd)            /* Token for command to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = (Command *) cmd;
    ImportRef *refPtr, *nextRefPtr;
    Tcl_Command importCmd;

    /*
     * Bump the command epoch counter. This will invalidate all cached
     * references that point to this command.
     */

    cmdPtr->cmdEpoch++;

    /*
     * The code here is tricky. We can't delete the hash table entry before
     * invoking the deletion callback because there are cases where the
     * deletion callback needs to invoke the command (e.g. object systems such
     * as OTcl). However, this means that the callback could try to delete or
     * rename the command. The deleted flag allows us to detect these cases
     * and skip nested deletes.
     */

    if (cmdPtr->flags & CMD_IS_DELETED) {
        /*
         * Another deletion is already in progress. Remove the hash table
         * entry now, but don't invoke a callback or free the command
         * structure. Take care to only remove the hash entry if it has not
         * already been removed; otherwise if we manage to hit this function
         * three times, everything goes up in smoke. [Bug 1220058]
         */

        if (cmdPtr->hPtr != NULL) {
            Tcl_DeleteHashEntry(cmdPtr->hPtr);
            cmdPtr->hPtr = NULL;
        }
        return 0;
    }

    /*
     * We must delete this command, even though both traces and delete procs
     * may try to avoid this (renaming the command etc). Also traces and
     * delete procs may try to delete the command themsevles. This flag
     * declares that a delete is in progress and that recursive deletes should
     * be ignored.
     */

    cmdPtr->flags |= CMD_IS_DELETED;

    /*
     * Call trace functions for the command being deleted. Then delete its
     * traces.
     */

    if (cmdPtr->tracePtr != NULL) {
        CommandTrace *tracePtr;
        CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

        /*
         * Now delete these traces.
         */

        tracePtr = cmdPtr->tracePtr;
        while (tracePtr != NULL) {
            CommandTrace *nextPtr = tracePtr->nextPtr;
            if ((--tracePtr->refCount) <= 0) {
                ckfree((char *) tracePtr);
            }
            tracePtr = nextPtr;
        }
        cmdPtr->tracePtr = NULL;
    }

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);

    /*
     * If the command being deleted has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-deleted command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
     * compilation epoch doesn't match is recompiled.
     */

    if (cmdPtr->compileProc != NULL) {
        iPtr->compileEpoch++;
    }

    if (cmdPtr->deleteProc != NULL) {
        /*
         * Delete the command's client data. If this was an imported command
         * created when a command was imported into a namespace, this client
         * data will be a pointer to a ImportedCmdData structure describing
         * the "real" command that this imported command refers to.
         */

        /*
         * If you are getting a crash during the call to deleteProc and
         * cmdPtr->deleteProc is a pointer to the function free(), the most
         * likely cause is that your extension allocated memory for the
         * clientData argument to Tcl_CreateObjCommand() with the ckalloc()
         * macro and you are now trying to deallocate this memory with free()
         * instead of ckfree(). You should pass a pointer to your own method
         * that calls ckfree().
         */

        (*cmdPtr->deleteProc)(cmdPtr->deleteData);
    }

    /*
     * If this command was imported into other namespaces, then imported
     * commands were created that refer back to this command. Delete these
     * imported commands now.
     */

    for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
            refPtr = nextRefPtr) {
        nextRefPtr = refPtr->nextPtr;
        importCmd = (Tcl_Command) refPtr->importedCmdPtr;
        Tcl_DeleteCommandFromToken(interp, importCmd);
    }

    /*
     * Don't use hPtr to delete the hash entry here, because it's possible
     * that the deletion callback renamed the command. Instead, use
     * cmdPtr->hptr, and make sure that no-one else has already deleted the
     * hash entry.
     */

    if (cmdPtr->hPtr != NULL) {
        Tcl_DeleteHashEntry(cmdPtr->hPtr);
        cmdPtr->hPtr = NULL;
    }

    /*
     * Mark the Command structure as no longer valid. This allows
     * TclExecuteByteCode to recognize when a Command has logically been
     * deleted and a pointer to this Command structure cached in a CmdName
     * object is invalid. TclExecuteByteCode will look up the command again in
     * the interpreter's command hashtable.
     */

    cmdPtr->objProc = NULL;

    /*
     * Now free the Command structure, unless there is another reference to it
     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
     * delay the cleanup until all references are either discarded (when a
     * ByteCode is freed) or replaced by a new reference (when a cached
     * CmdName Command reference is found to be invalid and TclExecuteByteCode
     * looks up the command in the command hashtable).
     */

    TclCleanupCommandMacro(cmdPtr);
    return 0;
}

static char *
CallCommandTraces(
    Interp *iPtr,               /* Interpreter containing command. */
    Command *cmdPtr,            /* Command whose traces are to be invoked. */
    const char *oldName,        /* Command's old name, or NULL if we must get
                                 * the name from cmdPtr */
    const char *newName,        /* Command's new name, or NULL if the command
                                 * is not being renamed */
    int flags)                  /* Flags indicating the type of traces to
                                 * trigger, either TCL_TRACE_DELETE or
                                 * TCL_TRACE_RENAME. */
{
    register CommandTrace *tracePtr;
    ActiveCommandTrace active;
    char *result;
    Tcl_Obj *oldNamePtr = NULL;
    Tcl_InterpState state = NULL;

    if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
        /*
         * While a rename trace is active, we will not process any more rename
         * traces; while a delete trace is active we will never reach here -
         * because Tcl_DeleteCommandFromToken checks for the condition
         * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
         * command deletion is in progress. For all other traces, delete
         * traces will not be invoked but a call to TraceCommandProc will
         * ensure that tracePtr->clientData is freed whenever the command
         * "oldName" is deleted.
         */

        if (cmdPtr->flags & TCL_TRACE_RENAME) {
            flags &= ~TCL_TRACE_RENAME;
        }
        if (flags == 0) {
            return NULL;
        }
    }
    cmdPtr->flags |= CMD_TRACE_ACTIVE;
    cmdPtr->refCount++;

    result = NULL;
    active.nextPtr = iPtr->activeCmdTracePtr;
    active.reverseScan = 0;
    iPtr->activeCmdTracePtr = &active;

    if (flags & TCL_TRACE_DELETE) {
        flags |= TCL_TRACE_DESTROYED;
    }
    active.cmdPtr = cmdPtr;

    Tcl_Preserve(iPtr);

    for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
            tracePtr = active.nextTracePtr) {
        active.nextTracePtr = tracePtr->nextPtr;
        if (!(tracePtr->flags & flags)) {
            continue;
        }
        cmdPtr->flags |= tracePtr->flags;
        if (oldName == NULL) {
            TclNewObj(oldNamePtr);
            Tcl_IncrRefCount(oldNamePtr);
            Tcl_GetCommandFullName((Tcl_Interp *) iPtr,
                    (Tcl_Command) cmdPtr, oldNamePtr);
            oldName = TclGetString(oldNamePtr);
        }
        tracePtr->refCount++;
        if (state == NULL) {
            state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
        }
        (*tracePtr->traceProc)(tracePtr->clientData,
                (Tcl_Interp *) iPtr, oldName, newName, flags);
        cmdPtr->flags &= ~tracePtr->flags;
        if ((--tracePtr->refCount) <= 0) {
            ckfree((char *) tracePtr);
        }
    }

    if (state) {
        Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }

    /*
     * If a new object was created to hold the full oldName, free it now.
     */

    if (oldNamePtr != NULL) {
        TclDecrRefCount(oldNamePtr);
    }

    /*
     * Restore the variable's flags, remove the record of our active traces,
     * and then return.
     */

    cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
    cmdPtr->refCount--;
    iPtr->activeCmdTracePtr = active.nextPtr;
    Tcl_Release(iPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetCommandSource --
 *
 *      This function returns a Tcl_Obj with the full source string for the
 *      command. This insures that traces get a correct NUL-terminated command
 *      string.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
GetCommandSource(
    Interp *iPtr,
    const char *command,
    int numChars,
    int objc,
    Tcl_Obj *const objv[])
{
    if (!command) {
        return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1) {
        command = TclGetSrcInfoForCmd(iPtr, &numChars);
    }
    return Tcl_NewStringObj(command, numChars);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupCommand --
 *
 *      This function frees up a Command structure unless it is still
 *      referenced from an interpreter's command hashtable or from a CmdName
 *      Tcl object representing the name of a command in a ByteCode
 *      instruction sequence.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Memory gets freed unless a reference to the Command structure still
 *      exists. In that case the cleanup is delayed until the command is
 *      deleted or when the last ByteCode referring to it is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupCommand(
    register Command *cmdPtr)   /* Points to the Command structure to
                                 * be freed. */
{
    cmdPtr->refCount--;
    if (cmdPtr->refCount <= 0) {
        ckfree((char *) cmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateMathFunc --
 *
 *      Creates a new math function for expressions in a given interpreter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The Tcl function defined by "name" is created or redefined. If the
 *      function already exists then its definition is replaced; this includes
 *      the builtin functions. Redefining a builtin function forces all
 *      existing code to be invalidated since that code may be compiled using
 *      an instruction specific to the replaced function. In addition,
 *      redefioning a non-builtin function will force existing code to be
 *      invalidated if the number of arguments has changed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateMathFunc(
    Tcl_Interp *interp,         /* Interpreter in which function is to be
                                 * available. */
    const char *name,           /* Name of function (e.g. "sin"). */
    int numArgs,                /* Nnumber of arguments required by
                                 * function. */
    Tcl_ValueType *argTypes,    /* Array of types acceptable for each
                                 * argument. */
    Tcl_MathProc *proc,         /* C function that implements the math
                                 * function. */
    ClientData clientData)      /* Additional value to pass to the
                                 * function. */
{
    Tcl_DString bigName;
    OldMathFuncData *data = (OldMathFuncData *)
            ckalloc(sizeof(OldMathFuncData));

    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = (Tcl_ValueType *)
            ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
    Tcl_DStringAppend(&bigName, name, -1);

    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
            OldMathFuncProc, data, OldMathFuncDeleteProc);
    Tcl_DStringFree(&bigName);
}

/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncProc --
 *
 *      Dispatch to a math function created with Tcl_CreateMathFunc
 *
 * Results:
 *      Returns a standard Tcl result.
 *
 * Side effects:
 *      Whatever the math function does.
 *
 *----------------------------------------------------------------------
 */

static int
OldMathFuncProc(
    ClientData clientData,      /* Ponter to OldMathFuncData describing the
                                 * function being called */
    Tcl_Interp *interp,         /* Tcl interpreter */
    int objc,                   /* Actual parameter count */
    Tcl_Obj *const *objv)       /* Parameter vector */
{
    Tcl_Obj *valuePtr;
    OldMathFuncData *dataPtr = clientData;
    Tcl_Value funcResult, *args;
    int result;
    int j, k;
    double d;

    /*
     * Check argument count.
     */

    if (objc != dataPtr->numArgs + 1) {
        MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
        return TCL_ERROR;
    }

    /*
     * Convert arguments from Tcl_Obj's to Tcl_Value's.
     */

    args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
    for (j = 1, k = 0; j < objc; ++j, ++k) {

        /* TODO: Convert to TclGetNumberFromObj() ? */
        valuePtr = objv[j];
        result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
        if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
            d = valuePtr->internalRep.doubleValue;
            result = TCL_OK;
        }
#endif
        if (result != TCL_OK) {
            /*
             * We have a non-numeric argument.
             */

            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "argument to math function didn't have numeric value",-1));
            TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
            ckfree((char *)args);
            return TCL_ERROR;
        }

        /*
         * Copy the object's numeric value to the argument record, converting
         * it if necessary.
         *
         * NOTE: no bignum support; use the new mathfunc interface for that.
         */

        args[k].type = dataPtr->argTypes[k];
        switch (args[k].type) {
        case TCL_EITHER:
            if (Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue))
                    == TCL_OK) {
                args[k].type = TCL_INT;
                break;
            }
            if (Tcl_GetWideIntFromObj(interp, valuePtr, &(args[k].wideValue))
                    == TCL_OK) {
                args[k].type = TCL_WIDE_INT;
                break;
            }
            args[k].type = TCL_DOUBLE;
            /* FALLTHROUGH */

        case TCL_DOUBLE:
            args[k].doubleValue = d;
            break;
        case TCL_INT:
            if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
                ckfree((char *)args);
                return TCL_ERROR;
            }
            valuePtr = Tcl_GetObjResult(interp);
            Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue));
            Tcl_ResetResult(interp);
            break;
        case TCL_WIDE_INT:
            if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
                ckfree((char *)args);
                return TCL_ERROR;
            }
            valuePtr = Tcl_GetObjResult(interp);
            Tcl_GetWideIntFromObj(NULL, valuePtr, &(args[k].wideValue));
            Tcl_ResetResult(interp);
            break;
        }
    }

    /*
     * Call the function.
     */

    errno = 0;
    result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
    ckfree((char *)args);
    if (result != TCL_OK) {
        return result;
    }

    /*
     * Return the result of the call.
     */

    if (funcResult.type == TCL_INT) {
        TclNewLongObj(valuePtr, funcResult.intValue);
    } else if (funcResult.type == TCL_WIDE_INT) {
        valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
    } else {
        return CheckDoubleResult(interp, funcResult.doubleValue);
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncDeleteProc --
 *
 *      Cleans up after deleting a math function registered with
 *      Tcl_CreateMathFunc
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Frees allocated memory.
 *
 *----------------------------------------------------------------------
 */

static void
OldMathFuncDeleteProc(
     ClientData clientData)
{
    OldMathFuncData *dataPtr = clientData;

    ckfree((void *) dataPtr->argTypes);
    ckfree((void *) dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMathFuncInfo --
 *
 *      Discovers how a particular math function was created in a given
 *      interpreter.
 *
 * Results:
 *      TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
 *      interpreter result if that happens.)
 *
 * Side effects:
 *      If this function succeeds, the variables pointed to by the numArgsPtr
 *      and argTypePtr arguments will be updated to detail the arguments
 *      allowed by the function. The variable pointed to by the procPtr
 *      argument will be set to NULL if the function is a builtin function,
 *      and will be set to the address of the C function used to implement the
 *      math function otherwise (in which case the variable pointed to by the
 *      clientDataPtr argument will also be updated.)
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetMathFuncInfo(
    Tcl_Interp *interp,
    const char *name,
    int *numArgsPtr,
    Tcl_ValueType **argTypesPtr,
    Tcl_MathProc **procPtr,
    ClientData *clientDataPtr)
{
    Tcl_Obj *cmdNameObj;
    Command *cmdPtr;

    /*
     * Get the command that implements the math function.
     */

    TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
    Tcl_AppendToObj(cmdNameObj, name, -1);
    Tcl_IncrRefCount(cmdNameObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
    Tcl_DecrRefCount(cmdNameObj);

    /*
     * Report unknown functions.
     */

    if (cmdPtr == NULL) {
        Tcl_Obj *message;

        TclNewLiteralStringObj(message, "unknown math function \"");
        Tcl_AppendToObj(message, name, -1);
        Tcl_AppendToObj(message, "\"", 1);
        Tcl_SetObjResult(interp, message);
        *numArgsPtr = -1;
        *argTypesPtr = NULL;
        *procPtr = NULL;
        *clientDataPtr = NULL;
        return TCL_ERROR;
    }

    /*
     * Retrieve function info for user defined functions; return dummy
     * information for builtins.
     */

    if (cmdPtr->objProc == &OldMathFuncProc) {
        OldMathFuncData *dataPtr = cmdPtr->clientData;

        *procPtr = dataPtr->proc;
        *numArgsPtr = dataPtr->numArgs;
        *argTypesPtr = dataPtr->argTypes;
        *clientDataPtr = dataPtr->clientData;
    } else {
        *procPtr = NULL;
        *numArgsPtr = -1;
        *argTypesPtr = NULL;
        *procPtr = NULL;
        *clientDataPtr = NULL;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListMathFuncs --
 *
 *      Produces a list of all the math functions defined in a given
 *      interpreter.
 *
 * Results:
 *      A pointer to a Tcl_Obj structure with a reference count of zero, or
 *      NULL in the case of an error (in which case a suitable error message
 *      will be left in the interpreter result.)
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ListMathFuncs(
    Tcl_Interp *interp,
    const char *pattern)
{
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *nsPtr;
    Namespace *dummy1NsPtr;
    Namespace *dummy2NsPtr;
    const char *dummyNamePtr;
    Tcl_Obj *result = Tcl_NewObj();

    TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
            globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
            &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
    if (nsPtr == NULL) {
        return result;
    }

    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
        if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
            Tcl_ListObjAppendElement(NULL, result,
                    Tcl_NewStringObj(pattern, -1));
        }
    } else {
        Tcl_HashSearch cmdHashSearch;
        Tcl_HashEntry *cmdHashEntry =
                Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);

        for (; cmdHashEntry != NULL;
                cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
            const char *cmdNamePtr =
                    Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);

            if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
                Tcl_ListObjAppendElement(NULL, result,
                        Tcl_NewStringObj(cmdNamePtr, -1));
            }
        }
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --
 *
 *      Check if an interpreter is ready to eval commands or scripts, i.e., if
 *      it was not deleted and if the nesting level is not too high.
 *
 * Results:
 *      The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
 *      otherwise.
 *
 * Side effects:
 *      The interpreters object and string results are cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
    int localInt; /* used for checking the stack */
    register Interp *iPtr = (Interp *) interp;

    /*
     * Reset both the interpreter's string and object results and clear out
     * any previous error information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */

    if (iPtr->flags & DELETED) {
        Tcl_ResetResult(interp);
        Tcl_AppendResult(interp,
                "attempt to call eval in deleted interpreter", NULL);
        Tcl_SetErrorCode(interp, "TCL", "IDELETE",
                "attempt to call eval in deleted interpreter", NULL);
        return TCL_ERROR;
    }

    /*
     * Check depth of nested calls to Tcl_Eval: if this gets too large, it's
     * probably because of an infinite loop somewhere.
     */

    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)
            && CheckCStack(iPtr, &localInt)) {
        return TCL_OK;
    }

    if (!CheckCStack(iPtr, &localInt)) {
        Tcl_AppendResult(interp,
                "out of stack space (infinite loop?)", NULL);
    } else {
        Tcl_AppendResult(interp,
                "too many nested evaluations (infinite loop?)", NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclEvalObjvInternal
 *
 *      This function evaluates a Tcl command that has already been parsed
 *      into words, with one Tcl_Obj holding each word. The caller is
 *      responsible for managing the iPtr->numLevels.
 *
 *      TclEvalObjvInternal is the backend for Tcl_EvalObjv, the bytecode
 *      engine also calls it directly.
 *
 * Results:
 *      The return value is a standard Tcl completion code such as TCL_OK or
 *      TCL_ERROR. A result or error message is left in interp's result. If an
 *      error occurs, this function does NOT add any information to the
 *      errorInfo variable.
 *
 * Side effects:
 *      Depends on the command.
 *
 *----------------------------------------------------------------------
 */

int
TclEvalObjvInternal(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate the
                                 * command. Also used for error reporting. */
    int objc,                   /* Number of words in command. */
    Tcl_Obj *const objv[],      /* An array of pointers to objects that are
                                 * the words that make up the command. */
    const char *command,        /* Points to the beginning of the string
                                 * representation of the command; this is used
                                 * for traces. NULL if the string
                                 * representation of the command is unknown is
                                 * to be generated from (objc,objv), -1 if it
                                 * is to be generated from bytecode
                                 * source. This is only needed the traces. */
    int length,                 /* Number of bytes in command; if -1, all
                                 * characters up to the first null byte are
                                 * used. */
    int flags)                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Only
                                 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
                                 * currently supported. */
{
    Command *cmdPtr;
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **newObjv;
    int i;
    CallFrame *savedVarFramePtr = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    int code = TCL_OK;
    int traceCode = TCL_OK;
    int checkTraces = 1, traced;
    Namespace *savedNsPtr = NULL;
    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
    Tcl_Obj *commandPtr = NULL;

    if (TclInterpReady(interp) == TCL_ERROR) {
        return TCL_ERROR;
    }

    if (objc == 0) {
        return TCL_OK;
    }

    /*
     * If any execution traces rename or delete the current command, we may
     * need (at most) two passes here.
     */

  reparseBecauseOfTraces:

    /*
     * Configure evaluation context to match the requested flags.
     */

    if (flags) {
        if (flags & TCL_EVAL_INVOKE) {
            savedNsPtr = varFramePtr->nsPtr;
            if (lookupNsPtr) {
                varFramePtr->nsPtr = lookupNsPtr;
                iPtr->lookupNsPtr = NULL;
            } else {
                varFramePtr->nsPtr = iPtr->globalNsPtr;
            }
        } else if ((flags & TCL_EVAL_GLOBAL)
                && (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
            varFramePtr = iPtr->rootFramePtr;
            savedVarFramePtr = iPtr->varFramePtr;
            iPtr->varFramePtr = varFramePtr;
        }
    }

    /*
     * Find the function to execute this command. If there isn't one, then see
     * if there is an unknown command handler registered for this namespace.
     * If so, create a new word array with the handler as the first words and
     * the original command words as arguments. Then call ourselves
     * recursively to execute it.
     */

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
    if (!cmdPtr) {
        goto notFound;
    }

    if (savedNsPtr) {
        varFramePtr->nsPtr = savedNsPtr;
    } else if (iPtr->ensembleRewrite.sourceObjs) {
        /*
         * TCL_EVAL_INVOKE was not set: clear rewrite rules
         */

        iPtr->ensembleRewrite.sourceObjs = NULL;
    }

    /*
     * Call trace functions if needed.
     */

    traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
    if (traced && checkTraces) {
        int cmdEpoch = cmdPtr->cmdEpoch;
        int newEpoch;

        /*
         * Insure that we have a correct nul-terminated command string for the
         * trace code.
         */

        commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
        command = TclGetStringFromObj(commandPtr, &length);

        /*
         * Execute any command or execution traces. Note that we bump up the
         * command's reference count for the duration of the calling of the
         * traces so that the structure doesn't go away underneath our feet.
         */

        cmdPtr->refCount++;
        if (iPtr->tracePtr && (traceCode == TCL_OK)) {
            traceCode = TclCheckInterpTraces(interp, command, length,
                    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
        }
        if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
            traceCode = TclCheckExecutionTraces(interp, command, length,
                    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
        }
        newEpoch = cmdPtr->cmdEpoch;
        TclCleanupCommandMacro(cmdPtr);

        /*
         * If the traces modified/deleted the command or any existing traces,
         * they will update the command's epoch. When that happens, set
         * checkTraces is set to 0 to prevent the re-calling of traces (and
         * any possible infinite loop) and we go back to re-find the command
         * implementation.
         */

        if (cmdEpoch != newEpoch) {
            checkTraces = 0;
            if (commandPtr) {
                Tcl_DecrRefCount(commandPtr);
            }
            goto reparseBecauseOfTraces;
        }
    }

    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
        char *a[10];
        int i = 0;

        while (i < 10) {
            a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
        }
        TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
                a[8], a[9]);
    }
    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
        Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
        char *a[4]; int i[2];

        TclDTraceInfo(info, a, i);
        TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
        TclDecrRefCount(info);
    }

    /*
     * Finally, invoke the command's Tcl_ObjCmdProc.
     */

    cmdPtr->refCount++;
    iPtr->cmdCount++;
    if (code == TCL_OK && traceCode == TCL_OK
            && !TclLimitExceeded(iPtr->limit)) {
        if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
            TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
                    (Tcl_Obj **)(objv + 1));
        }
        code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
        if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
            TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
        }
    }

    if (TclAsyncReady(iPtr)) {
        code = Tcl_AsyncInvoke(interp, code);
    }
    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
        code = Tcl_LimitCheck(interp);
    }

    /*
     * Call 'leave' command traces
     */

    if (traced) {
        if (!(cmdPtr->flags & CMD_IS_DELETED)) {
            if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
                traceCode = TclCheckExecutionTraces(interp, command, length,
                        cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
            }
            if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
                traceCode = TclCheckInterpTraces(interp, command, length,
                        cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
            }
        }

        /*
         * If one of the trace invocation resulted in error, then change the
         * result code accordingly. Note, that the interp->result should
         * already be set correctly by the call to TraceExecutionProc.
         */

        if (traceCode != TCL_OK) {
            code = traceCode;
        }
        if (commandPtr) {
            Tcl_DecrRefCount(commandPtr);
        }
    }

    /*
     * Decrement the reference count of cmdPtr and deallocate it if it has
     * dropped to zero.
     */

    TclCleanupCommandMacro(cmdPtr);

    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     */

    if (*(iPtr->result) != 0) {
        (void) Tcl_GetObjResult(interp);
    }

    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
        Tcl_Obj *r;

        r = Tcl_GetObjResult(interp);
        TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
    }

  done:
    if (savedVarFramePtr) {
        iPtr->varFramePtr = savedVarFramePtr;
    }
    return code;

  notFound:
    {
        Namespace *currNsPtr = NULL;    /* Used to check for and invoke any
                                         * registered unknown command handler
                                         * for the current namespace (TIP
                                         * 181). */
        int newObjc, handlerObjc;
        Tcl_Obj **handlerObjv;

        currNsPtr = varFramePtr->nsPtr;
        if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
            currNsPtr = iPtr->globalNsPtr;
            if (currNsPtr == NULL) {
                Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
            }
        }

        /*
         * Check to see if the resolution namespace has lost its unknown
         * handler. If so, reset it to "::unknown".
         */

        if (currNsPtr->unknownHandlerPtr == NULL) {
            TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
            Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
        }

        /*
         * Get the list of words for the unknown handler and allocate enough
         * space to hold both the handler prefix and all words of the command
         * invokation itself.
         */

        Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
                &handlerObjc, &handlerObjv);
        newObjc = objc + handlerObjc;
        newObjv = (Tcl_Obj **) TclStackAlloc(interp,
                (int) sizeof(Tcl_Obj *) * newObjc);

        /*
         * Copy command prefix from unknown handler and add on the real
         * command's full argument list. Note that we only use memcpy() once
         * because we have to increment the reference count of all the handler
         * arguments anyway.
         */

        for (i = 0; i < handlerObjc; ++i) {
            newObjv[i] = handlerObjv[i];
            Tcl_IncrRefCount(newObjv[i]);
        }
        memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);

        /*
         * Look up and invoke the handler (by recursive call to this
         * function). If there is no handler at all, instead of doing the
         * recursive call we just generate a generic error message; it would
         * be an infinite-recursion nightmare otherwise.
         */

        cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
        if (cmdPtr == NULL) {
            Tcl_AppendResult(interp, "invalid command name \"",
                    TclGetString(objv[0]), "\"", NULL);
            code = TCL_ERROR;
        } else {
            iPtr->numLevels++;
            code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
                    length, 0);
            iPtr->numLevels--;
        }

        /*
         * Release any resources we locked and allocated during the handler
         * call.
         */

        for (i = 0; i < handlerObjc; ++i) {
            Tcl_DecrRefCount(newObjv[i]);
        }
        TclStackFree(interp, newObjv);
        if (savedNsPtr) {
            varFramePtr->nsPtr = savedNsPtr;
        }
        goto done;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjv --
 *
 *      This function evaluates a Tcl command that has already been parsed
 *      into words, with one Tcl_Obj holding each word.
 *
 * Results:
 *      The return value is a standard Tcl completion code such as TCL_OK or
 *      TCL_ERROR. A result or error message is left in interp's result.
 *
 * Side effects:
 *      Depends on the command.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_EvalObjv(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate the
                                 * command. Also used for error reporting. */
    int objc,                   /* Number of words in command. */
    Tcl_Obj *const objv[],      /* An array of pointers to objects that are
                                 * the words that make up the command. */
    int flags)                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Only
                                 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
                                 * currently supported. */
{
    Interp *iPtr = (Interp *) interp;
    int code = TCL_OK;

    iPtr->numLevels++;
    code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
    iPtr->numLevels--;

    if (code == TCL_OK) {
        return code;
    } else {
        int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);

        /*
         * If we are again at the top level, process any unusual return code
         * returned by the evaluated code.
         */

        if (iPtr->numLevels == 0) {
            if (code == TCL_RETURN) {
                code = TclUpdateReturnInfo(iPtr);
            }
            if ((code != TCL_ERROR) && !allowExceptions) {
                ProcessUnexpectedResult(interp, code);
                code = TCL_ERROR;
            }
        }

        if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
            /*
             * If there was an error, a command string will be needed for the
             * error log: generate it now. Do not worry too much about doing
             * it expensively.
             */

            Tcl_Obj *listPtr;
            char *cmdString;
            int cmdLen;

            listPtr = Tcl_NewListObj(objc, objv);
            cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
            Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
            Tcl_DecrRefCount(listPtr);
        }

        return code;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalTokensStandard --
 *
 *      Given an array of tokens parsed from a Tcl command (e.g., the tokens
 *      that make up a word or the index for an array variable) this function
 *      evaluates the tokens and concatenates their values to form a single
 *      result value.
 *
 * Results:
 *      The return value is a standard Tcl completion code such as TCL_OK or
 *      TCL_ERROR. A result or error message is left in interp's result.
 *
 * Side effects:
 *      Depends on the array of tokens being evaled.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,         /* Interpreter in which to lookup variables,
                                 * execute nested commands, and report
                                 * errors. */
    Tcl_Token *tokenPtr,        /* Pointer to first in an array of tokens to
                                 * evaluate and concatenate. */
    int count)                  /* Number of tokens to consider at tokenPtr.
                                 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalTokens --
 *
 *      Given an array of tokens parsed from a Tcl command (e.g., the tokens
 *      that make up a word or the index for an array variable) this function
 *      evaluates the tokens and concatenates their values to form a single
 *      result value.
 *
 * Results:
 *      The return value is a pointer to a newly allocated Tcl_Obj containing
 *      the value of the array of tokens. The reference count of the returned
 *      object has been incremented. If an error occurs in evaluating the
 *      tokens then a NULL value is returned and an error message is left in
 *      interp's result.
 *
 * Side effects:
 *      A new object is allocated to hold the result.
 *
 *----------------------------------------------------------------------
 *
 * This uses a non-standard return convention; its use is now deprecated. It
 * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
 * in the core any longer. It is only kept for backward compatibility.
 */

Tcl_Obj *
Tcl_EvalTokens(
    Tcl_Interp *interp,         /* Interpreter in which to lookup variables,
                                 * execute nested commands, and report
                                 * errors. */
    Tcl_Token *tokenPtr,        /* Pointer to first in an array of tokens to
                                 * evaluate and concatenate. */
    int count)                  /* Number of tokens to consider at tokenPtr.
                                 * Must be at least 1. */
{
    Tcl_Obj *resPtr;

    if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
        return NULL;
    }
    resPtr = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resPtr);
    Tcl_ResetResult(interp);
    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *
 *      This function evaluates a Tcl script without using the compiler or
 *      byte-code interpreter. It just parses the script, creates values for
 *      each word of each command, then calls EvalObjv to execute each
 *      command.
 *
 * Results:
 *      The return value is a standard Tcl completion code such as TCL_OK or
 *      TCL_ERROR. A result or error message is left in interp's result.
 *
 * Side effects:
 *      Depends on the script.
 *
 * TIP #280 : Keep public API, internally extended API.
 *----------------------------------------------------------------------
 */

int
Tcl_EvalEx(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate the
                                 * script. Also used for error reporting. */
    const char *script,         /* First character of script to evaluate. */
    int numBytes,               /* Number of bytes in script. If < 0, the
                                 * script consists of all bytes up to the
                                 * first null character. */
    int flags)                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Only
                                 * TCL_EVAL_GLOBAL is currently supported. */
{
  return TclEvalEx(interp, script, numBytes, flags, 1);
}

int
TclEvalEx(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate the
                                 * script. Also used for error reporting. */
    const char *script,         /* First character of script to evaluate. */
    int numBytes,               /* Number of bytes in script. If < 0, the
                                 * script consists of all bytes up to the
                                 * first NUL character. */
    int flags,                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Only
                                 * TCL_EVAL_GLOBAL is currently supported. */
    int line)                   /* The line the script starts on. */
{
    Interp *iPtr = (Interp *) interp;
    const char *p, *next;
    const unsigned int minObjs = 20;
    Tcl_Obj **objv, **objvSpace;
    int *expand, *lines, *lineSpace;
    Tcl_Token *tokenPtr;
    int commandLength, bytesLeft, expandRequested, code = TCL_OK;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
                                 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    unsigned int i, objectsUsed = 0;
                                /* These variables keep track of how much
                                 * state has been allocated while evaluating
                                 * the script, so that it can be freed
                                 * properly if an error occurs. */
    Tcl_Parse *parsePtr = (Tcl_Parse *)
            TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)
            TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)
            TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
    int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
                                /* TIP #280 Structures for tracking of command
                                 * locations. */

    if (numBytes < 0) {
        numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
        iPtr->varFramePtr = iPtr->rootFramePtr;
    }

    /*
     * Each iteration through the following loop parses the next command from
     * the script and then executes it.
     */

    objv = objvSpace = stackObjArray;
    lines = lineSpace = linesStack;
    expand = expandStack;
    p = script;
    bytesLeft = numBytes;

    /*
     * TIP #280 Initialize tracking. Do not push on the frame stack yet.
     *
     * We may cont. counting based on a specific context (CTX), or open a new
     * context, either for a sourced script, or 'eval'. For sourced files we
     * always have a path object, even if nothing was specified in the interp
     * itself. That makes code using it simpler as NULL checks can be left
     * out. Sourced file without path in the 'scriptFile' is possible during
     * Tcl initialization.
     */

    if (iPtr->evalFlags & TCL_EVAL_CTX) {
        /*
         * Path information comes out of the context.
         */

        eeFramePtr->type = TCL_LOCATION_SOURCE;
        eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
        Tcl_IncrRefCount(eeFramePtr->data.eval.path);
    } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
        /*
         * Set up for a sourced file.
         */

        eeFramePtr->type = TCL_LOCATION_SOURCE;

        if (iPtr->scriptFile) {
            /*
             * Normalization here, to have the correct pwd. Should have
             * negligible impact on performance, as the norm should have been
             * done already by the 'source' invoking us, and it caches the
             * result.
             */

            Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);

            if (norm == NULL) {
                /*
                 * Error message in the interp result.
                 */
                code = TCL_ERROR;
                goto error;
            }
            eeFramePtr->data.eval.path = norm;
            Tcl_IncrRefCount(eeFramePtr->data.eval.path);
        } else {
            TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
        }
    } else {
        /*
         * Set up for plain eval.
         */

        eeFramePtr->type = TCL_LOCATION_EVAL;
        eeFramePtr->data.eval.path = NULL;
    }

    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
    eeFramePtr->framePtr = iPtr->framePtr;
    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
    eeFramePtr->nline = 0;
    eeFramePtr->line = NULL;

    iPtr->evalFlags = 0;
    do {
        if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
            code = TCL_ERROR;
            goto error;
        }

        /*
         * TIP #280 Track lines. The parser may have skipped text till it
         * found the command we are now at. We have to count the lines in this
         * block.
         */

        TclAdvanceLines(&line, p, parsePtr->commandStart);

        gotParse = 1;
        if (parsePtr->numWords > 0) {
            /*
             * TIP #280. Track lines within the words of the current command.
             */

            int wordLine  = line;
            const char *wordStart = parsePtr->commandStart;

            /*
             * Generate an array of objects for the words of the command.
             */

            unsigned int objectsNeeded = 0;
            unsigned int numWords = parsePtr->numWords;

            if (numWords > minObjs) {
                expand = (int *) ckalloc(numWords * sizeof(int));
                objvSpace = (Tcl_Obj **)
                        ckalloc(numWords * sizeof(Tcl_Obj *));
                lineSpace = (int *) ckalloc(numWords * sizeof(int));
            }
            expandRequested = 0;
            objv = objvSpace;
            lines = lineSpace;

            for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
                    objectsUsed < numWords;
                    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
                /*
                 * TIP #280. Track lines to current word. Save the information
                 * on a per-word basis, signaling dynamic words as needed.
                 * Make the information available to the recursively called
                 * evaluator as well, including the type of context (source
                 * vs. eval).
                 */

                TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
                wordStart = tokenPtr->start;

                lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
                        ? wordLine : -1;

                if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
                    iPtr->evalFlags |= TCL_EVAL_FILE;
                }

                code = TclSubstTokens(interp, tokenPtr+1,
                        tokenPtr->numComponents, NULL, wordLine);

                iPtr->evalFlags = 0;

                if (code != TCL_OK) {
                    goto error;
                }
                objv[objectsUsed] = Tcl_GetObjResult(interp);
                Tcl_IncrRefCount(objv[objectsUsed]);
                if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
                    int numElements;

                    code = TclListObjLength(interp, objv[objectsUsed],
                            &numElements);
                    if (code == TCL_ERROR) {
                        /*
                         * Attempt to expand a non-list.
                         */

                        Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
                                "\n    (expanding word %d)", objectsUsed));
                        Tcl_DecrRefCount(objv[objectsUsed]);
                        goto error;
                    }
                    expandRequested = 1;
                    expand[objectsUsed] = 1;

                    objectsNeeded += (numElements ? numElements : 1);
                } else {
                    expand[objectsUsed] = 0;
                    objectsNeeded++;
                }
            } /* for loop */
            if (expandRequested) {
                /*
                 * Some word expansion was requested. Check for objv resize.
                 */

                Tcl_Obj **copy = objvSpace;
                int *lcopy = lineSpace;
                int wordIdx = numWords;
                int objIdx = objectsNeeded - 1;

                if ((numWords > minObjs) || (objectsNeeded >  minObjs)) {
                    objv = objvSpace = (Tcl_Obj **)
                            ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
                    lines = lineSpace = (int *)
                            ckalloc(objectsNeeded * sizeof(int));
                }

                objectsUsed = 0;
                while (wordIdx--) {
                    if (expand[wordIdx]) {
                        int numElements;
                        Tcl_Obj **elements, *temp = copy[wordIdx];

                        Tcl_ListObjGetElements(NULL, temp, &numElements,
                                &elements);
                        objectsUsed += numElements;
                        while (numElements--) {
                            lines[objIdx] = -1;
                            objv[objIdx--] = elements[numElements];
                            Tcl_IncrRefCount(elements[numElements]);
                        }
                        Tcl_DecrRefCount(temp);
                    } else {
                        lines[objIdx] = lcopy[wordIdx];
                        objv[objIdx--] = copy[wordIdx];
                        objectsUsed++;
                    }
                }
                objv += objIdx+1;

                if (copy != stackObjArray) {
                    ckfree((char *) copy);
                }
                if (lcopy != linesStack) {
                    ckfree((char *) lcopy);
                }
            }

            /*
             * Execute the command and free the objects for its words.
             *
             * TIP #280: Remember the command itself for 'info frame'. We
             * shorten the visible command by one char to exclude the
             * termination character, if necessary. Here is where we put our
             * frame on the stack of frames too. _After_ the nested commands
             * have been executed.
             */

            eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
            eeFramePtr->cmd.str.len = parsePtr->commandSize;

            if (parsePtr->term ==
                    parsePtr->commandStart + parsePtr->commandSize - 1) {
                eeFramePtr->cmd.str.len--;
            }

            eeFramePtr->nline = objectsUsed;
            eeFramePtr->line = lines;

            iPtr->cmdFramePtr = eeFramePtr;
            iPtr->numLevels++;
            code = TclEvalObjvInternal(interp, objectsUsed, objv,
                    parsePtr->commandStart, parsePtr->commandSize, 0);
            iPtr->numLevels--;
            iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;

            eeFramePtr->line = NULL;
            eeFramePtr->nline = 0;

            if (code != TCL_OK) {
                goto error;
            }
            for (i = 0; i < objectsUsed; i++) {
                Tcl_DecrRefCount(objv[i]);
            }
            objectsUsed = 0;
            if (objvSpace != stackObjArray) {
                ckfree((char *) objvSpace);
                objvSpace = stackObjArray;
                ckfree((char *) lineSpace);
                lineSpace = linesStack;
            }

            /*
             * Free expand separately since objvSpace could have been
             * reallocated above.
             */

            if (expand != expandStack) {
                ckfree((char *) expand);
                expand = expandStack;
            }
        }

        /*
         * Advance to the next command in the script.
         *
         * TIP #280 Track Lines. Now we track how many lines were in the
         * executed command.
         */

        next = parsePtr->commandStart + parsePtr->commandSize;
        bytesLeft -= next - p;
        p = next;
        TclAdvanceLines(&line, parsePtr->commandStart, p);
        Tcl_FreeParse(parsePtr);
        gotParse = 0;
    } while (bytesLeft > 0);
    iPtr->varFramePtr = savedVarFramePtr;
    code = TCL_OK;
    goto cleanup_return;

  error:
    /*
     * Generate and log various pieces of error information.
     */

    if (iPtr->numLevels == 0) {
        if (code == TCL_RETURN) {
            code = TclUpdateReturnInfo(iPtr);
        }
        if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) {
            ProcessUnexpectedResult(interp, code);
            code = TCL_ERROR;
        }
    }
    if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
        commandLength = parsePtr->commandSize;
        if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
            /*
             * The terminator character (such as ; or ]) of the command where
             * the error occurred is the last character in the parsed command.
             * Reduce the length by one so that the error message doesn't
             * include the terminator character.
             */

            commandLength -= 1;
        }
        Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
                commandLength);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;

    /*
     * Then free resources that had been allocated to the command.
     */

    for (i = 0; i < objectsUsed; i++) {
        Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
        Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
        ckfree((char *) objvSpace);
        ckfree((char *) lineSpace);
    }
    if (expand != expandStack) {
        ckfree((char *) expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */

    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
        Tcl_DecrRefCount(eeFramePtr->data.eval.path);
    }
    TclStackFree(interp, linesStack);
    TclStackFree(interp, expandStack);
    TclStackFree(interp, stackObjArray);
    TclStackFree(interp, eeFramePtr);
    TclStackFree(interp, parsePtr);

    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAdvanceLines --
 *
 *      This function is a helper which counts the number of lines in a block
 *      of text and advances an external counter.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The specified counter is advanced per the number of lines found.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceLines(
    int *line,
    const char *start,
    const char *end)
{
    register const char *p;

    for (p = start; p < end; p++) {
        if (*p == '\n') {
            (*line)++;
        }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Eval --
 *
 *      Execute a Tcl command in a string. This function executes the script
 *      directly, rather than compiling it to bytecodes. Before the arrival of
 *      the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used
 *      for executing Tcl commands, but nowadays it isn't used much.
 *
 * Results:
 *      The return value is one of the return codes defined in tcl.h (such as
 *      TCL_OK), and interp's result contains a value to supplement the return
 *      code. The value of the result will persist only until the next call to
 *      Tcl_Eval or Tcl_EvalObj: you must copy it or lose it!
 *
 * Side effects:
 *      Can be almost arbitrary, depending on the commands in the script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Eval(
    Tcl_Interp *interp,         /* Token for command interpreter (returned by
                                 * previous call to Tcl_CreateInterp). */
    const char *script)         /* Pointer to TCL command to execute. */
{
    int code = Tcl_EvalEx(interp, script, -1, 0);

    /*
     * For backwards compatibility with old C code that predates the object
     * system in Tcl 8.0, we have to mirror the object result back into the
     * string result (some callers may expect it there).
     */

    (void) Tcl_GetStringResult(interp);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObj, Tcl_GlobalEvalObj --
 *
 *      These functions are deprecated but we keep them around for backwards
 *      compatibility reasons.
 *
 * Results:
 *      See the functions they call.
 *
 * Side effects:
 *      See the functions they call.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_EvalObj
int
Tcl_EvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    return Tcl_EvalObjEx(interp, objPtr, 0);
}

#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjEx, TclEvalObjEx --
 *
 *      Execute Tcl commands stored in a Tcl object. These commands are
 *      compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
 *      specified.
 *
 * Results:
 *      The return value is one of the return codes defined in tcl.h (such as
 *      TCL_OK), and the interpreter's result contains a value to supplement
 *      the return code.
 *
 * Side effects:
 *      The object is converted, if necessary, to a ByteCode object that holds
 *      the bytecode instructions for the commands. Executing the commands
 *      will almost certainly have side effects that depend on those commands.
 *
 * TIP #280 : Keep public API, internally extended API.
 *----------------------------------------------------------------------
 */

int
Tcl_EvalObjEx(
    Tcl_Interp *interp,         /* Token for command interpreter (returned by
                                 * a previous call to Tcl_CreateInterp). */
    register Tcl_Obj *objPtr,   /* Pointer to object containing commands to
                                 * execute. */
    int flags)                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Supported values
                                 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
{
    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
}

int
TclEvalObjEx(
    Tcl_Interp *interp,         /* Token for command interpreter (returned by
                                 * a previous call to Tcl_CreateInterp). */
    register Tcl_Obj *objPtr,   /* Pointer to object containing commands to
                                 * execute. */
    int flags,                  /* Collection of OR-ed bits that control the
                                 * evaluation of the script. Supported values
                                 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,    /* Frame of the command doing the eval. */
    int word)                   /* Index of the word which is in objPtr. */
{
    register Interp *iPtr = (Interp *) interp;
    char *script;
    int numSrcBytes;
    int result;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
                                 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);

    Tcl_IncrRefCount(objPtr);

    if (flags & TCL_EVAL_DIRECT) {
        /*
         * We're not supposed to use the compiler or byte-code interpreter.
         * Let Tcl_EvalEx evaluate the command directly (and probably more
         * slowly).
         *
         * Pure List Optimization (no string representation). In this case, we
         * can safely use Tcl_EvalObjv instead and get an appreciable
         * improvement in execution speed. This is because it allows us to
         * avoid a setFromAny step that would just pack everything into a
         * string and back out again.
         *
         * This restriction has been relaxed a bit by storing in lists whether
         * they are "canonical" or not (a canonical list being one that is
         * either pure or that has its string rep derived by
         * UpdateStringOfList from the internal rep).
         */

        if (objPtr->typePtr == &tclListType) {  /* is a list... */
            List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;

            if (objPtr->bytes == NULL ||        /* ...without a string rep */
                    listRepPtr->canonicalFlag) {/* ...or that is canonical */
                /*
                 * TIP #280 Structures for tracking lines. As we know that
                 * this is dynamic execution we ignore the invoker, even if
                 * known.
                 */

                int line, i;
                char *w;
                Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
                CmdFrame *eoFramePtr = (CmdFrame *)
                        TclStackAlloc(interp, sizeof(CmdFrame));

                eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
                eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
                        1 : iPtr->cmdFramePtr->level + 1);
                eoFramePtr->framePtr = iPtr->framePtr;
                eoFramePtr->nextPtr = iPtr->cmdFramePtr;

                Tcl_ListObjGetElements(NULL, copyPtr,
                        &(eoFramePtr->nline), &elements);
                eoFramePtr->line = (int *)
                        ckalloc(eoFramePtr->nline * sizeof(int));

                eoFramePtr->cmd.listPtr  = objPtr;
                Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
                eoFramePtr->data.eval.path = NULL;

                /*
                 * TIP #280 Computes all the line numbers for the words in the
                 * command.
                 */

                line = 1;
                for (i=0; i < eoFramePtr->nline; i++) {
                    eoFramePtr->line[i] = line;
                    w = TclGetString(elements[i]);
                    TclAdvanceLines(&line, w, w + strlen(w));
                }

                iPtr->cmdFramePtr = eoFramePtr;
                result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements,
                        flags);

                Tcl_DecrRefCount(copyPtr);
                iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
                Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
                ckfree((char *) eoFramePtr->line);
                eoFramePtr->line = NULL;
                eoFramePtr->nline = 0;
                TclStackFree(interp, eoFramePtr);

                goto done;
            }
        }

        /*
         * TIP #280. Propagate context as much as we can. Especially if the
         * script to evaluate is a single literal it makes sense to look if
         * our context is one with absolute line numbers we can then track
         * into the literal itself too.
         *
         * See also tclCompile.c, TclInitCompileEnv, for the equivalent code
         * in the bytecode compiler.
         */

        if (invoker == NULL) {
            /*
             * No context, force opening of our own.
             */

            script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
            result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
        } else {
            /*
             * We have an invoker, describing the command asking for the
             * evaluation of a subordinate script. This script may originate
             * in a literal word, or from a variable, etc. Using the line
             * array we now check if we have good line information for the
             * relevant word. The type of context is relevant as well. In a
             * non-'source' context we don't have to try tracking lines.
             *
             * First see if the word exists and is a literal. If not we go
             * through the easy dynamic branch. No need to perform more
             * complex invokations.
             */

            if ((invoker->nline <= word) || (invoker->line[word] < 0)) {
                /*
                 * Dynamic script, or dynamic context, force our own
                 * context.
                 */

                script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
                result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

            } else {
                /*
                 * Try to get an absolute context for the evaluation.
                 */

                int pc = 0;
                CmdFrame *ctxPtr = (CmdFrame *)
                        TclStackAlloc(interp, sizeof(CmdFrame));

                *ctxPtr = *invoker;
                if (invoker->type == TCL_LOCATION_BC) {
                    /*
                     * Note: Type BC => ctxPtr->data.eval.path is not used.
                     * ctxPtr->data.tebc.codePtr is used instead.
                     */

                    TclGetSrcInfoForPc(ctxPtr);
                    pc = 1;
                }

                if (ctxPtr->type == TCL_LOCATION_SOURCE) {
                    /*
                     * Absolute context to reuse.
                     */

                    iPtr->invokeCmdFramePtr = ctxPtr;
                    iPtr->evalFlags |= TCL_EVAL_CTX;

                    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
                    result = TclEvalEx(interp, script, numSrcBytes, flags,
                            ctxPtr->line[word]);

                    if (pc) {
                        /*
                         * Death of SrcInfo reference.
                         */

                        Tcl_DecrRefCount(ctxPtr->data.eval.path);
                    }
                } else {
                    /*
                     * Dynamic context or script, easier to make our own as
                     * well.
                     */

                    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
                    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
                }

                TclStackFree(interp, ctxPtr);
            }
        }
    } else {
        /*
         * Let the compiler/engine subsystem do the evaluation.
         *
         * TIP #280 The invoker provides us with the context for the script.
         * We transfer this to the byte code compiler.
         */

        savedVarFramePtr = iPtr->varFramePtr;
        if (flags & TCL_EVAL_GLOBAL) {
            iPtr->varFramePtr = iPtr->rootFramePtr;
        }

        result = TclCompEvalObj(interp, objPtr, invoker, word);

        /*
         * If we are again at the top level, process any unusual return code
         * returned by the evaluated code.
         */

        if (iPtr->numLevels == 0) {
            if (result == TCL_RETURN) {
                result = TclUpdateReturnInfo(iPtr);
            }
            if ((result != TCL_OK) && (result != TCL_ERROR)
                    && !allowExceptions) {
                ProcessUnexpectedResult(interp, result);
                result = TCL_ERROR;
                script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
                Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
            }
        }
        iPtr->evalFlags = 0;
        iPtr->varFramePtr = savedVarFramePtr;
    }

  done:
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcessUnexpectedResult --
 *
 *      Function called by Tcl_EvalObj to set the interpreter's result value
 *      to an appropriate error message when the code it evaluates returns an
 *      unexpected result code (not TCL_OK and not TCL_ERROR) to the topmost
 *      evaluation level.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The interpreter result is set to an error message appropriate to the
 *      result code.
 *
 *----------------------------------------------------------------------
 */

static void
ProcessUnexpectedResult(
    Tcl_Interp *interp,         /* The interpreter in which the unexpected
                                 * result code was returned. */
    int returnCode)             /* The unexpected result code. */
{
    Tcl_ResetResult(interp);
    if (returnCode == TCL_BREAK) {
        Tcl_AppendResult(interp,
                "invoked \"break\" outside of a loop", NULL);
    } else if (returnCode == TCL_CONTINUE) {
        Tcl_AppendResult(interp,
                "invoked \"continue\" outside of a loop", NULL);
    } else {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "command returned bad code: %d", returnCode));
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
 *
 *      Functions to evaluate an expression and return its value in a
 *      particular form.
 *
 * Results:
 *      Each of the functions below returns a standard Tcl result. If an error
 *      occurs then an error message is left in the interp's result. Otherwise
 *      the value of the expression, in the appropriate form, is stored at
 *      *ptr. If the expression had a result that was incompatible with the
 *      desired form then an error is returned.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_ExprLong(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    const char *exprstring,     /* Expression to evaluate. */
    long *ptr)                  /* Where to store result. */
{
    register Tcl_Obj *exprPtr;
    int result = TCL_OK;
    if (*exprstring == '\0') {
        /*
         * Legacy compatibility - return 0 for the zero-length string.
         */

        *ptr = 0;
    } else {
        exprPtr = Tcl_NewStringObj(exprstring, -1);
        Tcl_IncrRefCount(exprPtr);
        result = Tcl_ExprLongObj(interp, exprPtr, ptr);
        Tcl_DecrRefCount(exprPtr);
        if (result != TCL_OK) {
            (void) Tcl_GetStringResult(interp);
        }
    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    const char *exprstring,     /* Expression to evaluate. */
    double *ptr)                /* Where to store result. */
{
    register Tcl_Obj *exprPtr;
    int result = TCL_OK;

    if (*exprstring == '\0') {
        /*
         * Legacy compatibility - return 0 for the zero-length string.
         */

        *ptr = 0.0;
    } else {
        exprPtr = Tcl_NewStringObj(exprstring, -1);
        Tcl_IncrRefCount(exprPtr);
        result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
        Tcl_DecrRefCount(exprPtr);
                                /* Discard the expression object. */
        if (result != TCL_OK) {
            (void) Tcl_GetStringResult(interp);
        }
    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    const char *exprstring,     /* Expression to evaluate. */
    int *ptr)                   /* Where to store 0/1 result. */
{
    if (*exprstring == '\0') {
        /*
         * An empty string. Just set the result boolean to 0 (false).
         */

        *ptr = 0;
        return TCL_OK;
    } else {
        int result;
        Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

        Tcl_IncrRefCount(exprPtr);
        result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
        Tcl_DecrRefCount(exprPtr);
        if (result != TCL_OK) {
            /*
             * Move the interpreter's object result to the string result, then
             * reset the object result.
             */

            (void) Tcl_GetStringResult(interp);
        }
        return result;
    }
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
 *
 *      Functions to evaluate an expression in an object and return its value
 *      in a particular form.
 *
 * Results:
 *      Each of the functions below returns a standard Tcl result object. If
 *      an error occurs then an error message is left in the interpreter's
 *      result. Otherwise the value of the expression, in the appropriate
 *      form, is stored at *ptr. If the expression had a result that was
 *      incompatible with the desired form then an error is returned.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

int
Tcl_ExprLongObj(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    register Tcl_Obj *objPtr,   /* Expression to evaluate. */
    long *ptr)                  /* Where to store long result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    double d;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
        return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK){
        return TCL_ERROR;
    }

    switch (type) {
    case TCL_NUMBER_DOUBLE: {
        mp_int big;

        d = *((const double *) internalPtr);
        Tcl_DecrRefCount(resultPtr);
        if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
            return TCL_ERROR;
        }
        resultPtr = Tcl_NewBignumObj(&big);
        /* FALLTHROUGH */
    }
    case TCL_NUMBER_LONG:
    case TCL_NUMBER_WIDE:
    case TCL_NUMBER_BIG:
        result = TclGetLongFromObj(interp, resultPtr, ptr);
        break;

    case TCL_NUMBER_NAN:
        Tcl_GetDoubleFromObj(interp, resultPtr, &d);
        result = TCL_ERROR;
    }

    Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
    return result;
}

int
Tcl_ExprDoubleObj(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    register Tcl_Obj *objPtr,   /* Expression to evaluate. */
    double *ptr)                /* Where to store double result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
        return TCL_ERROR;
    }

    result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
    if (result == TCL_OK) {
        switch (type) {
        case TCL_NUMBER_NAN:
#ifndef ACCEPT_NAN
            result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
            break;
#endif
        case TCL_NUMBER_DOUBLE:
            *ptr = *((const double *) internalPtr);
            result = TCL_OK;
            break;
        default:
            result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
        }
    }
    Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
    return result;
}

int
Tcl_ExprBooleanObj(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    register Tcl_Obj *objPtr,   /* Expression to evaluate. */
    int *ptr)                   /* Where to store 0/1 result. */
{
    Tcl_Obj *resultPtr;
    int result;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result == TCL_OK) {
        result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
        Tcl_DecrRefCount(resultPtr);
                                /* Discard the result object. */
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjInvokeNamespace --
 *
 *      Object version: Invokes a Tcl command, given an objv/objc, from either
 *      the exposed or hidden set of commands in the given interpreter.
 *      NOTE: The command is invoked in the global stack frame of the
 *      interpreter or namespace, thus it cannot see any current state on the
 *      stack of that interpreter.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Whatever the command does.
 *
 *----------------------------------------------------------------------
 */

int
TclObjInvokeNamespace(
    Tcl_Interp *interp,         /* Interpreter in which command is to be
                                 * invoked. */
    int objc,                   /* Count of arguments. */
    Tcl_Obj *const objv[],      /* Argument objects; objv[0] points to the
                                 * name of the command to invoke. */
    Tcl_Namespace *nsPtr,       /* The namespace to use. */
    int flags)                  /* Combination of flags controlling the call:
                                 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
                                 * or TCL_INVOKE_NO_TRACEBACK. */
{
    int result;
    Tcl_CallFrame *framePtr;

    /*
     * Make the specified namespace the current namespace and invoke the
     * command.
     */

    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
    if (result != TCL_OK) {
        return TCL_ERROR;
    }

    result = TclObjInvoke(interp, objc, objv, flags);

    TclPopStackFrame(interp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjInvoke --
 *
 *      Invokes a Tcl command, given an objv/objc, from either the exposed or
 *      the hidden sets of commands in the given interpreter.
 *
 * Results:
 *      A standard Tcl object result.
 *
 * Side effects:
 *      Whatever the command does.
 *
 *----------------------------------------------------------------------
 */

int
TclObjInvoke(
    Tcl_Interp *interp,         /* Interpreter in which command is to be
                                 * invoked. */
    int objc,                   /* Count of arguments. */
    Tcl_Obj *const objv[],      /* Argument objects; objv[0] points to the
                                 * name of the command to invoke. */
    int flags)                  /* Combination of flags controlling the call:
                                 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
                                 * or TCL_INVOKE_NO_TRACEBACK. */
{
    register Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTblPtr;     /* Table of hidden commands. */
    char *cmdName;              /* Name of the command from objv[0]. */
    Tcl_HashEntry *hPtr = NULL;
    Command *cmdPtr;
    int result;

    if (interp == NULL) {
        return TCL_ERROR;
    }

    if ((objc < 1) || (objv == NULL)) {
        Tcl_AppendResult(interp, "illegal argument vector", NULL);
        return TCL_ERROR;
    }

    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
        Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }

    if (TclInterpReady(interp) == TCL_ERROR) {
        return TCL_ERROR;
    }

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
        hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
        Tcl_AppendResult(interp, "invalid hidden command name \"",
                cmdName, "\"", NULL);
        return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Invoke the command function.
     */

    iPtr->cmdCount++;
    result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);

    /*
     * If an error occurred, record information about what was being executed
     * when the error occurred.
     */

    if ((result == TCL_ERROR)
            && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
            && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
        int length;
        Tcl_Obj *command = Tcl_NewListObj(objc, objv);
        const char *cmdString;

        Tcl_IncrRefCount(command);
        cmdString = Tcl_GetStringFromObj(command, &length);
        Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
        Tcl_DecrRefCount(command);
        iPtr->flags &= ~ERR_ALREADY_LOGGED;
    }
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprString --
 *
 *      Evaluate an expression in a string and return its value in string
 *      form.
 *
 * Results:
 *      A standard Tcl result. If the result is TCL_OK, then the interp's
 *      result is set to the string value of the expression. If the result is
 *      TCL_ERROR, then the interp's result contains an error message.
 *
 * Side effects:
 *      A Tcl object is allocated to hold a copy of the expression string.
 *      This expression object is passed to Tcl_ExprObj and then deallocated.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_ExprString(
    Tcl_Interp *interp,         /* Context in which to evaluate the
                                 * expression. */
    const char *expr)           /* Expression to evaluate. */
{
    int code = TCL_OK;

    if (expr[0] == '\0') {
        /*
         * An empty string. Just set the interpreter's result to 0.
         */

        Tcl_SetResult(interp, "0", TCL_VOLATILE);
    } else {
        Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);

        Tcl_IncrRefCount(exprObj);
        code = Tcl_ExprObj(interp, exprObj, &resultPtr);
        Tcl_DecrRefCount(exprObj);
        if (code == TCL_OK) {
            Tcl_SetObjResult(interp, resultPtr);
            Tcl_DecrRefCount(resultPtr);
        }

        /*
         * Force the string rep of the interp result.
         */

        (void) Tcl_GetStringResult(interp);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --
 *
 *      Add a Tcl_Obj value to the errorInfo field that describes the current
 *      error.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The value of the Tcl_obj is appended to the errorInfo field. If we are
 *      just starting to log an error, errorInfo is initialized from the error
 *      message in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,         /* Interpreter to which error information
                                 * pertains. */
    Tcl_Obj *objPtr)            /* Message to record. */
{
    int length;
    const char *message = TclGetStringFromObj(objPtr, &length);

    Tcl_IncrRefCount(objPtr);
    Tcl_AddObjErrorInfo(interp, message, length);
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddErrorInfo --
 *
 *      Add information to the errorInfo field that describes the current
 *      error.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The contents of message are appended to the errorInfo field. If we are
 *      just starting to log an error, errorInfo is initialized from the error
 *      message in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddErrorInfo(
    Tcl_Interp *interp,         /* Interpreter to which error information
                                 * pertains. */
    const char *message)        /* Message to record. */
{
    Tcl_AddObjErrorInfo(interp, message, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddObjErrorInfo --
 *
 *      Add information to the errorInfo field that describes the current
 *      error. This routine differs from Tcl_AddErrorInfo by taking a byte
 *      pointer and length.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      "length" bytes from "message" are appended to the errorInfo field. If
 *      "length" is negative, use bytes up to the first NULL byte. If we are
 *      just starting to log an error, errorInfo is initialized from the error
 *      message in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddObjErrorInfo(
    Tcl_Interp *interp,         /* Interpreter to which error information
                                 * pertains. */
    const char *message,        /* Points to the first byte of an array of
                                 * bytes of the message. */
    int length)                 /* The number of bytes in the message. If < 0,
                                 * then append all bytes up to a NULL byte. */
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
     */

    iPtr->flags |= ERR_LEGACY_COPY;
    if (iPtr->errorInfo == NULL) {
        if (iPtr->result[0] != 0) {
            /*
             * The interp's string result is set, apparently by some extension
             * making a deprecated direct write to it. That extension may
             * expect interp->result to continue to be set, so we'll take
             * special pains to avoid clearing it, until we drop support for
             * interp->result completely.
             */

            iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
        } else {
            iPtr->errorInfo = iPtr->objResultPtr;
        }
        Tcl_IncrRefCount(iPtr->errorInfo);
        if (!iPtr->errorCode) {
            Tcl_SetErrorCode(interp, "NONE", NULL);
        }
    }

    /*
     * Now append "message" to the end of errorInfo.
     */

    if (length != 0) {
        if (Tcl_IsShared(iPtr->errorInfo)) {
            Tcl_DecrRefCount(iPtr->errorInfo);
            iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
            Tcl_IncrRefCount(iPtr->errorInfo);
        }
        Tcl_AppendToObj(iPtr->errorInfo, message, length);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_VarEvalVA --
 *
 *      Given a variable number of string arguments, concatenate them all
 *      together and execute the result as a Tcl command.
 *
 * Results:
 *      A standard Tcl return result. An error message or other result may be
 *      left in the interp's result.
 *
 * Side effects:
 *      Depends on what was done by the command.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_VarEvalVA(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate command. */
    va_list argList)            /* Variable argument list. */
{
    Tcl_DString buf;
    char *string;
    int result;

    /*
     * Copy the strings one after the other into a single larger string. Use
     * stack-allocated space for small commands, but if the command gets too
     * large than call ckalloc to create the space.
     */

    Tcl_DStringInit(&buf);
    while (1) {
        string = va_arg(argList, char *);
        if (string == NULL) {
            break;
        }
        Tcl_DStringAppend(&buf, string, -1);
    }

    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
    Tcl_DStringFree(&buf);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarEval --
 *
 *      Given a variable number of string arguments, concatenate them all
 *      together and execute the result as a Tcl command.
 *
 * Results:
 *      A standard Tcl return result. An error message or other result may be
 *      left in interp->result.
 *
 * Side effects:
 *      Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */
        /* ARGSUSED */
int
Tcl_VarEval(
    Tcl_Interp *interp,
    ...)
{
    va_list argList;
    int result;

    va_start(argList, interp);
    result = Tcl_VarEvalVA(interp, argList);
    va_end(argList);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalEval --
 *
 *      Evaluate a command at global level in an interpreter.
 *
 * Results:
 *      A standard Tcl result is returned, and the interp's result is modified
 *      accordingly.
 *
 * Side effects:
 *      The command string is executed in interp, and the execution is carried
 *      out in the variable context of global level (no functions active),
 *      just as if an "uplevel #0" command were being executed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GlobalEval(
    Tcl_Interp *interp,         /* Interpreter in which to evaluate command. */
    const char *command)        /* Command to evaluate. */
{
    register Interp *iPtr = (Interp *) interp;
    int result;
    CallFrame *savedVarFramePtr;

    savedVarFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = iPtr->rootFramePtr;
    result = Tcl_Eval(interp, command);
    iPtr->varFramePtr = savedVarFramePtr;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetRecursionLimit --
 *
 *      Set the maximum number of recursive calls that may be active for an
 *      interpreter at once.
 *
 * Results:
 *      The return value is the old limit on nesting for interp.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetRecursionLimit(
    Tcl_Interp *interp,         /* Interpreter whose nesting limit is to be
                                 * set. */
    int depth)                  /* New value for maximimum depth. */
{
    Interp *iPtr = (Interp *) interp;
    int old;

    old = iPtr->maxNestingDepth;
    if (depth > 0) {
        iPtr->maxNestingDepth = depth;
    }
    return old;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AllowExceptions --
 *
 *      Sets a flag in an interpreter so that exceptions can occur in the next
 *      call to Tcl_Eval without them being turned into errors.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's evalFlags
 *      structure. See the reference documentation for more details.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AllowExceptions(
    Tcl_Interp *interp)         /* Interpreter in which to set flag. */
{
    Interp *iPtr = (Interp *) interp;

    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVersion --
 *
 *      Get the Tcl major, minor, and patchlevel version numbers and the
 *      release type. A patch is a release type TCL_FINAL_RELEASE with a
 *      patchLevel > 0.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_GetVersion(
    int *majorV,
    int *minorV,
    int *patchLevelV,
    int *type)
{
    if (majorV != NULL) {
        *majorV = TCL_MAJOR_VERSION;
    }
    if (minorV != NULL) {
        *minorV = TCL_MINOR_VERSION;
    }
    if (patchLevelV != NULL) {
        *patchLevelV = TCL_RELEASE_SERIAL;
    }
    if (type != NULL) {
        *type = TCL_RELEASE_LEVEL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Math Functions --
 *
 *      This page contains the functions that implement all of the built-in
 *      math functions for expressions.
 *
 * Results:
 *      Each function returns TCL_OK if it succeeds and pushes an Tcl object
 *      holding the result. If it fails it returns TCL_ERROR and leaves an
 *      error message in the interpreter's result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int
ExprCeilFunc(
    ClientData clientData,      /* Ignored */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclCeil(&big)));
        mp_clear(&big);
    } else {
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d)));
    }
    return TCL_OK;
}

static int
ExprFloorFunc(
    ClientData clientData,      /* Ignored */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclFloor(&big)));
        mp_clear(&big);
    } else {
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d)));
    }
    return TCL_OK;
}

static int
ExprIsqrtFunc(
    ClientData clientData,      /* Ignored */
    Tcl_Interp *interp,         /* The interpreter in which to execute. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter list. */
{
    ClientData ptr;
    int type;
    double d;
    Tcl_WideInt w;
    mp_int big;
    int exact = 0;              /* Flag == 1 if the argument can be
                                 * represented in a double as an exact
                                 * integer. */

    /*
     * Check syntax.
     */

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }

    /*
     * Make sure that the arg is a number.
     */

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }

    switch (type) {
    case TCL_NUMBER_NAN:
        Tcl_GetDoubleFromObj(interp, objv[1], &d);
        return TCL_ERROR;
    case TCL_NUMBER_DOUBLE:
        d = *((const double *) ptr);
        if (d < 0) {
            goto negarg;
        }
#ifdef IEEE_FLOATING_POINT
        if (d <= MAX_EXACT) {
            exact = 1;
        }
#endif
        if (!exact) {
            if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
                return TCL_ERROR;
            }
        }
        break;
    case TCL_NUMBER_BIG:
        if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
            return TCL_ERROR;
        }
        if (SIGN(&big) == MP_NEG) {
            mp_clear(&big);
            goto negarg;
        }
        break;
    default:
        if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
            return TCL_ERROR;
        }
        if (w < 0) {
            goto negarg;
        }
        d = (double) w;
#ifdef IEEE_FLOATING_POINT
        if (d < MAX_EXACT) {
            exact = 1;
        }
#endif
        if (!exact) {
            Tcl_GetBignumFromObj(interp, objv[1], &big);
        }
        break;
    }

    if (exact) {
        Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
    } else {
        mp_int root;

        mp_init(&root);
        mp_sqrt(&big, &root);
        mp_clear(&big);
        Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
    }

    return TCL_OK;

  negarg:
    Tcl_SetObjResult(interp,
            Tcl_NewStringObj("square root of negative argument", -1));
    return TCL_ERROR;
}

static int
ExprSqrtFunc(
    ClientData clientData,      /* Ignored */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    if ((d >= 0.0) && TclIsInfinite(d)
            && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) {
        mp_int root;

        mp_init(&root);
        mp_sqrt(&big, &root);
        mp_clear(&big);
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root)));
        mp_clear(&root);
    } else {
        Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
    }
    return TCL_OK;
}

static int
ExprUnaryFunc(
    ClientData clientData,      /* Contains the address of a function that
                                 * takes one double argument and returns a
                                 * double result. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count */
    Tcl_Obj *const *objv)       /* Actual parameter list */
{
    int code;
    double d;
    double (*func)(double) = (double (*)(double)) clientData;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
        d = objv[1]->internalRep.doubleValue;
        Tcl_ResetResult(interp);
        code = TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    errno = 0;
    return CheckDoubleResult(interp, (*func)(d));
}

static int
CheckDoubleResult(
    Tcl_Interp *interp,
    double dResult)
{
#ifndef ACCEPT_NAN
    if (TclIsNaN(dResult)) {
        TclExprFloatError(interp, dResult);
        return TCL_ERROR;
    }
#endif
    if ((errno == ERANGE) && ((dResult == 0.0) || TclIsInfinite(dResult))) {
        /*
         * When ERANGE signals under/overflow, just accept 0.0 or +/-Inf
         */
    } else if (errno != 0) {
        /*
         * Report other errno values as errors.
         */

        TclExprFloatError(interp, dResult);
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprBinaryFunc(
    ClientData clientData,      /* Contains the address of a function that
                                 * takes two double arguments and returns a
                                 * double result. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Parameter vector. */
{
    int code;
    double d1, d2;
    double (*func)(double, double) = (double (*)(double, double)) clientData;

    if (objc != 3) {
        MathFuncWrongNumArgs(interp, 3, objc, objv);
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
        d1 = objv[1]->internalRep.doubleValue;
        Tcl_ResetResult(interp);
        code = TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
    if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
        d2 = objv[2]->internalRep.doubleValue;
        Tcl_ResetResult(interp);
        code = TCL_OK;
    }
#endif
    if (code != TCL_OK) {
        return TCL_ERROR;
    }
    errno = 0;
    return CheckDoubleResult(interp, (*func)(d1, d2));
}

static int
ExprAbsFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Parameter vector. */
{
    ClientData ptr;
    int type;
    mp_int big;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }

    if (type == TCL_NUMBER_LONG) {
        long l = *((const long *) ptr);
        if (l <= (long)0) {
            if (l == LONG_MIN) {
                TclBNInitBignumFromLong(&big, l);
                goto tooLarge;
            }
            Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
        } else {
            Tcl_SetObjResult(interp, objv[1]);
        }
        return TCL_OK;
    }

    if (type == TCL_NUMBER_DOUBLE) {
        double d = *((const double *) ptr);
        if (d <= 0.0) {
            Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
        } else {
            Tcl_SetObjResult(interp, objv[1]);
        }
        return TCL_OK;
    }

#ifndef NO_WIDE_TYPE
    if (type == TCL_NUMBER_WIDE) {
        Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
        if (w < (Tcl_WideInt)0) {
            if (w == LLONG_MIN) {
                TclBNInitBignumFromWideInt(&big, w);
                goto tooLarge;
            }
            Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
        } else {
            Tcl_SetObjResult(interp, objv[1]);
        }
        return TCL_OK;
    }
#endif

    if (type == TCL_NUMBER_BIG) {
        /* TODO: const correctness ? */
        if (mp_cmp_d((mp_int *) ptr, 0) == MP_LT) {
            Tcl_GetBignumFromObj(NULL, objv[1], &big);
        tooLarge:
            mp_neg(&big, &big);
            Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
        } else {
            Tcl_SetObjResult(interp, objv[1]);
        }
        return TCL_OK;
    }

    if (type == TCL_NUMBER_NAN) {
#ifdef ACCEPT_NAN
        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
#else
        double d;
        Tcl_GetDoubleFromObj(interp, objv[1], &d);
        return TCL_ERROR;
#endif
    }
    return TCL_OK;
}

static int
ExprBoolFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    int value;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}

static int
ExprDoubleFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    double dResult;
    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
        if (objv[1]->typePtr == &tclDoubleType) {
            Tcl_SetObjResult(interp, objv[1]);
            return TCL_OK;
        }
#endif
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprEntierFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
        d = *((const double *) ptr);
        if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
            mp_int big;

            if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
                /* Infinity */
                return TCL_ERROR;
            }
            Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
            return TCL_OK;
        } else {
            long result = (long) d;

            Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
            return TCL_OK;
        }
    }

    if (type != TCL_NUMBER_NAN) {
        /*
         * All integers are already of integer type.
         */

        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }

    /*
     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprIntFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    long iResult;
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
        return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
        /*
         * Truncate the bignum; keep only bits in long range.
         */

        mp_int big;

        Tcl_GetBignumFromObj(NULL, objPtr, &big);
        mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
        objPtr = Tcl_NewBignumObj(&big);
        Tcl_IncrRefCount(objPtr);
        TclGetLongFromObj(NULL, objPtr, &iResult);
        Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
    return TCL_OK;
}

static int
ExprWideFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    Tcl_WideInt wResult;
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
        return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
        /*
         * Truncate the bignum; keep only bits in wide int range.
         */

        mp_int big;

        Tcl_GetBignumFromObj(NULL, objPtr, &big);
        mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
        objPtr = Tcl_NewBignumObj(&big);
        Tcl_IncrRefCount(objPtr);
        Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
        Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

static int
ExprRandFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    double dResult;
    long tmp;                   /* Algorithm assumes at least 32 bits. Only
                                 * long guarantees that. See below. */
    Tcl_Obj *oResult;

    if (objc != 1) {
        MathFuncWrongNumArgs(interp, 1, objc, objv);
        return TCL_ERROR;
    }

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
        iPtr->flags |= RAND_SEED_INITIALIZED;

        /*
         * Take into consideration the thread this interp is running in order
         * to insure different seeds in different threads (bug #416643)
         */

        iPtr->randSeed = TclpGetClicks() + ((long)Tcl_GetCurrentThread()<<12);

        /*
         * Make sure 1 <= randSeed <= (2^31) - 2. See below.
         */

        iPtr->randSeed &= (unsigned long) 0x7fffffff;
        if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
            iPtr->randSeed ^= 123459876;
        }
    }

    /*
     * Generate the random number using the linear congruential generator
     * defined by the following recurrence:
     *          seed = ( IA * seed ) mod IM
     * where IA is 16807 and IM is (2^31) - 1. The recurrence maps a seed in
     * the range [1, IM - 1] to a new seed in that same range. The recurrence
     * maps IM to 0, and maps 0 back to 0, so those two values must not be
     * allowed as initial values of seed.
     *
     * In order to avoid potential problems with integer overflow, the
     * recurrence is implemented in terms of additional constants IQ and IR
     * such that
     *          IM = IA*IQ + IR
     * None of the operations in the implementation overflows a 32-bit signed
     * integer, and the C type long is guaranteed to be at least 32 bits wide.
     *
     * For more details on how this algorithm works, refer to the following
     * papers:
     *
     *  S.K. Park & K.W. Miller, "Random number generators: good ones are hard
     *  to find," Comm ACM 31(10):1192-1201, Oct 1988
     *
     *  W.H. Press & S.A. Teukolsky, "Portable random number generators,"
     *  Computers in Physics 6(5):522-524, Sep/Oct 1992.
     */

#define RAND_IA         16807
#define RAND_IM         2147483647
#define RAND_IQ         127773
#define RAND_IR         2836
#define RAND_MASK       123459876

    tmp = iPtr->randSeed/RAND_IQ;
    iPtr->randSeed = RAND_IA*(iPtr->randSeed - tmp*RAND_IQ) - RAND_IR*tmp;
    if (iPtr->randSeed < 0) {
        iPtr->randSeed += RAND_IM;
    }

    /*
     * Since the recurrence keeps seed values in the range [1, RAND_IM - 1],
     * dividing by RAND_IM yields a double in the range (0, 1).
     */

    dResult = iPtr->randSeed * (1.0/RAND_IM);

    /*
     * Push a Tcl object with the result.
     */

    TclNewDoubleObj(oResult, dResult);
    Tcl_SetObjResult(interp, oResult);
    return TCL_OK;
}

static int
ExprRoundFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Parameter vector. */
{
    double d;
    ClientData ptr;
    int type;

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 1, objc, objv);
        return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
        double fractPart, intPart;
        long max = LONG_MAX, min = LONG_MIN;

        fractPart = modf(*((const double *) ptr), &intPart);
        if (fractPart <= -0.5) {
            min++;
        } else if (fractPart >= 0.5) {
            max--;
        }
        if ((intPart >= (double)max) || (intPart <= (double)min)) {
            mp_int big;

            if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) {
                /* Infinity */
                return TCL_ERROR;
            }
            if (fractPart <= -0.5) {
                mp_sub_d(&big, 1, &big);
            } else if (fractPart >= 0.5) {
                mp_add_d(&big, 1, &big);
            }
            Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
            return TCL_OK;
        } else {
            long result = (long)intPart;

            if (fractPart <= -0.5) {
                result--;
            } else if (fractPart >= 0.5) {
                result++;
            }
            Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
            return TCL_OK;
        }
    }

    if (type != TCL_NUMBER_NAN) {
        /*
         * All integers are already rounded
         */

        Tcl_SetObjResult(interp, objv[1]);
        return TCL_OK;
    }

    /*
     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprSrandFunc(
    ClientData clientData,      /* Ignored. */
    Tcl_Interp *interp,         /* The interpreter in which to execute the
                                 * function. */
    int objc,                   /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    long i = 0;                 /* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
        MathFuncWrongNumArgs(interp, 2, objc, objv);
        return TCL_ERROR;
    }

    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
        Tcl_Obj *objPtr;
        mp_int big;

        if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
            /* TODO: more ::errorInfo here? or in caller? */
            return TCL_ERROR;
        }

        mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
        objPtr = Tcl_NewBignumObj(&big);
        Tcl_IncrRefCount(objPtr);
        TclGetLongFromObj(NULL, objPtr, &i);
        Tcl_DecrRefCount(objPtr);
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc() for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = i;
    iPtr->randSeed &= (unsigned long) 0x7fffffff;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
        iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function
     * will always succeed.
     */

    return ExprRandFunc(clientData, interp, 1, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * MathFuncWrongNumArgs --
 *
 *      Generate an error message when a math function presents the wrong
 *      number of arguments.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      An error message is stored in the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static void
MathFuncWrongNumArgs(
    Tcl_Interp *interp,         /* Tcl interpreter */
    int expected,               /* Formal parameter count. */
    int found,                  /* Actual parameter count. */
    Tcl_Obj *const *objv)       /* Actual parameter vector. */
{
    const char *name = Tcl_GetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
        --tail;
        if (*tail == ':' && tail[-1] == ':') {
            name = tail+1;
            break;
        }
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "too %s arguments for math function \"%s\"",
            (found < expected ? "few" : "many"), name));
}
#ifdef USE_DTRACE

/*
 *----------------------------------------------------------------------
 *
 * DTraceObjCmd --
 *
 *      This function is invoked to process the "::tcl::dtrace" Tcl command.
 *
 * Results:
 *      A standard Tcl object result.
 *
 * Side effects:
 *      The 'tcl-probe' DTrace probe is triggered (if it is enabled).
 *
 *----------------------------------------------------------------------
 */

static int
DTraceObjCmd(
    ClientData dummy,           /* Not used. */
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
        char *a[10];
        int i = 0;

        while (i++ < 10) {
            a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
        }
        TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
                a[8], a[9]);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDTraceInfo --
 *
 *      Extract information from a TIP280 dict for use by DTrace probes.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
TclDTraceInfo(
    Tcl_Obj *info,
    char **args,
    int *argsi)
{
    static Tcl_Obj *keys[7] = { NULL };
    Tcl_Obj **k = keys, *val;
    int i;

    if (!*k) {
        TclNewLiteralStringObj(keys[0], "cmd");
        TclNewLiteralStringObj(keys[1], "type");
        TclNewLiteralStringObj(keys[2], "proc");
        TclNewLiteralStringObj(keys[3], "file");
        TclNewLiteralStringObj(keys[4], "lambda");
        TclNewLiteralStringObj(keys[5], "line");
        TclNewLiteralStringObj(keys[6], "level");
    }
    for (i = 0; i < 4; i++) {
        Tcl_DictObjGet(NULL, info, *k++, &val);
        args[i] = val ? TclGetString(val) : NULL;
    }
    if (!args[2]) {
        Tcl_DictObjGet(NULL, info, *k, &val);
        args[2] = val ? TclGetString(val) : NULL;
    }
    k++;
    for (i = 0; i < 2; i++) {
        Tcl_DictObjGet(NULL, info, *k++, &val);
        if (val) {
            TclGetIntFromObj(NULL, val, &(argsi[i]));
        } else {
            argsi[i] = 0;
        }
    }
}
#endif /* USE_DTRACE */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */