/[dtapublic]/projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclbasic.c

Diff of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclbasic.c

Parent Directory | Revision Log | View Patch Patch

-revision 66 by dashley,
Sun Oct 30 21:57:38 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tclBasic.c --
   *
   *      Contains the basic facilities for TCL command interpretation,
   *      including interpreter creation and deletion, command creation
   *      and deletion, and command parsing and 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.
   *
   * 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.1.1.1 2001/06/13 04:33:43 dtashley Exp $
   */
  #include "tclInt.h"
  #include "tclCompile.h"
  #ifndef TCL_GENERIC_ONLY
  #   include "tclPort.h"
  #endif
  /*
   * Static procedures in this file:
   */
  static void             DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
  static void             ProcessUnexpectedResult _ANSI_ARGS_((
                              Tcl_Interp *interp, int returnCode));
  static void             RecordTracebackInfo _ANSI_ARGS_((
                              Tcl_Interp *interp, Tcl_Obj *objPtr,
                              int numSrcBytes));
  extern TclStubs tclStubs;
  /*
   * The following structure defines the commands in the Tcl core.
   */
  typedef struct {
      char *name;                 /* Name of object-based command. */
      Tcl_CmdProc *proc;          /* String-based procedure for command. */
      Tcl_ObjCmdProc *objProc;    /* Object-based procedure for command. */
      CompileProc *compileProc;   /* Procedure 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 procedures that implement them:
   */
  static CmdInfo builtInCmds[] = {
      /*
       * Commands in the generic core. Note that at least one of the proc or
       * objProc members should be non-NULL. This avoids infinitely recursive
       * calls between TclInvokeObjectCommand and TclInvokeStringCommand if a
       * command name is computed at runtime and results in the name of a
       * compiled command.
       */
      {"append",          (Tcl_CmdProc *) NULL,   Tcl_AppendObjCmd,
          (CompileProc *) NULL,           1},
      {"array",           (Tcl_CmdProc *) NULL,   Tcl_ArrayObjCmd,
          (CompileProc *) NULL,           1},
      {"binary",          (Tcl_CmdProc *) NULL,   Tcl_BinaryObjCmd,
          (CompileProc *) NULL,           1},
      {"break",           (Tcl_CmdProc *) NULL,   Tcl_BreakObjCmd,
          TclCompileBreakCmd,             1},
      {"case",            (Tcl_CmdProc *) NULL,   Tcl_CaseObjCmd,
          (CompileProc *) NULL,           1},
      {"catch",           (Tcl_CmdProc *) NULL,   Tcl_CatchObjCmd,
          TclCompileCatchCmd,             1},
      {"clock",           (Tcl_CmdProc *) NULL,   Tcl_ClockObjCmd,
          (CompileProc *) NULL,           1},
      {"concat",          (Tcl_CmdProc *) NULL,   Tcl_ConcatObjCmd,
          (CompileProc *) NULL,           1},
      {"continue",        (Tcl_CmdProc *) NULL,   Tcl_ContinueObjCmd,
          TclCompileContinueCmd,          1},
      {"encoding",        (Tcl_CmdProc *) NULL,   Tcl_EncodingObjCmd,
          (CompileProc *) NULL,           0},
      {"error",           (Tcl_CmdProc *) NULL,   Tcl_ErrorObjCmd,
          (CompileProc *) NULL,           1},
      {"eval",            (Tcl_CmdProc *) NULL,   Tcl_EvalObjCmd,
          (CompileProc *) NULL,           1},
      {"exit",            (Tcl_CmdProc *) NULL,   Tcl_ExitObjCmd,
          (CompileProc *) NULL,           0},
      {"expr",            (Tcl_CmdProc *) NULL,   Tcl_ExprObjCmd,
          TclCompileExprCmd,              1},
      {"fcopy",           (Tcl_CmdProc *) NULL,   Tcl_FcopyObjCmd,
          (CompileProc *) NULL,           1},
      {"fileevent",       (Tcl_CmdProc *) NULL,   Tcl_FileEventObjCmd,
          (CompileProc *) NULL,           1},
      {"for",             (Tcl_CmdProc *) NULL,   Tcl_ForObjCmd,
          TclCompileForCmd,               1},
      {"foreach",         (Tcl_CmdProc *) NULL,   Tcl_ForeachObjCmd,
          TclCompileForeachCmd,           1},
      {"format",          (Tcl_CmdProc *) NULL,   Tcl_FormatObjCmd,
          (CompileProc *) NULL,           1},
      {"global",          (Tcl_CmdProc *) NULL,   Tcl_GlobalObjCmd,
          (CompileProc *) NULL,           1},
      {"if",              (Tcl_CmdProc *) NULL,   Tcl_IfObjCmd,
          TclCompileIfCmd,                1},
      {"incr",            (Tcl_CmdProc *) NULL,   Tcl_IncrObjCmd,
          TclCompileIncrCmd,              1},
      {"info",            (Tcl_CmdProc *) NULL,   Tcl_InfoObjCmd,
          (CompileProc *) NULL,           1},
      {"join",            (Tcl_CmdProc *) NULL,   Tcl_JoinObjCmd,
          (CompileProc *) NULL,           1},
      {"lappend",         (Tcl_CmdProc *) NULL,   Tcl_LappendObjCmd,
          (CompileProc *) NULL,           1},
      {"lindex",          (Tcl_CmdProc *) NULL,   Tcl_LindexObjCmd,
          (CompileProc *) NULL,           1},
      {"linsert",         (Tcl_CmdProc *) NULL,   Tcl_LinsertObjCmd,
          (CompileProc *) NULL,           1},
      {"list",            (Tcl_CmdProc *) NULL,   Tcl_ListObjCmd,
          (CompileProc *) NULL,           1},
      {"llength",         (Tcl_CmdProc *) NULL,   Tcl_LlengthObjCmd,
          (CompileProc *) NULL,           1},
      {"load",            (Tcl_CmdProc *) NULL,   Tcl_LoadObjCmd,
          (CompileProc *) NULL,           0},
      {"lrange",          (Tcl_CmdProc *) NULL,   Tcl_LrangeObjCmd,
          (CompileProc *) NULL,           1},
      {"lreplace",        (Tcl_CmdProc *) NULL,   Tcl_LreplaceObjCmd,
          (CompileProc *) NULL,           1},
      {"lsearch",         (Tcl_CmdProc *) NULL,   Tcl_LsearchObjCmd,
          (CompileProc *) NULL,           1},
      {"lsort",           (Tcl_CmdProc *) NULL,   Tcl_LsortObjCmd,
          (CompileProc *) NULL,           1},
      {"namespace",       (Tcl_CmdProc *) NULL,   Tcl_NamespaceObjCmd,
          (CompileProc *) NULL,           1},
      {"package",         (Tcl_CmdProc *) NULL,   Tcl_PackageObjCmd,
          (CompileProc *) NULL,           1},
      {"proc",            (Tcl_CmdProc *) NULL,   Tcl_ProcObjCmd,
          (CompileProc *) NULL,           1},
      {"regexp",          (Tcl_CmdProc *) NULL,   Tcl_RegexpObjCmd,
          (CompileProc *) NULL,           1},
      {"regsub",          (Tcl_CmdProc *) NULL,   Tcl_RegsubObjCmd,
          (CompileProc *) NULL,           1},
      {"rename",          (Tcl_CmdProc *) NULL,   Tcl_RenameObjCmd,
          (CompileProc *) NULL,           1},
      {"return",          (Tcl_CmdProc *) NULL,   Tcl_ReturnObjCmd,
          (CompileProc *) NULL,           1},
      {"scan",            (Tcl_CmdProc *) NULL,   Tcl_ScanObjCmd,
          (CompileProc *) NULL,           1},
      {"set",             (Tcl_CmdProc *) NULL,   Tcl_SetObjCmd,
          TclCompileSetCmd,               1},
      {"split",           (Tcl_CmdProc *) NULL,   Tcl_SplitObjCmd,
          (CompileProc *) NULL,           1},
      {"string",          (Tcl_CmdProc *) NULL,   Tcl_StringObjCmd,
          (CompileProc *) NULL,           1},
      {"subst",           (Tcl_CmdProc *) NULL,   Tcl_SubstObjCmd,
          (CompileProc *) NULL,           1},
      {"switch",          (Tcl_CmdProc *) NULL,   Tcl_SwitchObjCmd,
          (CompileProc *) NULL,           1},
      {"trace",           (Tcl_CmdProc *) NULL,   Tcl_TraceObjCmd,
          (CompileProc *) NULL,           1},
      {"unset",           (Tcl_CmdProc *) NULL,   Tcl_UnsetObjCmd,
          (CompileProc *) NULL,           1},
      {"uplevel",         (Tcl_CmdProc *) NULL,   Tcl_UplevelObjCmd,
          (CompileProc *) NULL,           1},
      {"upvar",           (Tcl_CmdProc *) NULL,   Tcl_UpvarObjCmd,
          (CompileProc *) NULL,           1},
      {"variable",        (Tcl_CmdProc *) NULL,   Tcl_VariableObjCmd,
          (CompileProc *) NULL,           1},
      {"while",           (Tcl_CmdProc *) NULL,   Tcl_WhileObjCmd,
          TclCompileWhileCmd,             1},
      /*
       * Commands in the UNIX core:
       */
  #ifndef TCL_GENERIC_ONLY
      {"after",           (Tcl_CmdProc *) NULL,   Tcl_AfterObjCmd,
          (CompileProc *) NULL,           1},
      {"cd",              (Tcl_CmdProc *) NULL,   Tcl_CdObjCmd,
          (CompileProc *) NULL,           0},
      {"close",           (Tcl_CmdProc *) NULL,   Tcl_CloseObjCmd,
          (CompileProc *) NULL,           1},
      {"eof",             (Tcl_CmdProc *) NULL,   Tcl_EofObjCmd,
          (CompileProc *) NULL,           1},
      {"fblocked",        (Tcl_CmdProc *) NULL,   Tcl_FblockedObjCmd,
          (CompileProc *) NULL,           1},
      {"fconfigure",      (Tcl_CmdProc *) NULL,   Tcl_FconfigureObjCmd,
          (CompileProc *) NULL,           0},
      {"file",            (Tcl_CmdProc *) NULL,   Tcl_FileObjCmd,
          (CompileProc *) NULL,           0},
      {"flush",           (Tcl_CmdProc *) NULL,   Tcl_FlushObjCmd,
          (CompileProc *) NULL,           1},
      {"gets",            (Tcl_CmdProc *) NULL,   Tcl_GetsObjCmd,
          (CompileProc *) NULL,           1},
      {"glob",            (Tcl_CmdProc *) NULL,   Tcl_GlobObjCmd,
          (CompileProc *) NULL,           0},
      {"open",            (Tcl_CmdProc *) NULL,   Tcl_OpenObjCmd,
          (CompileProc *) NULL,           0},
      {"pid",             (Tcl_CmdProc *) NULL,   Tcl_PidObjCmd,
          (CompileProc *) NULL,           1},
      {"puts",            (Tcl_CmdProc *) NULL,   Tcl_PutsObjCmd,
          (CompileProc *) NULL,           1},
      {"pwd",             (Tcl_CmdProc *) NULL,   Tcl_PwdObjCmd,
          (CompileProc *) NULL,           0},
      {"read",            (Tcl_CmdProc *) NULL,   Tcl_ReadObjCmd,
          (CompileProc *) NULL,           1},
      {"seek",            (Tcl_CmdProc *) NULL,   Tcl_SeekObjCmd,
          (CompileProc *) NULL,           1},
      {"socket",          (Tcl_CmdProc *) NULL,   Tcl_SocketObjCmd,
          (CompileProc *) NULL,           0},
      {"tell",            (Tcl_CmdProc *) NULL,   Tcl_TellObjCmd,
          (CompileProc *) NULL,           1},
      {"time",            (Tcl_CmdProc *) NULL,   Tcl_TimeObjCmd,
          (CompileProc *) NULL,           1},
      {"update",          (Tcl_CmdProc *) NULL,   Tcl_UpdateObjCmd,
          (CompileProc *) NULL,           1},
      {"vwait",           (Tcl_CmdProc *) NULL,   Tcl_VwaitObjCmd,
          (CompileProc *) NULL,           1},
  #ifdef MAC_TCL
      {"beep",            (Tcl_CmdProc *) NULL,   Tcl_BeepObjCmd,
          (CompileProc *) NULL,           0},
      {"echo",            Tcl_EchoCmd,            (Tcl_ObjCmdProc *) NULL,
          (CompileProc *) NULL,           0},
      {"ls",              (Tcl_CmdProc *) NULL,   Tcl_LsObjCmd,
          (CompileProc *) NULL,           0},
      {"resource",        (Tcl_CmdProc *) NULL,   Tcl_ResourceObjCmd,
          (CompileProc *) NULL,           1},
      {"source",          (Tcl_CmdProc *) NULL,   Tcl_MacSourceObjCmd,
          (CompileProc *) NULL,           0},
  #else
      {"exec",            (Tcl_CmdProc *) NULL,   Tcl_ExecObjCmd,
          (CompileProc *) NULL,           0},
      {"source",          (Tcl_CmdProc *) NULL,   Tcl_SourceObjCmd,
          (CompileProc *) NULL,           0},
  #endif /* MAC_TCL */
  #endif /* TCL_GENERIC_ONLY */
      {NULL,              (Tcl_CmdProc *) NULL,   (Tcl_ObjCmdProc *) NULL,
          (CompileProc *) NULL,           0}
  };
  /*
   *----------------------------------------------------------------------
   *
   * 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 procedures like Tcl_CreateCmd, Tcl_Eval, or
   *      Tcl_DeleteInterp.
   *
   * Side effects:
   *      The command interpreter is initialized with an empty variable
   *      table and the built-in commands.
   *
   *----------------------------------------------------------------------
   */
  Tcl_Interp *
  Tcl_CreateInterp()
  {
      Interp *iPtr;
      Tcl_Interp *interp;
      Command *cmdPtr;
      BuiltinFunc *builtinFuncPtr;
      MathFunc *mathFuncPtr;
      Tcl_HashEntry *hPtr;
      CmdInfo *cmdInfoPtr;
      int i;
      union {
          char c[sizeof(short)];
          short s;
      } order;
  #ifdef TCL_COMPILE_STATS
      ByteCodeStats *statsPtr;
  #endif /* TCL_COMPILE_STATS */
      TclInitSubsystems(NULL);
      /*
       * Panic if someone updated the CallFrame structure without
       * also updating the Tcl_CallFrame structure (or vice versa).
       */
      if (sizeof(Tcl_CallFrame) != sizeof(CallFrame)) {
          /*NOTREACHED*/
          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;
      Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
      iPtr->numLevels = 0;
      iPtr->maxNestingDepth = 1000;
      iPtr->framePtr = NULL;
      iPtr->varFramePtr = NULL;
      iPtr->activeTracePtr = NULL;
      iPtr->returnCode = TCL_OK;
      iPtr->errorInfo = NULL;
      iPtr->errorCode = NULL;
      iPtr->appendResult = NULL;
      iPtr->appendAvl = 0;
      iPtr->appendUsed = 0;
      Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
      iPtr->packageUnknown = NULL;
      iPtr->cmdCount = 0;
      iPtr->termOffset = 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->assocData = (Tcl_HashTable *) NULL;
      iPtr->execEnvPtr = NULL;          /* set after namespaces initialized */
      iPtr->emptyObjPtr = Tcl_NewObj(); /* another empty object */
      Tcl_IncrRefCount(iPtr->emptyObjPtr);
      iPtr->resultSpace[0] = 0;
      iPtr->globalNsPtr = NULL;   /* force creation of global ns below */
      iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
              (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
      if (iPtr->globalNsPtr == NULL) {
          panic("Tcl_CreateInterp: can't create global namespace");
      }
      /*
       * 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);
      /*
       * 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;
      /*
       * 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 procedure
       * that extracts strings, calls the string procedure, 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 new;
          Tcl_HashEntry *hPtr;
          if ((cmdInfoPtr->proc == (Tcl_CmdProc *) NULL)
                  && (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL)
                  && (cmdInfoPtr->compileProc == (CompileProc *) NULL)) {
              panic("Tcl_CreateInterp: builtin command with NULL string and object command procs and a NULL compile proc\n");
          }
          hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
                  cmdInfoPtr->name, &new);
          if (new) {
              cmdPtr = (Command *) ckalloc(sizeof(Command));
              cmdPtr->hPtr = hPtr;
              cmdPtr->nsPtr = iPtr->globalNsPtr;
              cmdPtr->refCount = 1;
              cmdPtr->cmdEpoch = 0;
              cmdPtr->compileProc = cmdInfoPtr->compileProc;
              if (cmdInfoPtr->proc == (Tcl_CmdProc *) NULL) {
                  cmdPtr->proc = TclInvokeObjectCommand;
                  cmdPtr->clientData = (ClientData) cmdPtr;
              } else {
                  cmdPtr->proc = cmdInfoPtr->proc;
                  cmdPtr->clientData = (ClientData) NULL;
              }
              if (cmdInfoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
                  cmdPtr->objProc = TclInvokeStringCommand;
                  cmdPtr->objClientData = (ClientData) cmdPtr;
              } else {
                  cmdPtr->objProc = cmdInfoPtr->objProc;
                  cmdPtr->objClientData = (ClientData) NULL;
              }
              cmdPtr->deleteProc = NULL;
              cmdPtr->deleteData = (ClientData) NULL;
              cmdPtr->deleted = 0;
              cmdPtr->importRefPtr = NULL;
              Tcl_SetHashValue(hPtr, cmdPtr);
          }
      }
      /*
       * Register the builtin math functions.
       */
      i = 0;
      for (builtinFuncPtr = builtinFuncTable;  builtinFuncPtr->name != NULL;
              builtinFuncPtr++) {
          Tcl_CreateMathFunc((Tcl_Interp *) iPtr, builtinFuncPtr->name,
                  builtinFuncPtr->numArgs, builtinFuncPtr->argTypes,
                  (Tcl_MathProc *) NULL, (ClientData) 0);
          hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
                  builtinFuncPtr->name);
          if (hPtr == NULL) {
              panic("Tcl_CreateInterp: Tcl_CreateMathFunc incorrectly registered '%s'", builtinFuncPtr->name);
              return NULL;
          }
          mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
          mathFuncPtr->builtinFuncIndex = i;
          i++;
      }
      iPtr->flags |= EXPR_INITIALIZED;
      /*
       * Do Multiple/Safe Interps Tcl init stuff
       */
      TclInterpInit(interp);
      /*
       * We used to create the "errorInfo" and "errorCode" global vars at this
       * point because so much of the Tcl implementation assumes they already
       * exist. This is not quite enough, however, since they can be unset
       * at any time.
       *
       * There are 2 choices:
       *    + Check every place where a GetVar of those is used
       *      and the NULL result is not checked (like in tclLoad.c)
       *    + Make SetVar,... NULL friendly
       * We choose the second option because :
       *    + It is easy and low cost to check for NULL pointer before
       *      calling strlen()
       *    + It can be helpfull to other people using those API
       *    + Passing a NULL value to those closest 'meaning' is empty string
       *      (specially with the new objects where 0 bytes strings are ok)
       * So the following init is commented out:              -- dl
       *
       * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorInfo", (char *) NULL,
       *       "", TCL_GLOBAL_ONLY);
       * (void) Tcl_SetVar2((Tcl_Interp *)iPtr, "errorCode", (char *) NULL,
       *       "NONE", TCL_GLOBAL_ONLY);
       */
  #ifndef TCL_GENERIC_ONLY
      TclSetupEnv(interp);
  #endif
      /*
       * 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);
      /*
       * 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", (char *) NULL,
              TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
              TclPrecTraceProc, (ClientData) 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.
       */
      Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
  #ifdef Tcl_InitStubs
  #undef Tcl_InitStubs
  #endif
      Tcl_InitStubs(interp, TCL_VERSION, 1);
      return interp;
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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(interp)
      Tcl_Interp *interp;         /* Hide commands in this interpreter. */
  {
      register CmdInfo *cmdInfoPtr;
      if (interp == (Tcl_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 procedure to be called before a given
   *      interpreter is deleted. The procedure is called as soon
   *      as Tcl_DeleteInterp is called; if Tcl_CallWhenDeleted is
   *      called on an interpreter that has already been deleted,
   *      the procedure 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(interp, proc, clientData)
      Tcl_Interp *interp;         /* Interpreter to watch. */
      Tcl_InterpDeleteProc *proc; /* Procedure to call when interpreter
                                   * is about to be deleted. */
      ClientData clientData;      /* One-word value to pass to proc. */
  {
      Interp *iPtr = (Interp *) interp;
      static int assocDataCounter = 0;
  #ifdef TCL_THREADS
      static Tcl_Mutex assocMutex;
  #endif
      int new;
      char buffer[32 + TCL_INTEGER_SPACE];
      AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
      Tcl_HashEntry *hPtr;
      Tcl_MutexLock(&assocMutex);
      sprintf(buffer, "Assoc Data Key #%d", assocDataCounter);
      assocDataCounter++;
      Tcl_MutexUnlock(&assocMutex);
      if (iPtr->assocData == (Tcl_HashTable *) NULL) {
          iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
          Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
      }
      hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
      dPtr->proc = proc;
      dPtr->clientData = clientData;
      Tcl_SetHashValue(hPtr, dPtr);
  }
  /*
   *--------------------------------------------------------------
   *
   * Tcl_DontCallWhenDeleted --
   *
   *      Cancel the arrangement for a procedure 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(interp, proc, clientData)
      Tcl_Interp *interp;         /* Interpreter to watch. */
      Tcl_InterpDeleteProc *proc; /* Procedure 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 == (Tcl_HashTable *) 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(interp, name, proc, clientData)
      Tcl_Interp *interp;         /* Interpreter to associate with. */
      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 new;
      if (iPtr->assocData == (Tcl_HashTable *) NULL) {
          iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
          Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
      }
      hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
      if (new == 0) {
          dPtr = (AssocData *) 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(interp, name)
      Tcl_Interp *interp;                 /* Interpreter to associate with. */
      char *name;                         /* Name of association. */
  {
      Interp *iPtr = (Interp *) interp;
      AssocData *dPtr;
      Tcl_HashEntry *hPtr;
      if (iPtr->assocData == (Tcl_HashTable *) NULL) {
          return;
      }
      hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
      if (hPtr == (Tcl_HashEntry *) NULL) {
          return;
      }
      dPtr = (AssocData *) 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(interp, name, procPtr)
      Tcl_Interp *interp;                 /* Interpreter associated with. */
      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 == (Tcl_HashTable *) NULL) {
          return (ClientData) NULL;
      }
      hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
      if (hPtr == (Tcl_HashEntry *) NULL) {
          return (ClientData) NULL;
      }
      dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
      if (procPtr != (Tcl_InterpDeleteProc **) 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(interp)
      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 procedure 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(interp)
      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.
       */
      iPtr->flags |= DELETED;
      /*
       * Ensure that the interpreter is eventually deleted.
       */
      Tcl_EventuallyFree((ClientData) interp,
              (Tcl_FreeProc *) DeleteInterpProc);
  }
  /*
   *----------------------------------------------------------------------
   *
   * DeleteInterpProc --
   *
   *      Helper procedure to delete an interpreter. This procedure is
   *      called when the last call to Tcl_Preserve on this interpreter
   *      is matched by a call to Tcl_Release. The procedure 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(interp)
      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) {
          panic("DeleteInterpProc called with active evals");
      }
      /*
       * The interpreter should already be marked deleted; otherwise how
       * did we get here?
       */
      if (!(iPtr->flags & DELETED)) {
          panic("DeleteInterpProc called on interpreter not marked deleted");
      }
      TclHandleFree(iPtr->handle);
      /*
       * Dismantle everything in the global namespace except for the
       * "errorInfo" and "errorCode" variables. These remain until the
       * namespace is actually destroyed, in case any errors occur.
       *
       * Dismantle the namespace here, before we clear the assocData. If any
       * background errors occur here, they will be deleted below.
       */
      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);
      }
      /*
       * Tear down the math function table.
       */
      for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
               hPtr != NULL;
               hPtr = Tcl_NextHashEntry(&search)) {
          ckfree((char *) Tcl_GetHashValue(hPtr));
      }
      Tcl_DeleteHashTable(&iPtr->mathFuncTable);
      /*
       * Invoke deletion callbacks; note that a callback can create new
       * callbacks, so we iterate.
       */
      while (iPtr->assocData != (Tcl_HashTable *) NULL) {
          AssocData *dPtr;
          hTablePtr = iPtr->assocData;
          iPtr->assocData = (Tcl_HashTable *) NULL;
          for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
                   hPtr != NULL;
                   hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
              dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
              Tcl_DeleteHashEntry(hPtr);
              if (dPtr->proc != NULL) {
                  (*dPtr->proc)(dPtr->clientData, interp);
              }
              ckfree((char *) dPtr);
          }
          Tcl_DeleteHashTable(hTablePtr);
          ckfree((char *) hTablePtr);
      }
      /*
       * Finish deleting the global namespace.
       */
      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;
      if (iPtr->errorInfo != NULL) {
          ckfree(iPtr->errorInfo);
          iPtr->errorInfo = NULL;
      }
      if (iPtr->errorCode != NULL) {
          ckfree(iPtr->errorCode);
          iPtr->errorCode = NULL;
      }
      if (iPtr->appendResult != NULL) {
          ckfree(iPtr->appendResult);
          iPtr->appendResult = NULL;
      }
      TclFreePackageInfo(iPtr);
      while (iPtr->tracePtr != NULL) {
          Trace *nextPtr = iPtr->tracePtr->nextPtr;
          ckfree((char *) iPtr->tracePtr);
          iPtr->tracePtr = nextPtr;
      }
      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));
      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(interp, cmdName, hiddenCmdToken)
      Tcl_Interp *interp;         /* Interpreter in which to hide command. */
      char *cmdName;              /* Name of command to hide. */
      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 new;
      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_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "cannot use namespace qualifiers as hidden command",
                  "token (rename)", (char *) 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, (Tcl_Namespace *) 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_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "can only hide global namespace commands",
                  " (use rename then hide)", (char *) 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, &new);
      if (!new) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "hidden command named \"", hiddenCmdToken, "\" already exists",
                  (char *) 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 untill 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 = (Tcl_HashEntry *) NULL;
          cmdPtr->cmdEpoch++;
      }
      /*
       * Now link the hash table entry with the command structure.
       * We ensured above that the nsPtr was right.
       */
      cmdPtr->hPtr = hPtr;
      Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
      /*
       * If the command being hidden has a compile procedure, 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(interp, hiddenCmdToken, cmdName)
      Tcl_Interp *interp;         /* Interpreter in which to make command
                                   * callable. */
      char *hiddenCmdToken;       /* Name of hidden command. */
      char *cmdName;              /* Name of to-be-exposed command. */
  {
      Interp *iPtr = (Interp *) interp;
      Command *cmdPtr;
      Namespace *nsPtr;
      Tcl_HashEntry *hPtr;
      Tcl_HashTable *hiddenCmdTablePtr;
      int new;
      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_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "can not expose to a namespace ",
                  "(use expose to toplevel, then rename)",
                   (char *) 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 == (Tcl_HashEntry *) NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "unknown hidden command \"", hiddenCmdToken,
                  "\"", (char *) NULL);
          return TCL_ERROR;
      }
      cmdPtr = (Command *) 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 panic() than 'nicely' erroring out ?
           */
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "trying to expose a non global command name space command",
                  (char *) 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, &new);
      if (!new) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                  "exposed command \"", cmdName,
                  "\" already exists", (char *) NULL);
          return TCL_ERROR;
      }
      /*
       * 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, (ClientData) 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 procedure, 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(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;         /* Token for command interpreter returned by
                                   * a previous call to Tcl_CreateInterp. */
      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;          /* Procedure to associate with cmdName. */
      ClientData clientData;      /* Arbitrary value passed to string proc. */
      Tcl_CmdDeleteProc *deleteProc;
                                  /* If not NULL, gives a procedure to call
                                   * when this command is deleted. */
  {
      Interp *iPtr = (Interp *) interp;
      ImportRef *oldRefPtr = NULL;
      Namespace *nsPtr, *dummy1, *dummy2;
      Command *cmdPtr, *refCmdPtr;
      Tcl_HashEntry *hPtr;
      char *tail;
      int new;
      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, (Namespace *) NULL,
             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, &new);
      if (!new) {
          /*
           * 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 = (Command *) Tcl_GetHashValue(hPtr);
          oldRefPtr = cmdPtr->importRefPtr;
          cmdPtr->importRefPtr = NULL;
          Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
          hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
          if (!new) {
              /*
               * 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));
          }
      }
      cmdPtr = (Command *) ckalloc(sizeof(Command));
      Tcl_SetHashValue(hPtr, cmdPtr);
      cmdPtr->hPtr = hPtr;
      cmdPtr->nsPtr = nsPtr;
      cmdPtr->refCount = 1;
      cmdPtr->cmdEpoch = 0;
      cmdPtr->compileProc = (CompileProc *) NULL;
      cmdPtr->objProc = TclInvokeStringCommand;
      cmdPtr->objClientData = (ClientData) cmdPtr;
      cmdPtr->proc = proc;
      cmdPtr->clientData = clientData;
      cmdPtr->deleteProc = deleteProc;
      cmdPtr->deleteData = clientData;
      cmdPtr->deleted = 0;
      cmdPtr->importRefPtr = 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 = (ImportedCmdData*)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(interp, cmdName, proc, clientData, deleteProc)
      Tcl_Interp *interp;         /* Token for command interpreter (returned
                                   * by previous call to Tcl_CreateInterp). */
      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 procedure to associate with
                                   * name. */
      ClientData clientData;      /* Arbitrary value to pass to object
                                   * procedure. */
      Tcl_CmdDeleteProc *deleteProc;
                                  /* If not NULL, gives a procedure to call
                                   * when this command is deleted. */
  {
      Interp *iPtr = (Interp *) interp;
      ImportRef *oldRefPtr = NULL;
      Namespace *nsPtr, *dummy1, *dummy2;
      Command *cmdPtr, *refCmdPtr;
      Tcl_HashEntry *hPtr;
      char *tail;
      int new;
      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, (Namespace *) NULL,
             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, &new);
      if (!new) {
          cmdPtr = (Command *) 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, &new);
          if (!new) {
              /*
               * 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));
          }
      }
      cmdPtr = (Command *) ckalloc(sizeof(Command));
      Tcl_SetHashValue(hPtr, cmdPtr);
      cmdPtr->hPtr = hPtr;
      cmdPtr->nsPtr = nsPtr;
      cmdPtr->refCount = 1;
      cmdPtr->cmdEpoch = 0;
      cmdPtr->compileProc = (CompileProc *) NULL;
      cmdPtr->objProc = proc;
      cmdPtr->objClientData = clientData;
      cmdPtr->proc = TclInvokeObjectCommand;
      cmdPtr->clientData = (ClientData) cmdPtr;
      cmdPtr->deleteProc = deleteProc;
      cmdPtr->deleteData = clientData;
      cmdPtr->deleted = 0;
      cmdPtr->importRefPtr = 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 = (ImportedCmdData*)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 procedure exists for a command. A
   *      pointer to this procedure 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, interp, objc, objv)
      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. */
  {
      register Command *cmdPtr = (Command *) clientData;
      register int i;
      int result;
      /*
       * This procedure generates an argv array for the string arguments. It
       * starts out with stack-allocated space but uses dynamically-allocated
       * storage if needed.
       */
  #define NUM_ARGS 20
      char *(argStorage[NUM_ARGS]);
      char **argv = argStorage;
      /*
       * Create the string argument array "argv". Make sure argv is large
       * enough to hold the objc arguments plus 1 extra for the zero
       * end-of-argv word.
       */
      if ((objc + 1) > NUM_ARGS) {
          argv = (char **) ckalloc((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);
      /*
       * Free the argv array if malloc'ed storage was used.
       */
      if (argv != argStorage) {
          ckfree((char *) argv);
      }
      return result;
  #undef NUM_ARGS
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclInvokeObjectCommand --
   *
   *      "Wrapper" Tcl_CmdProc used to call an existing object-based
   *      Tcl_ObjCmdProc if no string-based procedure exists for a command.
   *      A pointer to this procedure 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, interp, argc, argv)
      ClientData clientData;      /* Points to command's Command structure. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int argc;                   /* Number of arguments. */
      register char **argv;       /* Argument strings. */
  {
      Command *cmdPtr = (Command *) clientData;
      register Tcl_Obj *objPtr;
      register int i;
      int length, result;
      /*
       * This procedure generates an objv array for object arguments that hold
       * the argv strings. It starts out with stack-allocated space but uses
       * dynamically-allocated storage if needed.
       */
  #define NUM_ARGS 20
      Tcl_Obj *(argStorage[NUM_ARGS]);
      register Tcl_Obj **objv = argStorage;
      /*
       * Create the object argument array "objv". Make sure objv is large
       * enough to hold the objc arguments plus 1 extra for the zero
       * end-of-objv word.
       */
      if ((argc + 1) > NUM_ARGS) {
          objv = (Tcl_Obj **)
              ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
      }
      for (i = 0;  i < argc;  i++) {
          length = strlen(argv[i]);
          TclNewObj(objPtr);
          TclInitStringRep(objPtr, argv[i], length);
          Tcl_IncrRefCount(objPtr);
          objv[i] = objPtr;
      }
      objv[argc] = 0;
      /*
       * 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.
       */
      Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
              TCL_VOLATILE);
      /*
       * 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);
      }
      if (objv != argStorage) {
          ckfree((char *) objv);
      }
      return result;
  #undef NUM_ARGS
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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(interp, oldName, newName)
      Tcl_Interp *interp;                 /* Current interpreter. */
      char *oldName;                      /* Existing command name. */
      char *newName;                      /* New command name. */
  {
      Interp *iPtr = (Interp *) interp;
      char *newTail;
      Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;
      Tcl_Command cmd;
      Command *cmdPtr;
      Tcl_HashEntry *hPtr, *oldHPtr;
      int new, result;
      /*
       * Find the existing command. An error is returned if cmdName can't
       * be found.
       */
      cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
          /*flags*/ 0);
      cmdPtr = (Command *) cmd;
      if (cmdPtr == NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ",
                  ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
                  " \"", oldName, "\": command doesn't exist", (char *) NULL);
          return TCL_ERROR;
      }
      cmdNsPtr = cmdPtr->nsPtr;
      /*
       * 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);
          return TCL_OK;
      }
      /*
       * 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, (Namespace *) NULL,
         CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
      if ((newNsPtr == NULL) || (newTail == NULL)) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                   "can't rename to \"", newName, "\": bad command name",
                   (char *) NULL);
          return TCL_ERROR;
      }
      if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
          Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                   "can't rename to \"", newName,
                   "\": command already exists", (char *) NULL);
          return TCL_ERROR;
      }
      /*
       * 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, &new);
      Tcl_SetHashValue(hPtr, (ClientData) 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;
          return result;
      }
      /*
       * 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 procedure, 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++;
      }
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_SetCommandInfo --
   *
   *      Modifies various information about a Tcl command. Note that
   *      this procedure will not change a command's namespace; use
   *      Tcl_RenameCommand 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(interp, cmdName, infoPtr)
      Tcl_Interp *interp;                 /* Interpreter in which to look
                                           * for command. */
      char *cmdName;                      /* Name of desired command. */
      Tcl_CmdInfo *infoPtr;               /* Where to find information
                                           * to store in the command. */
  {
      Tcl_Command cmd;
      Command *cmdPtr;
      cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
              /*flags*/ 0);
      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 == (Tcl_ObjCmdProc *) NULL) {
          cmdPtr->objProc = TclInvokeStringCommand;
          cmdPtr->objClientData = (ClientData) 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(interp, cmdName, infoPtr)
      Tcl_Interp *interp;                 /* Interpreter in which to look
                                           * for command. */
      char *cmdName;                      /* Name of desired command. */
      Tcl_CmdInfo *infoPtr;               /* Where to store information about
                                           * command. */
  {
      Tcl_Command cmd;
      Command *cmdPtr;
      cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
              /*flags*/ 0);
      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 procedure
   *      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.
   *
   *----------------------------------------------------------------------
   */
  char *
  Tcl_GetCommandName(interp, command)
      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 procedure 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(interp, command, objPtr)
      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(interp, cmdName)
      Tcl_Interp *interp;         /* Token for command interpreter (returned
                                   * by a previous Tcl_CreateInterp call). */
      char *cmdName;              /* Name of command to remove. */
  {
      Tcl_Command cmd;
      /*
       *  Find the desired command and delete it.
       */
      cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) 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 procedure
   *      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(interp, cmd)
      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;
      /*
       * 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->deleted) {
          /*
           * Another deletion is already in progress.  Remove the hash
           * table entry now, but don't invoke a callback or free the
           * command structure.
           */
          Tcl_DeleteHashEntry(cmdPtr->hPtr);
          cmdPtr->hPtr = NULL;
          return 0;
      }
      /*
       * If the command being deleted has a compile procedure, 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++;
      }
      cmdPtr->deleted = 1;
      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);
      }
      /*
       * Bump the command epoch counter. This will invalidate all cached
       * references that point to this command.
       */
      cmdPtr->cmdEpoch++;
      /*
       * 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);
      }
      /*
       * 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).
       */
      TclCleanupCommand(cmdPtr);
      return 0;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclCleanupCommand --
   *
   *      This procedure 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(cmdPtr)
      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 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(interp, name, numArgs, argTypes, proc, clientData)
      Tcl_Interp *interp;                 /* Interpreter in which function is
                                           * to be available. */
      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;                 /* Procedure that implements the
                                           * math function. */
      ClientData clientData;              /* Additional value to pass to the
                                           * function. */
  {
      Interp *iPtr = (Interp *) interp;
      Tcl_HashEntry *hPtr;
      MathFunc *mathFuncPtr;
      int new, i;
      hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
      if (new) {
          Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
      }
      mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
      if (!new) {
          if (mathFuncPtr->builtinFuncIndex >= 0) {
              /*
               * We are redefining a builtin math function. Invalidate the
               * interpreter's existing code by incrementing its
               * compileEpoch member. This field is checked in Tcl_EvalObj
               * and ObjInterpProc, and code whose compilation epoch doesn't
               * match is recompiled. Newly compiled code will no longer
               * treat the function as builtin.
               */
              iPtr->compileEpoch++;
          } else {
              /*
               * A non-builtin function is being redefined. We must invalidate
               * existing code if the number of arguments has changed. This
               * is because existing code was compiled assuming that number.
               */
              if (numArgs != mathFuncPtr->numArgs) {
                  iPtr->compileEpoch++;
              }
          }
      }
      mathFuncPtr->builtinFuncIndex = -1; /* can't be a builtin function */
      if (numArgs > MAX_MATH_ARGS) {
          numArgs = MAX_MATH_ARGS;
      }
      mathFuncPtr->numArgs = numArgs;
      for (i = 0;  i < numArgs;  i++) {
          mathFuncPtr->argTypes[i] = argTypes[i];
      }
      mathFuncPtr->proc = proc;
      mathFuncPtr->clientData = clientData;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_EvalObjEx --
   *
   *      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.
   *
   *      Just as in Tcl_Eval, interp->termOffset is set to the offset of the
   *      last character executed in the objPtr's string.
   *
   *----------------------------------------------------------------------
   */
  int
  Tcl_EvalObjEx(interp, objPtr, flags)
      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. */
  {
      register Interp *iPtr = (Interp *) interp;
      int evalFlags;                      /* Interp->evalFlags value when the
                                           * procedure was called. */
      register ByteCode* codePtr;         /* Tcl Internal type of bytecode. */
      int oldCount = iPtr->cmdCount;      /* Used to tell whether any commands
                                           * at all were executed. */
      int numSrcBytes;
      int result;
      CallFrame *savedVarFramePtr;        /* Saves old copy of iPtr->varFramePtr
                                           * in case TCL_EVAL_GLOBAL was set. */
      Namespace *namespacePtr;
      Tcl_IncrRefCount(objPtr);
      if ((iPtr->flags & USE_EVAL_DIRECT) || (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.
           *
           * USE_EVAL_DIRECT is a special flag used for testing purpose only
           * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
           */
          if (!(iPtr->flags & USE_EVAL_DIRECT) &&
                  (objPtr->typePtr == &tclListType) && /* is a list... */
                  (objPtr->bytes == NULL) /* ...without a string rep */) {
              register List *listRepPtr =
                  (List *) objPtr->internalRep.otherValuePtr;
              result = Tcl_EvalObjv(interp, listRepPtr->elemCount,
                      listRepPtr->elements, flags);
          } else {
              register char *p;
              p = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
              result = Tcl_EvalEx(interp, p, numSrcBytes, flags);
          }
          Tcl_DecrRefCount(objPtr);
          return result;
      }
      /*
       * Prevent the object from being deleted as a side effect of evaling it.
       */
      savedVarFramePtr = iPtr->varFramePtr;
      if (flags & TCL_EVAL_GLOBAL) {
          iPtr->varFramePtr = NULL;
      }
      /*
       * Reset both the interpreter's string and object results and clear out
       * any error information. This makes sure that we return an empty
       * result if there are no commands in the command string.
       */
      Tcl_ResetResult(interp);
      /*
       * Check depth of nested calls to Tcl_Eval:  if this gets too large,
       * it's probably because of an infinite loop somewhere.
       */
      iPtr->numLevels++;
      if (iPtr->numLevels > iPtr->maxNestingDepth) {
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
          result = TCL_ERROR;
          goto done;
      }
      /*
       * On the Mac, we will never reach the default recursion limit before
       * blowing the stack. So we need to do a check here.
       */
      if (TclpCheckStackSpace() == 0) {
          /*NOTREACHED*/
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
          result = TCL_ERROR;
          goto done;
      }
      /*
       * If the interpreter has been deleted, return an error.
       */
      if (iPtr->flags & DELETED) {
          Tcl_ResetResult(interp);
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "attempt to call eval in deleted interpreter", -1);
          Tcl_SetErrorCode(interp, "CORE", "IDELETE",
                  "attempt to call eval in deleted interpreter",
                  (char *) NULL);
          result = TCL_ERROR;
          goto done;
      }
      /*
       * Get the ByteCode from the object. If it exists, make sure it hasn't
       * been invalidated by, e.g., someone redefining a command with a
       * compile procedure (this might make the compiled code wrong). If
       * necessary, convert the object to be a ByteCode object and compile it.
       * Also, if the code was compiled in/for a different interpreter,
       * or for a different namespace, or for the same namespace but
       * with different name resolution rules, we recompile it.
       *
       * Precompiled objects, however, are immutable and therefore
       * they are not recompiled, even if the epoch has changed.
       *
       * To be pedantically correct, we should also check that the
       * originating procPtr is the same as the current context procPtr
       * (assuming one exists at all - none for global level).  This
       * code is #def'ed out because [info body] was changed to never
       * return a bytecode type object, which should obviate us from
       * the extra checks here.
       */
      if (iPtr->varFramePtr != NULL) {
          namespacePtr = iPtr->varFramePtr->nsPtr;
      } else {
          namespacePtr = iPtr->globalNsPtr;
      }
      if (objPtr->typePtr == &tclByteCodeType) {
          codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
          if (((Interp *) *codePtr->interpHandle != iPtr)
                  || (codePtr->compileEpoch != iPtr->compileEpoch)
  #ifdef CHECK_PROC_ORIGINATION   /* [Bug: 3412 Pedantic] */
                  || (codePtr->procPtr != NULL && !(iPtr->varFramePtr &&
                          iPtr->varFramePtr->procPtr == codePtr->procPtr))
  #endif
                  || (codePtr->nsPtr != namespacePtr)
                  || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
              if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
                  if ((Interp *) *codePtr->interpHandle != iPtr) {
                      panic("Tcl_EvalObj: compiled script jumped interps");
                  }
                  codePtr->compileEpoch = iPtr->compileEpoch;
              } else {
                  tclByteCodeType.freeIntRepProc(objPtr);
              }
          }
      }
      if (objPtr->typePtr != &tclByteCodeType) {
          iPtr->errorLine = 1;
          result = tclByteCodeType.setFromAnyProc(interp, objPtr);
          if (result != TCL_OK) {
              goto done;
          }
      } else {
          codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
          if (((Interp *) *codePtr->interpHandle != iPtr)
                  || (codePtr->compileEpoch != iPtr->compileEpoch)) {
              (*tclByteCodeType.freeIntRepProc)(objPtr);
              iPtr->errorLine = 1;
              result = (*tclByteCodeType.setFromAnyProc)(interp, objPtr);
              if (result != TCL_OK) {
                  iPtr->numLevels--;
                  return result;
              }
          }
      }
      codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
      /*
       * Extract then reset the compilation flags in the interpreter.
       * Resetting the flags must be done after any compilation.
       */
      evalFlags = iPtr->evalFlags;
      iPtr->evalFlags = 0;
      /*
       * Execute the commands. If the code was compiled from an empty string,
       * don't bother executing the code.
       */
      numSrcBytes = codePtr->numSrcBytes;
      if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
          /*
           * Increment the code's ref count while it is being executed. If
           * afterwards no references to it remain, free the code.
           */
          codePtr->refCount++;
          result = TclExecuteByteCode(interp, codePtr);
          codePtr->refCount--;
          if (codePtr->refCount <= 0) {
              TclCleanupByteCode(codePtr);
          }
      } else {
          result = TCL_OK;
      }
      /*
       * If no commands at all were executed, check for asynchronous
       * handlers so that they at least get one change to execute.
       * This is needed to handle event loops written in Tcl with
       * empty bodies.
       */
      if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
          result = Tcl_AsyncInvoke(interp, result);
      }
      /*
       * Update the interpreter's evaluation level count. If we are again at
       * the top level, process any unusual return code returned by the
       * evaluated code.
       */
      if (iPtr->numLevels == 1) {
          if (result == TCL_RETURN) {
              result = TclUpdateReturnInfo(iPtr);
          }
          if ((result != TCL_OK) && (result != TCL_ERROR)
                  && ((evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
              ProcessUnexpectedResult(interp, result);
              result = TCL_ERROR;
          }
      }
      /*
       * If an error occurred, record information about what was being
       * executed when the error occurred.
       */
      if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
          RecordTracebackInfo(interp, objPtr, numSrcBytes);
      }
      /*
       * Set the interpreter's termOffset member to the offset of the
       * character just after the last one executed. We approximate the offset
       * of the last character executed by using the number of characters
       * compiled.
       */
      iPtr->termOffset = numSrcBytes;
      iPtr->flags &= ~ERR_ALREADY_LOGGED;
      done:
      TclDecrRefCount(objPtr);
      iPtr->varFramePtr = savedVarFramePtr;
      iPtr->numLevels--;
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * ProcessUnexpectedResult --
   *
   *      Procedure 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(interp, returnCode)
      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_AppendToObj(Tcl_GetObjResult(interp),
                  "invoked \"break\" outside of a loop", -1);
      } else if (returnCode == TCL_CONTINUE) {
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "invoked \"continue\" outside of a loop", -1);
      } else {
          char buf[30 + TCL_INTEGER_SPACE];
          sprintf(buf, "command returned bad code: %d", returnCode);
          Tcl_SetResult(interp, buf, TCL_VOLATILE);
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * RecordTracebackInfo --
   *
   *      Procedure called by Tcl_EvalObj to record information about what was
   *      being executed when the error occurred.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Appends information about the script being evaluated to the
   *      interpreter's "errorInfo" variable.
   *
   *----------------------------------------------------------------------
   */
  static void
  RecordTracebackInfo(interp, objPtr, numSrcBytes)
      Tcl_Interp *interp;         /* The interpreter in which the error
                                   * occurred. */
      Tcl_Obj *objPtr;            /* Points to object containing script whose
                                   * evaluation resulted in an error. */
      int numSrcBytes;            /* Number of bytes compiled in script. */
  {
      Interp *iPtr = (Interp *) interp;
      char buf[200];
      char *ellipsis, *bytes;
      int length;
      /*
       * Decide how much of the command to print in the error message
       * (up to a certain number of bytes).
       */
      bytes = Tcl_GetStringFromObj(objPtr, &length);
      length = TclMin(numSrcBytes, length);
      ellipsis = "";
      if (length > 150) {
          length = 150;
          ellipsis = " ...";
      }
      if (!(iPtr->flags & ERR_IN_PROGRESS)) {
          sprintf(buf, "\n    while executing\n\"%.*s%s\"",
                  length, bytes, ellipsis);
      } else {
          sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
                  length, bytes, ellipsis);
      }
      Tcl_AddObjErrorInfo(interp, buf, -1);
  }
  /*
   *---------------------------------------------------------------------------
   *
   * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
   *
   *      Procedures to evaluate an expression and return its value in a
   *      particular form.
   *
   * Results:
   *      Each of the procedures 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(interp, string, ptr)
      Tcl_Interp *interp;         /* Context in which to evaluate the
                                   * expression. */
      char *string;               /* Expression to evaluate. */
      long *ptr;                  /* Where to store result. */
  {
      register Tcl_Obj *exprPtr;
      Tcl_Obj *resultPtr;
      int length = strlen(string);
      int result = TCL_OK;
      if (length > 0) {
          exprPtr = Tcl_NewStringObj(string, length);
          Tcl_IncrRefCount(exprPtr);
          result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
          if (result == TCL_OK) {
              /*
               * Store an integer based on the expression result.
               */
              if (resultPtr->typePtr == &tclIntType) {
                  *ptr = resultPtr->internalRep.longValue;
              } else if (resultPtr->typePtr == &tclDoubleType) {
                  *ptr = (long) resultPtr->internalRep.doubleValue;
              } else {
                  Tcl_SetResult(interp,
                          "expression didn't have numeric value", TCL_STATIC);
                  result = TCL_ERROR;
              }
              Tcl_DecrRefCount(resultPtr);  /* discard the result object */
          } else {
              /*
               * Move the interpreter's object result to the string result,
               * then reset the object result.
               */
              Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
                      TCL_VOLATILE);
          }
          Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
      } else {
          /*
           * An empty string. Just set the result integer to 0.
           */
          *ptr = 0;
      }
      return result;
  }
  int
  Tcl_ExprDouble(interp, string, ptr)
      Tcl_Interp *interp;         /* Context in which to evaluate the
                                   * expression. */
      char *string;               /* Expression to evaluate. */
      double *ptr;                /* Where to store result. */
  {
      register Tcl_Obj *exprPtr;
      Tcl_Obj *resultPtr;
      int length = strlen(string);
      int result = TCL_OK;
      if (length > 0) {
          exprPtr = Tcl_NewStringObj(string, length);
          Tcl_IncrRefCount(exprPtr);
          result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
          if (result == TCL_OK) {
              /*
               * Store a double  based on the expression result.
               */
              if (resultPtr->typePtr == &tclIntType) {
                  *ptr = (double) resultPtr->internalRep.longValue;
              } else if (resultPtr->typePtr == &tclDoubleType) {
                  *ptr = resultPtr->internalRep.doubleValue;
              } else {
                  Tcl_SetResult(interp,
                          "expression didn't have numeric value", TCL_STATIC);
                  result = TCL_ERROR;
              }
              Tcl_DecrRefCount(resultPtr);  /* discard the result object */
          } else {
              /*
               * Move the interpreter's object result to the string result,
               * then reset the object result.
               */
              Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
                      TCL_VOLATILE);
          }
          Tcl_DecrRefCount(exprPtr);  /* discard the expression object */
      } else {
          /*
           * An empty string. Just set the result double to 0.0.
           */
          *ptr = 0.0;
      }
      return result;
  }
  int
  Tcl_ExprBoolean(interp, string, ptr)
      Tcl_Interp *interp;         /* Context in which to evaluate the
                                   * expression. */
      char *string;               /* Expression to evaluate. */
      int *ptr;                   /* Where to store 0/1 result. */
  {
      register Tcl_Obj *exprPtr;
      Tcl_Obj *resultPtr;
      int length = strlen(string);
      int result = TCL_OK;
      if (length > 0) {
          exprPtr = Tcl_NewStringObj(string, length);
          Tcl_IncrRefCount(exprPtr);
          result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
          if (result == TCL_OK) {
              /*
               * Store a boolean based on the expression result.
               */
              if (resultPtr->typePtr == &tclIntType) {
                  *ptr = (resultPtr->internalRep.longValue != 0);
              } else if (resultPtr->typePtr == &tclDoubleType) {
                  *ptr = (resultPtr->internalRep.doubleValue != 0.0);
              } else {
                  result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
              }
              Tcl_DecrRefCount(resultPtr);  /* discard the result object */
          }
          if (result != TCL_OK) {
              /*
               * Move the interpreter's object result to the string result,
               * then reset the object result.
               */
              Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
                      TCL_VOLATILE);
          }
          Tcl_DecrRefCount(exprPtr); /* discard the expression object */
      } else {
          /*
           * An empty string. Just set the result boolean to 0 (false).
           */
          *ptr = 0;
      }
      return result;
  }
  /*
   *--------------------------------------------------------------
   *
   * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
   *
   *      Procedures to evaluate an expression in an object and return its
   *      value in a particular form.
   *
   * Results:
   *      Each of the procedures 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(interp, objPtr, ptr)
      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;
      result = Tcl_ExprObj(interp, objPtr, &resultPtr);
      if (result == TCL_OK) {
          if (resultPtr->typePtr == &tclIntType) {
              *ptr = resultPtr->internalRep.longValue;
          } else if (resultPtr->typePtr == &tclDoubleType) {
              *ptr = (long) resultPtr->internalRep.doubleValue;
          } else {
              result = Tcl_GetLongFromObj(interp, resultPtr, ptr);
              if (result != TCL_OK) {
                  return result;
              }
          }
          Tcl_DecrRefCount(resultPtr);  /* discard the result object */
      }
      return result;
  }
  int
  Tcl_ExprDoubleObj(interp, objPtr, ptr)
      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;
      result = Tcl_ExprObj(interp, objPtr, &resultPtr);
      if (result == TCL_OK) {
          if (resultPtr->typePtr == &tclIntType) {
              *ptr = (double) resultPtr->internalRep.longValue;
          } else if (resultPtr->typePtr == &tclDoubleType) {
              *ptr = resultPtr->internalRep.doubleValue;
          } else {
              result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr);
              if (result != TCL_OK) {
                  return result;
              }
          }
          Tcl_DecrRefCount(resultPtr);  /* discard the result object */
      }
      return result;
  }
  int
  Tcl_ExprBooleanObj(interp, objPtr, ptr)
      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) {
          if (resultPtr->typePtr == &tclIntType) {
              *ptr = (resultPtr->internalRep.longValue != 0);
          } else if (resultPtr->typePtr == &tclDoubleType) {
              *ptr = (resultPtr->internalRep.doubleValue != 0.0);
          } else {
              result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
          }
          Tcl_DecrRefCount(resultPtr);  /* discard the result object */
      }
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclInvoke --
   *
   *      Invokes a Tcl command, given an argv/argc, from either the
   *      exposed or the hidden sets of commands in the given interpreter.
   *      NOTE: The command is invoked in the current stack frame of
   *      the interpreter, thus it can modify local variables.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      Whatever the command does.
   *
   *----------------------------------------------------------------------
   */
  int
  TclInvoke(interp, argc, argv, flags)
      Tcl_Interp *interp;         /* Where to invoke the command. */
      int argc;                   /* Count of args. */
      register char **argv;       /* The arg strings; argv[0] is the name of
                                   * the command to invoke. */
      int flags;                  /* Combination of flags controlling the
                                   * call: TCL_INVOKE_HIDDEN and
                                   * TCL_INVOKE_NO_UNKNOWN. */
  {
      register Tcl_Obj *objPtr;
      register int i;
      int length, result;
      /*
       * This procedure generates an objv array for object arguments that hold
       * the argv strings. It starts out with stack-allocated space but uses
       * dynamically-allocated storage if needed.
       */
  #define NUM_ARGS 20
      Tcl_Obj *(objStorage[NUM_ARGS]);
      register Tcl_Obj **objv = objStorage;
      /*
       * Create the object argument array "objv". Make sure objv is large
       * enough to hold the objc arguments plus 1 extra for the zero
       * end-of-objv word.
       */
      if ((argc + 1) > NUM_ARGS) {
          objv = (Tcl_Obj **)
              ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
      }
      for (i = 0;  i < argc;  i++) {
          length = strlen(argv[i]);
          objv[i] = Tcl_NewStringObj(argv[i], length);
          Tcl_IncrRefCount(objv[i]);
      }
      objv[argc] = 0;
      /*
       * Use TclObjInterpProc to actually invoke the command.
       */
      result = TclObjInvoke(interp, argc, objv, flags);
      /*
       * Move the interpreter's object result to the string result,
       * then reset the object result.
       */
      Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
              TCL_VOLATILE);
      /*
       * Decrement the ref counts on the objv elements since we are done
       * with them.
       */
      for (i = 0;  i < argc;  i++) {
          objPtr = objv[i];
          Tcl_DecrRefCount(objPtr);
      }
      /*
       * Free the objv array if malloc'ed storage was used.
       */
      if (objv != objStorage) {
          ckfree((char *) objv);
      }
      return result;
  #undef NUM_ARGS
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclGlobalInvoke --
   *
   *      Invokes a Tcl command, given an argv/argc, from either the
   *      exposed or hidden sets of commands in the given interpreter.
   *      NOTE: The command is invoked in the global stack frame of
   *      the interpreter, thus it cannot see any current state on
   *      the stack for that interpreter.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      Whatever the command does.
   *
   *----------------------------------------------------------------------
   */
  int
  TclGlobalInvoke(interp, argc, argv, flags)
      Tcl_Interp *interp;         /* Where to invoke the command. */
      int argc;                   /* Count of args. */
      register char **argv;       /* The arg strings; argv[0] is the name of
                                   * the command to invoke. */
      int flags;                  /* Combination of flags controlling the
                                   * call: TCL_INVOKE_HIDDEN and
                                   * TCL_INVOKE_NO_UNKNOWN. */
  {
      register Interp *iPtr = (Interp *) interp;
      int result;
      CallFrame *savedVarFramePtr;
      savedVarFramePtr = iPtr->varFramePtr;
      iPtr->varFramePtr = NULL;
      result = TclInvoke(interp, argc, argv, flags);
      iPtr->varFramePtr = savedVarFramePtr;
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TclObjInvokeGlobal --
   *
   *      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, 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
  TclObjInvokeGlobal(interp, objc, objv, flags)
      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;
      int result;
      CallFrame *savedVarFramePtr;
      savedVarFramePtr = iPtr->varFramePtr;
      iPtr->varFramePtr = NULL;
      result = TclObjInvoke(interp, objc, objv, flags);
      iPtr->varFramePtr = savedVarFramePtr;
      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(interp, objc, objv, flags)
      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]. */
      register Tcl_HashEntry *hPtr;
      Tcl_Command cmd;
      Command *cmdPtr;
      int localObjc;              /* Used to invoke "unknown" if the */
      Tcl_Obj **localObjv = NULL; /* command is not found. */
      register int i;
      int length, result;
      char *bytes;
      if (interp == (Tcl_Interp *) NULL) {
          return TCL_ERROR;
      }
      if ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
          Tcl_AppendToObj(Tcl_GetObjResult(interp),
                  "illegal argument vector", -1);
          return TCL_ERROR;
      }
      cmdName = Tcl_GetString(objv[0]);
      if (flags & TCL_INVOKE_HIDDEN) {
          /*
           * We never invoke "unknown" for hidden commands.
           */
          hPtr = NULL;
          hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr;
          if (hTblPtr != NULL) {
              hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
          }
          if (hPtr == NULL) {
              Tcl_ResetResult(interp);
              Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                       "invalid hidden command name \"", cmdName, "\"",
                       (char *) NULL);
              return TCL_ERROR;
          }
          cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
      } else {
          cmdPtr = NULL;
          cmd = Tcl_FindCommand(interp, cmdName,
                  (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
          if (cmd != (Tcl_Command) NULL) {
              cmdPtr = (Command *) cmd;
          }
          if (cmdPtr == NULL) {
              if (!(flags & TCL_INVOKE_NO_UNKNOWN)) {
                  cmd = Tcl_FindCommand(interp, "unknown",
                          (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
                  if (cmd != (Tcl_Command) NULL) {
                      cmdPtr = (Command *) cmd;
                  }
                  if (cmdPtr != NULL) {
                      localObjc = (objc + 1);
                      localObjv = (Tcl_Obj **)
                          ckalloc((unsigned) (sizeof(Tcl_Obj *) * localObjc));
                      localObjv[0] = Tcl_NewStringObj("unknown", -1);
                      Tcl_IncrRefCount(localObjv[0]);
                      for (i = 0;  i < objc;  i++) {
                          localObjv[i+1] = objv[i];
                      }
                      objc = localObjc;
                      objv = localObjv;
                  }
              }
              /*
               * Check again if we found the command. If not, "unknown" is
               * not present and we cannot help, or the caller said not to
               * call "unknown" (they specified TCL_INVOKE_NO_UNKNOWN).
               */
              if (cmdPtr == NULL) {
                  Tcl_ResetResult(interp);
                  Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                          "invalid command name \"",  cmdName, "\"",
                           (char *) NULL);
                  return TCL_ERROR;
              }
          }
      }
      /*
       * Invoke the command procedure. First reset the interpreter's string
       * and object results to their default empty values since they could
       * have gotten changed by earlier invocations.
       */
      Tcl_ResetResult(interp);
      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)) {
          Tcl_DString ds;
          Tcl_DStringInit(&ds);
          if (!(iPtr->flags & ERR_IN_PROGRESS)) {
              Tcl_DStringAppend(&ds, "\n    while invoking\n\"", -1);
          } else {
              Tcl_DStringAppend(&ds, "\n    invoked from within\n\"", -1);
          }
          for (i = 0;  i < objc;  i++) {
              bytes = Tcl_GetStringFromObj(objv[i], &length);
              Tcl_DStringAppend(&ds, bytes, length);
              if (i < (objc - 1)) {
                  Tcl_DStringAppend(&ds, " ", -1);
              } else if (Tcl_DStringLength(&ds) > 100) {
                  Tcl_DStringSetLength(&ds, 100);
                  Tcl_DStringAppend(&ds, "...", -1);
                  break;
              }
          }
          Tcl_DStringAppend(&ds, "\"", -1);
          Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&ds), -1);
          Tcl_DStringFree(&ds);
          iPtr->flags &= ~ERR_ALREADY_LOGGED;
      }
      /*
       * Free any locally allocated storage used to call "unknown".
       */
      if (localObjv != (Tcl_Obj **) NULL) {
          Tcl_DecrRefCount(localObjv[0]);
          ckfree((char *) localObjv);
      }
      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(interp, string)
      Tcl_Interp *interp;         /* Context in which to evaluate the
                                   * expression. */
      char *string;               /* Expression to evaluate. */
  {
      register Tcl_Obj *exprPtr;
      Tcl_Obj *resultPtr;
      int length = strlen(string);
      char buf[TCL_DOUBLE_SPACE];
      int result = TCL_OK;
      if (length > 0) {
          TclNewObj(exprPtr);
          TclInitStringRep(exprPtr, string, length);
          Tcl_IncrRefCount(exprPtr);
          result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
          if (result == TCL_OK) {
              /*
               * Set the interpreter's string result from the result object.
               */
              if (resultPtr->typePtr == &tclIntType) {
                  sprintf(buf, "%ld", resultPtr->internalRep.longValue);
                  Tcl_SetResult(interp, buf, TCL_VOLATILE);
              } else if (resultPtr->typePtr == &tclDoubleType) {
                  Tcl_PrintDouble((Tcl_Interp *) NULL,
                          resultPtr->internalRep.doubleValue, buf);
                  Tcl_SetResult(interp, buf, TCL_VOLATILE);
              } else {
                  /*
                   * Set interpreter's string result from the result object.
                   */
                  Tcl_SetResult(interp, TclGetString(resultPtr),
                          TCL_VOLATILE);
              }
              Tcl_DecrRefCount(resultPtr);  /* discard the result object */
          } else {
              /*
               * Move the interpreter's object result to the string result,
               * then reset the object result.
               */
              Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
                      TCL_VOLATILE);
          }
          Tcl_DecrRefCount(exprPtr); /* discard the expression object */
      } else {
          /*
           * An empty string. Just set the interpreter's result to 0.
           */
          Tcl_SetResult(interp, "0", TCL_VOLATILE);
      }
      return result;
  }
  /*
   *--------------------------------------------------------------
   *
   * Tcl_ExprObj --
   *
   *      Evaluate an expression in a Tcl_Obj.
   *
   * Results:
   *      A standard Tcl object result. If the result is other than TCL_OK,
   *      then the interpreter's result contains an error message. If the
   *      result is TCL_OK, then a pointer to the expression's result value
   *      object is stored in resultPtrPtr. In that case, the object's ref
   *      count is incremented to reflect the reference returned to the
   *      caller; the caller is then responsible for the resulting object
   *      and must, for example, decrement the ref count when it is finished
   *      with the object.
   *
   * Side effects:
   *      Any side effects caused by subcommands in the expression, if any.
   *      The interpreter result is not modified unless there is an error.
   *
   *--------------------------------------------------------------
   */
  int
  Tcl_ExprObj(interp, objPtr, resultPtrPtr)
      Tcl_Interp *interp;         /* Context in which to evaluate the
                                   * expression. */
      register Tcl_Obj *objPtr;   /* Points to Tcl object containing
                                   * expression to evaluate. */
      Tcl_Obj **resultPtrPtr;     /* Where the Tcl_Obj* that is the expression
                                   * result is stored if no errors occur. */
  {
      Interp *iPtr = (Interp *) interp;
      CompileEnv compEnv;         /* Compilation environment structure
                                   * allocated in frame. */
      LiteralTable *localTablePtr = &(compEnv.localLitTable);
      register ByteCode *codePtr = NULL;
                                  /* Tcl Internal type of bytecode.
                                   * Initialized to avoid compiler warning. */
      AuxData *auxDataPtr;
      LiteralEntry *entryPtr;
      Tcl_Obj *saveObjPtr;
      char *string;
      int length, i, result;
      /*
       * First handle some common expressions specially.
       */
      string = Tcl_GetStringFromObj(objPtr, &length);
      if (length == 1) {
          if (*string == '0') {
              *resultPtrPtr = Tcl_NewLongObj(0);
              Tcl_IncrRefCount(*resultPtrPtr);
              return TCL_OK;
          } else if (*string == '1') {
              *resultPtrPtr = Tcl_NewLongObj(1);
              Tcl_IncrRefCount(*resultPtrPtr);
              return TCL_OK;
          }
      } else if ((length == 2) && (*string == '!')) {
          if (*(string+1) == '0') {
              *resultPtrPtr = Tcl_NewLongObj(1);
              Tcl_IncrRefCount(*resultPtrPtr);
              return TCL_OK;
          } else if (*(string+1) == '1') {
              *resultPtrPtr = Tcl_NewLongObj(0);
              Tcl_IncrRefCount(*resultPtrPtr);
              return TCL_OK;
          }
      }
      /*
       * Get the ByteCode from the object. If it exists, make sure it hasn't
       * been invalidated by, e.g., someone redefining a command with a
       * compile procedure (this might make the compiled code wrong). If
       * necessary, convert the object to be a ByteCode object and compile it.
       * Also, if the code was compiled in/for a different interpreter, we
       * recompile it.
       *
       * Precompiled expressions, however, are immutable and therefore
       * they are not recompiled, even if the epoch has changed.
       *
       */
      if (objPtr->typePtr == &tclByteCodeType) {
          codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
          if (((Interp *) *codePtr->interpHandle != iPtr)
                  || (codePtr->compileEpoch != iPtr->compileEpoch)) {
              if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
                  if ((Interp *) *codePtr->interpHandle != iPtr) {
                      panic("Tcl_ExprObj: compiled expression jumped interps");
                  }
                  codePtr->compileEpoch = iPtr->compileEpoch;
              } else {
                  (*tclByteCodeType.freeIntRepProc)(objPtr);
                  objPtr->typePtr = (Tcl_ObjType *) NULL;
              }
          }
      }
      if (objPtr->typePtr != &tclByteCodeType) {
          TclInitCompileEnv(interp, &compEnv, string, length);
          result = TclCompileExpr(interp, string, length, &compEnv);
          /*
           * Free the compilation environment's literal table bucket array if
           * it was dynamically allocated.
           */
          if (localTablePtr->buckets != localTablePtr->staticBuckets) {
              ckfree((char *) localTablePtr->buckets);
          }
          if (result != TCL_OK) {
              /*
               * Compilation errors. Free storage allocated for compilation.
               */
  #ifdef TCL_COMPILE_DEBUG
              TclVerifyLocalLiteralTable(&compEnv);
  #endif /*TCL_COMPILE_DEBUG*/
              entryPtr = compEnv.literalArrayPtr;
              for (i = 0;  i < compEnv.literalArrayNext;  i++) {
                  TclReleaseLiteral(interp, entryPtr->objPtr);
                  entryPtr++;
              }
  #ifdef TCL_COMPILE_DEBUG
              TclVerifyGlobalLiteralTable(iPtr);
  #endif /*TCL_COMPILE_DEBUG*/
              auxDataPtr = compEnv.auxDataArrayPtr;
              for (i = 0;  i < compEnv.auxDataArrayNext;  i++) {
                  if (auxDataPtr->type->freeProc != NULL) {
                      auxDataPtr->type->freeProc(auxDataPtr->clientData);
                  }
                  auxDataPtr++;
              }
              TclFreeCompileEnv(&compEnv);
              return result;
          }
          /*
           * Successful compilation. If the expression yielded no
           * instructions, push an zero object as the expression's result.
           */
          if (compEnv.codeNext == compEnv.codeStart) {
              TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
                      &compEnv);
          }
          /*
           * Add a "done" instruction as the last instruction and change the
           * object into a ByteCode object. Ownership of the literal objects
           * and aux data items is given to the ByteCode object.
           */
          compEnv.numSrcBytes = iPtr->termOffset;
          TclEmitOpcode(INST_DONE, &compEnv);
          TclInitByteCodeObj(objPtr, &compEnv);
          TclFreeCompileEnv(&compEnv);
          codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
  #ifdef TCL_COMPILE_DEBUG
          if (tclTraceCompile == 2) {
              TclPrintByteCodeObj(interp, objPtr);
          }
  #endif /* TCL_COMPILE_DEBUG */
      }
      /*
       * Execute the expression after first saving the interpreter's result.
       */
      saveObjPtr = Tcl_GetObjResult(interp);
      Tcl_IncrRefCount(saveObjPtr);
      Tcl_ResetResult(interp);
      /*
       * Increment the code's ref count while it is being executed. If
       * afterwards no references to it remain, free the code.
       */
      codePtr->refCount++;
      result = TclExecuteByteCode(interp, codePtr);
      codePtr->refCount--;
      if (codePtr->refCount <= 0) {
          TclCleanupByteCode(codePtr);
          objPtr->typePtr = NULL;
          objPtr->internalRep.otherValuePtr = NULL;
      }
      /*
       * If the expression evaluated successfully, store a pointer to its
       * value object in resultPtrPtr then restore the old interpreter result.
       * We increment the object's ref count to reflect the reference that we
       * are returning to the caller. We also decrement the ref count of the
       * interpreter's result object after calling Tcl_SetResult since we
       * next store into that field directly.
       */
      if (result == TCL_OK) {
          *resultPtrPtr = iPtr->objResultPtr;
          Tcl_IncrRefCount(iPtr->objResultPtr);
          Tcl_SetObjResult(interp, saveObjPtr);
      }
      Tcl_DecrRefCount(saveObjPtr);
      return result;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_CreateTrace --
   *
   *      Arrange for a procedure to be called to trace command execution.
   *
   * Results:
   *      The return value is a token for the trace, which may be passed
   *      to Tcl_DeleteTrace to eliminate the trace.
   *
   * Side effects:
   *      From now on, proc will be called just before a command procedure
   *      is called to execute a Tcl command.  Calls to proc will have the
   *      following form:
   *
   *      void
   *      proc(clientData, interp, level, command, cmdProc, cmdClientData,
   *              argc, argv)
   *          ClientData clientData;
   *          Tcl_Interp *interp;
   *          int level;
   *          char *command;
   *          int (*cmdProc)();
   *          ClientData cmdClientData;
   *          int argc;
   *          char **argv;
   *      {
   *      }
   *
   *      The clientData and interp arguments to proc will be the same
   *      as the corresponding arguments to this procedure.  Level gives
   *      the nesting level of command interpretation for this interpreter
   *      (0 corresponds to top level).  Command gives the ASCII text of
   *      the raw command, cmdProc and cmdClientData give the procedure that
   *      will be called to process the command and the ClientData value it
   *      will receive, and argc and argv give the arguments to the
   *      command, after any argument parsing and substitution.  Proc
   *      does not return a value.
   *
   *----------------------------------------------------------------------
   */
  Tcl_Trace
  Tcl_CreateTrace(interp, level, proc, clientData)
      Tcl_Interp *interp;         /* Interpreter in which to create trace. */
      int level;                  /* Only call proc for commands at nesting
                                   * level<=argument level (1=>top level). */
      Tcl_CmdTraceProc *proc;     /* Procedure to call before executing each
                                   * command. */
      ClientData clientData;      /* Arbitrary value word to pass to proc. */
  {
      register Trace *tracePtr;
      register Interp *iPtr = (Interp *) interp;
      /*
       * Invalidate existing compiled code for this interpreter and arrange
       * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
       * new code, no commands will be compiled inline (i.e., into an inline
       * sequence of instructions). We do this because commands that were
       * compiled inline will never result in a command trace being called.
       */
      iPtr->compileEpoch++;
      iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
      tracePtr = (Trace *) ckalloc(sizeof(Trace));
      tracePtr->level = level;
      tracePtr->proc = proc;
      tracePtr->clientData = clientData;
      tracePtr->nextPtr = iPtr->tracePtr;
      iPtr->tracePtr = tracePtr;
      return (Tcl_Trace) tracePtr;
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_DeleteTrace --
   *
   *      Remove a trace.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      From now on there will be no more calls to the procedure given
   *      in trace.
   *
   *----------------------------------------------------------------------
   */
  void
  Tcl_DeleteTrace(interp, trace)
      Tcl_Interp *interp;         /* Interpreter that contains trace. */
      Tcl_Trace trace;            /* Token for trace (returned previously by
                                   * Tcl_CreateTrace). */
  {
      register Interp *iPtr = (Interp *) interp;
      register Trace *tracePtr = (Trace *) trace;
      register Trace *tracePtr2;
      if (iPtr->tracePtr == tracePtr) {
          iPtr->tracePtr = tracePtr->nextPtr;
          ckfree((char *) tracePtr);
      } else {
          for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
                  tracePtr2 = tracePtr2->nextPtr) {
              if (tracePtr2->nextPtr == tracePtr) {
                  tracePtr2->nextPtr = tracePtr->nextPtr;
                  ckfree((char *) tracePtr);
                  break;
              }
          }
      }
      if (iPtr->tracePtr == NULL) {
          /*
           * When compiling new code, allow commands to be compiled inline.
           */
          iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tcl_AddErrorInfo --
   *
   *      Add information to the "errorInfo" variable that describes the
   *      current error.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The contents of message are added to the "errorInfo" variable.
   *      If Tcl_Eval has been called since the current value of errorInfo
   *      was set, errorInfo is cleared before adding the new message.
   *      If we are just starting to log an error, errorInfo is initialized
   *      from the error message in the interpreter's result.
   *
   *----------------------------------------------------------------------
   */
  void
  Tcl_AddErrorInfo(interp, message)
      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" variable 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 added to the "errorInfo" variable.
   *      If "length" is negative, use bytes up to the first NULL byte.
   *      If Tcl_EvalObj has been called since the current value of errorInfo
   *      was set, errorInfo is cleared before adding the new message.
   *      If we are just starting to log an error, errorInfo is initialized
   *      from the error message in the interpreter's result.
   *
   *----------------------------------------------------------------------
   */
  void
  Tcl_AddObjErrorInfo(interp, message, length)
      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;
      Tcl_Obj *messagePtr;
      /*
       * If we are just starting to log an error, errorInfo is initialized
       * from the error message in the interpreter's result.
       */
      if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
          iPtr->flags |= ERR_IN_PROGRESS;
          if (iPtr->result[0] == 0) {
              (void) Tcl_SetVar2Ex(interp, "errorInfo", NULL, iPtr->objResultPtr,
                      TCL_GLOBAL_ONLY);
          } else {                /* use the string result */
              Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
                      TCL_GLOBAL_ONLY);
          }
          /*
           * If the errorCode variable wasn't set by the code that generated
           * the error, set it to "NONE".
           */
          if (!(iPtr->flags & ERROR_CODE_SET)) {
              (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
                      TCL_GLOBAL_ONLY);
          }
      }
      /*
       * Now append "message" to the end of errorInfo.
       */
      if (length != 0) {
          messagePtr = Tcl_NewStringObj(message, length);
          Tcl_IncrRefCount(messagePtr);
          Tcl_SetVar2Ex(interp, "errorInfo", NULL, messagePtr,
                  (TCL_GLOBAL_ONLY | TCL_APPEND_VALUE));
          Tcl_DecrRefCount(messagePtr); /* free msg object appended above */
      }
  }
  /*
   *---------------------------------------------------------------------------
   *
   * 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 (interp, argList)
      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.
   *
   *----------------------------------------------------------------------
   */
          /* VARARGS2 */ /* ARGSUSED */
  int
  Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
  {
      Tcl_Interp *interp;
      va_list argList;
      int result;
      interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
      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
   *      procedures active), just as if an "uplevel #0" command were
   *      being executed.
   *
   ---------------------------------------------------------------------------
   */
  int
  Tcl_GlobalEval(interp, command)
      Tcl_Interp *interp;         /* Interpreter in which to evaluate command. */
      char *command;              /* Command to evaluate. */
  {
      register Interp *iPtr = (Interp *) interp;
      int result;
      CallFrame *savedVarFramePtr;
      savedVarFramePtr = iPtr->varFramePtr;
      iPtr->varFramePtr = NULL;
      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(interp, depth)
      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(interp)
      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(majorV, minorV, patchLevelV, type)
      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;
      }
  }
  /* End of tclbasic.c */

 Legend:



Removed from v.66
 


changed lines


 
Added in v.71
 Legend:



Removed from v.66
 


changed lines


 
Added in v.71
-Removed from v.66
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25