/* 

  * tclBasic.c --

  *

  *	Contains the basic facilities for TCL command interpretation,

  *	including interpreter creation and deletion, command creation

  *	and deletion, and command/script execution. 

  *

  * Copyright (c) 1987-1994 The Regents of the University of California.

  * Copyright (c) 1994-1997 Sun Microsystems, Inc.

  * Copyright (c) 1998-1999 by Scriptics Corporation.

  * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  *

  * 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.75.2.26 2006/11/28 22:19:59 andreas_kupries Exp $

  */

 #include "tclInt.h"

 #include "tclCompile.h"

 #ifndef TCL_GENERIC_ONLY

 #   include "tclPort.h"

 #endif

 /*

  * Static procedures in this file:

  */

 static char *		CallCommandTraces _ANSI_ARGS_((Interp *iPtr, 

 			    Command *cmdPtr, CONST char *oldName, 

 			    CONST char* newName, int flags));

 static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));

 static void		ProcessUnexpectedResult _ANSI_ARGS_((

 			    Tcl_Interp *interp, int returnCode));

 static int	        StringTraceProc _ANSI_ARGS_((ClientData clientData,

 						     Tcl_Interp* interp,

 						     int level,

 						     CONST char* command,

 						    Tcl_Command commandInfo,

 						    int objc,

 						    Tcl_Obj *CONST objv[]));

 static void           StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));

 #ifdef TCL_TIP280

 /* TIP #280 - Modified token based evulation, with line information */

 static int            EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script,

 					  int numBytes, int flags, int line));

 static int            EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp,

 						      Tcl_Token *tokenPtr,

 						      int count, int line));

 #endif

 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,

 	TclCompileAppendCmd,		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,

         TclCompileLappendCmd,		1},

     {"lindex",		(Tcl_CmdProc *) NULL,	Tcl_LindexObjCmd,

         TclCompileLindexCmd,		1},

     {"linsert",		(Tcl_CmdProc *) NULL,	Tcl_LinsertObjCmd,

         (CompileProc *) NULL,		1},

     {"list",		(Tcl_CmdProc *) NULL,	Tcl_ListObjCmd,

         TclCompileListCmd,		1},

     {"llength",		(Tcl_CmdProc *) NULL,	Tcl_LlengthObjCmd,

         TclCompileLlengthCmd,		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},

     {"lset",            (Tcl_CmdProc *) NULL,   Tcl_LsetObjCmd,

         TclCompileLsetCmd,           	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,

         TclCompileRegexpCmd,		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,	

         TclCompileReturnCmd,		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,

         TclCompileStringCmd,		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}

 };

 /*

  * The following structure holds the client data for string-based

  * trace procs

  */

 typedef struct StringTraceData {

     ClientData clientData;	/* Client data from Tcl_CreateTrace */

     Tcl_CmdTraceProc* proc;	/* Trace procedure from Tcl_CreateTrace */

 } StringTraceData;

 /*

  *----------------------------------------------------------------------

  *

  * 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 the built-in commands

  *      and with the variables documented in tclvars(n).

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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 = MAX_NESTING_DEPTH;

     iPtr->framePtr = NULL;

     iPtr->varFramePtr = NULL;

 #ifdef TCL_TIP280

     /*

      * TIP #280 - Initialize the arrays used to extend the ByteCode and

      * Proc structures.

      */

     iPtr->cmdFramePtr  = NULL;

     iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));

     iPtr->lineBCPtr    = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));

     Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);

     Tcl_InitHashTable(iPtr->lineBCPtr,    TCL_ONE_WORD_KEYS);

 #endif

     iPtr->activeVarTracePtr = 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;

 #ifdef TCL_TIP268

     /* TIP #268 */

     iPtr->packagePrefer = (getenv ("TCL_PKG_PREFER_LATEST") == NULL ? 

 			   PKG_PREFER_STABLE   :

 			   PKG_PREFER_LATEST);

 #endif

     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->tracesForbiddingInline = 0;

     iPtr->activeCmdTracePtr = NULL;

     iPtr->activeInterpTracePtr = 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->threadId = Tcl_GetCurrentThread();

     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->flags = 0;

 	    cmdPtr->importRefPtr = NULL;

 	    cmdPtr->tracePtr = NULL;

 	    Tcl_SetHashValue(hPtr, cmdPtr);

 	}

     }

     /*

      * Register the builtin math functions.

      */

     i = 0;

     for (builtinFuncPtr = tclBuiltinFuncTable;  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);

     Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",

 	    Tcl_NewLongObj((long) sizeof(long)), 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.

      * TIP#268: Expose information about its status,

      *          for runtime switches in the core library

      *          and tests.

      */

     Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);

 #ifdef TCL_TIP268

     Tcl_SetVar2(interp, "tcl_platform", "tip,268", "1",

 	    TCL_GLOBAL_ONLY);

 #endif

 #ifdef TCL_TIP280

     Tcl_SetVar2(interp, "tcl_platform", "tip,280", "1",

 	    TCL_GLOBAL_ONLY);

 #endif

 #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.

  *

  *--------------------------------------------------------------

  */

 EXPORT_C 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 Tcl_ThreadDataKey assocDataCounterKey;

     int *assocDataCounterPtr =

 	    Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));

     int new;

     char buffer[32 + TCL_INTEGER_SPACE];

     AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));

     Tcl_HashEntry *hPtr;

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

     (*assocDataCounterPtr)++;

     if (iPtr->assocData == (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.

  *

  *--------------------------------------------------------------

  */

 EXPORT_C 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetAssocData(interp, name, proc, clientData)

     Tcl_Interp *interp;		/* Interpreter to associate with. */

     CONST char *name;		/* Name for association. */

     Tcl_InterpDeleteProc *proc;	/* Proc to call when interpreter is

                                  * about to be deleted. */

     ClientData clientData;	/* One-word value to pass to proc. */

 {

     Interp *iPtr = (Interp *) interp;

     AssocData *dPtr;

     Tcl_HashEntry *hPtr;

     int 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_DeleteAssocData(interp, name)

     Tcl_Interp *interp;			/* Interpreter to associate with. */

     CONST char *name;			/* Name of association. */

 {

     Interp *iPtr = (Interp *) interp;

     AssocData *dPtr;

     Tcl_HashEntry *hPtr;

     if (iPtr->assocData == (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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C ClientData

 Tcl_GetAssocData(interp, name, procPtr)

     Tcl_Interp *interp;			/* Interpreter associated with. */

     CONST char *name;			/* Name of association. */

     Tcl_InterpDeleteProc **procPtr;	/* Pointer to place to store address

 					 * of current deletion callback. */

 {

     Interp *iPtr = (Interp *) interp;

     AssocData *dPtr;

     Tcl_HashEntry *hPtr;

     if (iPtr->assocData == (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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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) {

 	Tcl_DeleteTrace((Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr);

     }

     if (iPtr->execEnvPtr != NULL) {

 	TclDeleteExecEnv(iPtr->execEnvPtr);

     }

     Tcl_DecrRefCount(iPtr->emptyObjPtr);

     iPtr->emptyObjPtr = NULL;

     resPtr = iPtr->resolverPtr;

     while (resPtr) {

 	nextResPtr = resPtr->nextPtr;

 	ckfree(resPtr->name);

 	ckfree((char *) resPtr);

         resPtr = nextResPtr;

     }

     /*

      * Free up literal objects created for scripts compiled by the

      * interpreter.

      */

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

 #ifdef TCL_TIP280

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

      */

     {

         Tcl_HashEntry *hPtr;

 	Tcl_HashSearch hSearch;

 	CmdFrame*      cfPtr;

 	ExtCmdLoc*     eclPtr;

 	int            i;

 	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);

 	     hPtr != NULL;

 	     hPtr = Tcl_NextHashEntry(&hSearch)) {

 	    cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr);

 	    if (cfPtr->type == TCL_LOCATION_SOURCE) {

 	        Tcl_DecrRefCount (cfPtr->data.eval.path);

 	    }

 	    ckfree ((char*) cfPtr->line);

 	    ckfree ((char*) cfPtr);

 	    Tcl_DeleteHashEntry (hPtr);

 	}

 	Tcl_DeleteHashTable (iPtr->linePBodyPtr);

 	ckfree ((char*) iPtr->linePBodyPtr);

 	iPtr->linePBodyPtr = NULL;

 	/* See also tclCompile.c, TclCleanupByteCode */

 	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);

 	     hPtr != NULL;

 	     hPtr = Tcl_NextHashEntry(&hSearch)) {

 	    eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr);

 	    if (eclPtr->type == TCL_LOCATION_SOURCE) {

 	        Tcl_DecrRefCount (eclPtr->path);

 	    }

 	    for (i=0; i< eclPtr->nuloc; i++) {

 	        ckfree ((char*) eclPtr->loc[i].line);

 	    }

             if (eclPtr->loc != NULL) {

 		ckfree ((char*) eclPtr->loc);

 	    }

 	    ckfree ((char*) eclPtr);

 	    Tcl_DeleteHashEntry (hPtr);

 	}

 	Tcl_DeleteHashTable (iPtr->lineBCPtr);

 	ckfree((char*) iPtr->lineBCPtr);

 	iPtr->lineBCPtr = NULL;

     }

 #endif

     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.

  *

  *---------------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_HideCommand(interp, cmdName, hiddenCmdToken)

     Tcl_Interp *interp;		/* Interpreter in which to hide command. */

     CONST char *cmdName;	/* Name of command to hide. */

     CONST char *hiddenCmdToken;	/* Token name of the to-be-hidden command. */

 {

     Interp *iPtr = (Interp *) interp;

     Tcl_Command cmd;

     Command *cmdPtr;

     Tcl_HashTable *hiddenCmdTablePtr;

     Tcl_HashEntry *hPtr;

     int 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 in 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)

     Tcl_Interp *interp;		/* Interpreter in which to make command

                                  * callable. */

     CONST char *hiddenCmdToken;	/* Name of hidden command. */

     CONST char *cmdName;	/* Name of to-be-exposed command. */

 {

     Interp *iPtr = (Interp *) interp;

     Command *cmdPtr;

     Namespace *nsPtr;

     Tcl_HashEntry *hPtr;

     Tcl_HashTable *hiddenCmdTablePtr;

     int 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Command

 Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)

     Tcl_Interp *interp;		/* Token for command interpreter returned by

 				 * a previous call to Tcl_CreateInterp. */

     CONST char *cmdName;	/* Name of command. If it contains namespace

 				 * qualifiers, the new command is put in the

 				 * specified namespace; otherwise it is put

 				 * in the global namespace. */

     Tcl_CmdProc *proc;		/* 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;

     CONST 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->flags = 0;

     cmdPtr->importRefPtr = NULL;

     cmdPtr->tracePtr = NULL;

     /*

      * Plug in any existing import references found above.  Be sure

      * to update all of these references to point to the new command.

      */

     if (oldRefPtr != NULL) {

 	cmdPtr->importRefPtr = oldRefPtr;

 	while (oldRefPtr != NULL) {

 	    refCmdPtr = oldRefPtr->importedCmdPtr;

 	    dataPtr = (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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Command

 Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc)

     Tcl_Interp *interp;		/* Token for command interpreter (returned

 				 * by previous call to Tcl_CreateInterp). */

     CONST char *cmdName;	/* Name of command. If it contains namespace

 				 * qualifiers, the new command is put in the

 				 * specified namespace; otherwise it is put

 				 * in the global namespace. */

     Tcl_ObjCmdProc *proc;	/* Object-based 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;

     CONST 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->flags = 0;

     cmdPtr->importRefPtr = NULL;

     cmdPtr->tracePtr = NULL;

     /*

      * Plug in any existing import references found above.  Be sure

      * to update all of these references to point to the new command.

      */

     if (oldRefPtr != NULL) {

 	cmdPtr->importRefPtr = oldRefPtr;

 	while (oldRefPtr != NULL) {

 	    refCmdPtr = oldRefPtr->importedCmdPtr;

 	    dataPtr = (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

     CONST char *(argStorage[NUM_ARGS]);

     CONST 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 = (CONST 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 CONST 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 > NUM_ARGS) {

 	objv = (Tcl_Obj **)

 	    ckalloc((unsigned)(argc * 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;

     }

     /*

      * 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;

     CONST char *newTail;

     Namespace *cmdNsPtr, *newNsPtr, *dummy1, *dummy2;

     Tcl_Command cmd;

     Command *cmdPtr;

     Tcl_HashEntry *hPtr, *oldHPtr;

     int new, result;

     Tcl_Obj* oldFullName;

     Tcl_DString newFullName;

     /*

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

      * be found.

      */

     cmd = Tcl_FindCommand(interp, oldName, (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;

     oldFullName = Tcl_NewObj();

     Tcl_IncrRefCount( oldFullName );

     Tcl_GetCommandFullName( interp, cmd, oldFullName );

     /*

      * If the new command name is NULL or empty, delete the command. Do this

      * with Tcl_DeleteCommandFromToken, since we already have the command.

      */

     if ((newName == NULL) || (*newName == '\0')) {

 	Tcl_DeleteCommandFromToken(interp, cmd);

 	result = TCL_OK;

 	goto done;

     }

     /*

      * Make sure that the destination command does not already exist.

      * The rename operation is like creating a command, so we should

      * automatically create the containing namespaces just like

      * Tcl_CreateCommand would.

      */

     TclGetNamespaceForQualName(interp, newName, (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);

 	result = TCL_ERROR;

 	goto done;

     }

     if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		 "can't rename to \"", newName,

 		 "\": command already exists", (char *) NULL);

 	result = TCL_ERROR;

 	goto done;

     }

     /*

      * Warning: any changes done in the code here are likely

      * to be needed in Tcl_HideCommand() code too.

      * (until the common parts are extracted out)     --dl

      */

     /*

      * Put the command in the new namespace so we can check for an alias

      * loop. Since we are adding a new command to a namespace, we must

      * handle any shadowing of the global commands that this might create.

      */

     oldHPtr = cmdPtr->hPtr;

     hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &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;

 	goto done;

     }

     /*

      * Script for rename traces can delete the command "oldName".

      * Therefore increment the reference count for cmdPtr so that

      * it's Command structure is freed only towards the end of this

      * function by calling TclCleanupCommand.

      *

      * The trace procedure needs to get a fully qualified name for

      * old and new commands [Tcl bug #651271], or else there's no way

      * for the trace procedure to get the namespace from which the old

      * command is being renamed!

      */

     Tcl_DStringInit( &newFullName );

     Tcl_DStringAppend( &newFullName, newNsPtr->fullName, -1 );

     if ( newNsPtr != iPtr->globalNsPtr ) {

 	Tcl_DStringAppend( &newFullName, "::", 2 );

     }

     Tcl_DStringAppend( &newFullName, newTail, -1 );

     cmdPtr->refCount++;

     CallCommandTraces( iPtr, cmdPtr,

 		       Tcl_GetString( oldFullName ),

 		       Tcl_DStringValue( &newFullName ),

 		       TCL_TRACE_RENAME);

     Tcl_DStringFree( &newFullName );

     /*

      * The new command name is okay, so remove the command from its

      * current namespace. This is like deleting the command, so bump

      * the cmdEpoch to invalidate any cached references to the command.

      */

     Tcl_DeleteHashEntry(oldHPtr);

     cmdPtr->cmdEpoch++;

     /*

      * If the command being renamed has a compile 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++;

     }

     /*

      * Now free the Command structure, if the "oldName" command has

      * been deleted by invocation of rename traces.

      */

     TclCleanupCommand(cmdPtr);

     result = TCL_OK;

     done:

     TclDecrRefCount( oldFullName );

     return result;

 }

 /*

  *----------------------------------------------------------------------

  *

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

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_SetCommandInfo(interp, cmdName, infoPtr)

     Tcl_Interp *interp;			/* Interpreter in which to look

 					 * for command. */

     CONST char *cmdName;		/* Name of desired command. */

     CONST Tcl_CmdInfo *infoPtr;		/* Where to find information

 					 * to store in the command. */

 {

     Tcl_Command cmd;

     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,

             /*flags*/ 0);

     return Tcl_SetCommandInfoFromToken( cmd, infoPtr );

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetCommandInfoFromToken --

  *

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

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_SetCommandInfoFromToken( cmd, infoPtr )

     Tcl_Command cmd;

     CONST Tcl_CmdInfo* infoPtr;

 {

     Command* cmdPtr;		/* Internal representation of the command */

     if (cmd == (Tcl_Command) NULL) {

 	return 0;

     }

     /*

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

      */

     cmdPtr = (Command *) cmd;

     cmdPtr->proc = infoPtr->proc;

     cmdPtr->clientData = infoPtr->clientData;

     if (infoPtr->objProc == (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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_GetCommandInfo(interp, cmdName, infoPtr)

     Tcl_Interp *interp;			/* Interpreter in which to look

 					 * for command. */

     CONST char *cmdName;		/* Name of desired command. */

     Tcl_CmdInfo *infoPtr;		/* Where to store information about

 					 * command. */

 {

     Tcl_Command cmd;

     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,

             /*flags*/ 0);

     return Tcl_GetCommandInfoFromToken( cmd, infoPtr );

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetCommandInfoFromToken --

  *

  *	Returns various information about a Tcl command.

  *

  * Results:

  *	Copies information from the command identified by 'cmd' into

  *	a caller-supplied structure and returns 1.  If the 'cmd' is

  *	NULL, leaves the structure untouched and returns 0.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_GetCommandInfoFromToken( cmd, infoPtr )

     Tcl_Command cmd;

     Tcl_CmdInfo* infoPtr;

 {

     Command* cmdPtr;		/* Internal representation of the command */

     if ( cmd == (Tcl_Command) NULL ) {

 	return 0;

     }

     /*

      * Set isNativeObjectProc 1 if objProc was registered by a call to

      * Tcl_CreateObjCommand. Otherwise set it to 0.

      */

     cmdPtr = (Command *) cmd;

     infoPtr->isNativeObjectProc =

 	    (cmdPtr->objProc != TclInvokeStringCommand);

     infoPtr->objProc = cmdPtr->objProc;

     infoPtr->objClientData = cmdPtr->objClientData;

     infoPtr->proc = cmdPtr->proc;

     infoPtr->clientData = cmdPtr->clientData;

     infoPtr->deleteProc = cmdPtr->deleteProc;

     infoPtr->deleteData = cmdPtr->deleteData;

     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;

     return 1;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetCommandName --

  *

  *	Given a token returned by Tcl_CreateCommand, this 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST 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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_DeleteCommand(interp, cmdName)

     Tcl_Interp *interp;		/* Token for command interpreter (returned

 				 * by a previous Tcl_CreateInterp call). */

     CONST char *cmdName;	/* Name of command to remove. */

 {

     Tcl_Command cmd;

     /*

      *  Find the desired command and delete it.

      */

     cmd = Tcl_FindCommand(interp, cmdName, (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".

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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->flags & CMD_IS_DELETED) {

 	/*

 	 * Another deletion is already in progress.  Remove the hash

 	 * table entry now, but don't invoke a callback or free the

 	 * command structure.

 	 */

         Tcl_DeleteHashEntry(cmdPtr->hPtr);

 	cmdPtr->hPtr = NULL;

 	return 0;

     }

     /* 

      * We must delete this command, even though both traces and

      * delete procs may try to avoid this (renaming the command etc).

      * Also traces and delete procs may try to delete the command

      * themsevles.  This flag declares that a delete is in progress

      * and that recursive deletes should be ignored.

      */

     cmdPtr->flags |= CMD_IS_DELETED;

     /*

      * Bump the command epoch counter. This will invalidate all cached

      * references that point to this command.

      */

     cmdPtr->cmdEpoch++;

     /*

      * Call trace procedures for the command being deleted. Then delete

      * its traces. 

      */

     if (cmdPtr->tracePtr != NULL) {

 	CommandTrace *tracePtr;

 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

 	/* Now delete these traces */

 	tracePtr = cmdPtr->tracePtr;

 	while (tracePtr != NULL) {

 	    CommandTrace *nextPtr = tracePtr->nextPtr;

 	    if ((--tracePtr->refCount) <= 0) {

 		ckfree((char*)tracePtr);

 	    }

 	    tracePtr = nextPtr;

 	}

 	cmdPtr->tracePtr = NULL;

     }

     /*

      * 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++;

     }

     if (cmdPtr->deleteProc != NULL) {

 	/*

 	 * Delete the command's client data. If this was an imported command

 	 * created when a command was imported into a namespace, this client

 	 * data will be a pointer to a ImportedCmdData structure describing

 	 * the "real" command that this imported command refers to.

 	 */

 	/*

 	 * If you are getting a crash during the call to deleteProc and

 	 * cmdPtr->deleteProc is a pointer to the function free(), the

 	 * most likely cause is that your extension allocated memory

 	 * for the clientData argument to Tcl_CreateObjCommand() with

 	 * the ckalloc() macro and you are now trying to deallocate

 	 * this memory with free() instead of ckfree(). You should

 	 * pass a pointer to your own method that calls ckfree().

 	 */

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

     }

     /*

      * If this command was imported into other namespaces, then imported

      * commands were created that refer back to this command. Delete these

      * imported commands now.

      */

     for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;

             refPtr = nextRefPtr) {

 	nextRefPtr = refPtr->nextPtr;

 	importCmd = (Tcl_Command) refPtr->importedCmdPtr;

         Tcl_DeleteCommandFromToken(interp, importCmd);

     }

     /*

      * Don't use hPtr to delete the hash entry here, because it's

      * possible that the deletion callback renamed the command.

      * Instead, use cmdPtr->hptr, and make sure that no-one else

      * has already deleted the hash entry.

      */

     if (cmdPtr->hPtr != NULL) {

 	Tcl_DeleteHashEntry(cmdPtr->hPtr);

     }

     /*

      * 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;

 }

 static char *

 CallCommandTraces(iPtr, cmdPtr, oldName, newName, flags)

     Interp *iPtr;		/* Interpreter containing command. */

     Command *cmdPtr;		/* Command whose traces are to be

 				 * invoked. */

     CONST char *oldName;        /* Command's old name, or NULL if we

                                  * must get the name from cmdPtr */

     CONST char *newName;        /* Command's new name, or NULL if

                                  * the command is not being renamed */

     int flags;			/* Flags indicating the type of traces

 				 * to trigger, either TCL_TRACE_DELETE

 				 * or TCL_TRACE_RENAME. */

 {

     register CommandTrace *tracePtr;