/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 * 
 * *** DIFFERENT THAN THE STANDARD TCL DISTRIBUTION ***
 *
 * Routines that must examine or change the execution stack have been moved
 * into tclStackRun.c.
 * 
 * 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) 1995, Robert S. Gray, Dartmouth College
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "agent.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef lint
static char sccsid[] = "@(#) tclBasic.c 1.160 95/01/03 17:05:20";
#endif

#include "tclInt.h"
#include "patchlevel.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif

/*
 * The following structure defines all of the commands in the Tcl core,
 * and the C procedures that execute them.
 */

typedef struct {
    char *name;			/* Name of command                     */
    Tcl_CmdProc *proc;		/* Procedure that executes command     */
    unsigned char flags;        /* Flags that control command behavior */
} CmdInfo;

/*
 * Built-in commands, and the procedures associated with them:
 */

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

    {"append",		Tcl_AppendCmd	, 0		},
    {"array",		Tcl_ArrayCmd	, 0		},
    {"break",		Tcl_BreakCmd	, 0		},
    {"case",		Tcl_CaseCmd	, TCL_INTERRUPT	},
    {"catch",		Tcl_CatchCmd	, TCL_INTERRUPT	},
    {"concat",		Tcl_ConcatCmd	, 0		},
    {"continue",	Tcl_ContinueCmd	, 0		},
    {"error",		Tcl_ErrorCmd	, 0		},
    {"eval",		Tcl_EvalCmd	, TCL_INTERRUPT },
    {"expr",		Tcl_ExprCmd	, TCL_INTERRUPT },
    {"for",		Tcl_ForCmd	, TCL_INTERRUPT },
    {"foreach",		Tcl_ForeachCmd	, TCL_INTERRUPT },
    {"format",		Tcl_FormatCmd	, 0		},
    {"global",		Tcl_GlobalCmd	, 0		},
    {"glue",		Tcl_GlueCmd	, 0		},
    {"history",         Tcl_HistoryCmd	, 0		},
    {"if",		Tcl_IfCmd	, TCL_INTERRUPT },
    {"incr",		Tcl_IncrCmd	, 0		},
    {"info",		Tcl_InfoCmd	, 0		},
    {"join",		Tcl_JoinCmd	, 0		},
    {"lappend",		Tcl_LappendCmd	, 0		},
    {"lindex",		Tcl_LindexCmd	, 0		},
    {"linsert",		Tcl_LinsertCmd	, 0		},
    {"list",		Tcl_ListCmd	, 0		},
    {"llength",		Tcl_LlengthCmd	, 0		},
    {"lrange",		Tcl_LrangeCmd	, 0		},
    {"lreplace",	Tcl_LreplaceCmd	, 0		},
    {"lsearch",		Tcl_LsearchCmd	, 0		},
    {"lsort",		Tcl_LsortCmd	, 0		},
    {"proc",		Tcl_ProcCmd	, 0		},
    {"regexp",		Tcl_RegexpCmd	, 0		},
    {"regsub",		Tcl_RegsubCmd	, 0		},
    {"rename",		Tcl_RenameCmd	, 0		},
    {"return",		Tcl_ReturnCmd	, 0		},
    {"savestate",	Tcl_SavestateCmd, TCL_INTERRUPT	},
    {"saveprocs",	Tcl_SaveprocsCmd, 0		},
    {"savevars",	Tcl_SavevarsCmd , 0		},
    {"scan",		Tcl_ScanCmd	, 0		},
    {"set",		Tcl_SetCmd	, 0		},
    {"split",		Tcl_SplitCmd	, 0		},
    {"string",		Tcl_StringCmd	, 0		},
    {"subst",		Tcl_SubstCmd	, TCL_INTERRUPT },
    {"switch",		Tcl_SwitchCmd	, TCL_INTERRUPT },
    {"trace",		Tcl_TraceCmd	, 0		},
    {"unset",		Tcl_UnsetCmd	, 0		},
    {"uplevel",		Tcl_UplevelCmd	, TCL_INTERRUPT },
    {"upvar",		Tcl_UpvarCmd	, 0		},
    {"while",		Tcl_WhileCmd	, TCL_INTERRUPT },

    /*
     * Commands in the UNIX core:
     */

#ifndef TCL_GENERIC_ONLY
    {"cd",		Tcl_CdCmd	, 0		},
    {"close",		Tcl_CloseCmd	, 0		},
    {"eof",		Tcl_EofCmd	, 0		},
    {"exec",		Tcl_ExecCmd	, 0		},
    {"exit",		Tcl_ExitCmd	, 0		},
    {"file",		Tcl_FileCmd	, 0		},
    {"flush",		Tcl_FlushCmd	, 0		},
    {"gets",		Tcl_GetsCmd	, 0		},
    {"glob",		Tcl_GlobCmd	, 0		},
    {"open",		Tcl_OpenCmd	, 0		},
    {"pid",		Tcl_PidCmd	, 0		},
    {"puts",		Tcl_PutsCmd	, 0		},
    {"pwd",		Tcl_PwdCmd	, 0		},
    {"read",		Tcl_ReadCmd	, 0		},
    {"seek",		Tcl_SeekCmd	, 0		},
    {"source",		Tcl_SourceCmd	, TCL_INTERRUPT	},
    {"tell",		Tcl_TellCmd	, 0		},
    {"time",		Tcl_TimeCmd	, 0		},
#endif /* TCL_GENERIC_ONLY */

   /*
    * end of commands
    */

    {NULL,		(Tcl_CmdProc *) NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp and Tcl_CreateAndLoadInterp --
 *
 *	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.  SIGPIPE signals are set to
 *	be ignored (see comment below for details).
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp * TclCreateInterp (state, error)
     char *state;
     Tcl_DString *error;
{
    int i;
    char *libDir;
    register Interp *iPtr;
    register Tcl_Interp *interp;
    register Command *cmdPtr;
    register CmdInfo *cmdInfoPtr;
    static int firstInterp = 1;

    iPtr = (Interp *) ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;
    iPtr->result = iPtr->resultSpace;
    iPtr->freeProc = 0;
    iPtr->errorLine = 0;
    Tcl_InitHashTable(&iPtr->commandTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&iPtr->globalTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&iPtr->stateTable, TCL_STRING_KEYS);
#ifdef TCL_STATE_HANDLERS
    Tcl_InitHashTable(&iPtr->extenState, TCL_STRING_KEYS);
    iPtr->handlers.n = 0;
    iPtr->handlers.n_slots = NUM_HANDLERS;
    iPtr->handlers.slots = (StateHandler *) ckalloc ((unsigned) sizeof(StateHandler) * NUM_HANDLERS);
#endif
    TclInitStack (&iPtr -> execution_stack);
    TclInitMath ((Tcl_Interp *) iPtr);
    iPtr->maxNestingDepth = 1000;
    iPtr->framePtr = NULL;
    iPtr->varFramePtr = NULL;
    iPtr->activeTracePtr = NULL;
    iPtr->returnCode = TCL_OK;
    iPtr->errorInfo = NULL;
    iPtr->errorCode = NULL;
    iPtr->numEvents = 0;
    iPtr->events = NULL;
    iPtr->curEvent = 0;
    iPtr->curEventNum = 0;
    iPtr->revPtr = NULL;
    iPtr->historyFirst = NULL;
    iPtr->revDisables = 1;
    iPtr->evalFirst = iPtr->evalLast = NULL;
    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;
    for (i = 0; i < NUM_REGEXPS; i++) {
	iPtr->patterns[i] = NULL;
	iPtr->patLengths[i] = -1;
	iPtr->regexps[i] = NULL;
    }
    strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
    iPtr->pdPrec = DEFAULT_PD_PREC;
    iPtr->cmdCount = 0;
    iPtr->noEval = 0;
    iPtr->evalFlags = 0;
    iPtr->scriptFile=NULL; 
    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->deleteCallbackPtr = NULL;
    iPtr->resultSpace[0] = 0;

    /* 
     * Load the state
     */

    if (state != NULL) {
      if (Tcl_LoadState (interp, state, error) != TCL_OK) {
        return NULL;    
      }
    }
  
    /*
     * Create the built-in 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).
     */

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

	hPtr = Tcl_CreateHashEntry(&iPtr->commandTable,
		cmdInfoPtr->name, &new);

	if (new) {
	    cmdPtr              = (Command *) ckalloc(sizeof(Command));
	    cmdPtr->proc        = cmdInfoPtr->proc;
	    cmdPtr->commandFlag = cmdInfoPtr->flags;
	    cmdPtr->clientData  = (ClientData) NULL;
	    cmdPtr->deleteData  = (ClientData) NULL;
	    cmdPtr->deleteProc  = NULL;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

#ifndef TCL_GENERIC_ONLY

      /* set up the environment */

    TclSetupEnv (interp);
    Tcl_GlueVar2 (interp, "env", NULL, TCL_GLOBAL_ONLY);

      /*
       * The code below causes SIGPIPE (broken pipe) errors to
       * be ignored.  This is needed so that Tcl processes don't
       * die if they create child processes (e.g. using "exec" or
       * "open") that terminate prematurely.  The signal handler
       * is only set up when the first interpreter is created; 
       * after this the application can override the handler with
       * a different one of its own, if it wants.
       */

    if (firstInterp) {
	(void) signal(SIGPIPE, SIG_IGN);
	firstInterp = 0;
    }
#endif

    /* set up the library directory */

  libDir = getenv ("TCL_LIBRARY");
  if (libDir == NULL) {
    libDir = TCL_LIBRARY;
  }

    /* set up tcl_version, tcl_library and tcl_patchLevel */

  Tcl_SetVar (interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
  Tcl_SetVar (interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
  Tcl_SetVar (interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
  Tcl_GlueVar2 (interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
  Tcl_GlueVar2 (interp, "tcl_version", NULL, TCL_GLOBAL_ONLY);
  Tcl_GlueVar2 (interp, "tcl_patchLevel", NULL, TCL_GLOBAL_ONLY);
   
    /* trace tcl_precision */

  Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
     TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
     Tcl_PrecTraceProc, (ClientData) NULL);

  return (Tcl_Interp *) iPtr;
}

Tcl_Interp *Tcl_CreateInterp ()
{
  return (TclCreateInterp (NULL, NULL));
}
  
Tcl_Interp *Tcl_CreateAndLoadInterp (state, error)
     char *state;
     Tcl_DString *error;
{
  return (TclCreateInterp (state, error));
}   

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a procedure to be called before a given
 *	interpreter is deleted.
 *
 * 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. */
{
    DeleteCallback *dcPtr, *prevPtr;
    Interp *iPtr = (Interp *) interp;

    dcPtr = (DeleteCallback *) ckalloc(sizeof(DeleteCallback));
    dcPtr->proc = proc;
    dcPtr->clientData = clientData;
    dcPtr->nextPtr = NULL;
    if (iPtr->deleteCallbackPtr == NULL) {
	iPtr->deleteCallbackPtr = dcPtr;
    } else {
	prevPtr = iPtr->deleteCallbackPtr;
	while (prevPtr->nextPtr != NULL) {
	    prevPtr = prevPtr->nextPtr;
	}
	prevPtr->nextPtr = dcPtr;
    }
}

/*
 *--------------------------------------------------------------
 *
 * 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. */
{
    DeleteCallback *prevPtr, *dcPtr;
    Interp *iPtr = (Interp *) interp;

    for (prevPtr = NULL, dcPtr = iPtr->deleteCallbackPtr;
	    dcPtr != NULL; prevPtr = dcPtr, dcPtr = dcPtr->nextPtr) {
	if ((dcPtr->proc != proc) || (dcPtr->clientData != clientData)) {
	    continue;
	}
	if (prevPtr == NULL) {
	    iPtr->deleteCallbackPtr = dcPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = dcPtr->nextPtr;
	}
	ckfree((char *) dcPtr);
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteInterp --
 *
 *	Delete an interpreter and free up all of the resources associated
 *	with it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The interpreter is destroyed.  The caller should never again
 *	use the interp token.
 *
 *----------------------------------------------------------------------
 */

void Tcl_DeleteInterp(interp)
     Tcl_Interp *interp;
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    register Command *cmdPtr;
    DeleteCallback *dcPtr;
    int i;

    /*
     * If the interpreter is in use -- i.e. if there are commands on the
     * execution stack -- delay the deletion until later
     */

    iPtr->flags |= DELETED;

    if (iPtr -> execution_stack.top != -1)
      return;

#ifdef TCL_STATE_HANDLERS

    /*
     * Delete the extension state:
     */

    for (hPtr = Tcl_FirstHashEntry(&iPtr -> extenState, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_RemoveState (interp, Tcl_GetHashKey(&iPtr -> extenState, hPtr));
    }

#endif

    /*
     * Invoke deletion callbacks.
     */

    while (iPtr->deleteCallbackPtr != NULL) {
	dcPtr = iPtr->deleteCallbackPtr;
	iPtr->deleteCallbackPtr = dcPtr->nextPtr;
	(*dcPtr->proc)(dcPtr->clientData, interp);
	ckfree((char *) dcPtr);
    }

    /*
     * Free up any remaining resources associated with the
     * interpreter.
     */

    for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
	if (cmdPtr->deleteProc != NULL) { 
	    (*cmdPtr->deleteProc)(cmdPtr->deleteData);
	}
	ckfree((char *) cmdPtr);
    }
    Tcl_DeleteHashTable(&iPtr->commandTable);
    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	ckfree((char *) Tcl_GetHashValue(hPtr));
    }
    Tcl_DeleteHashTable(&iPtr->mathFuncTable);
    TclDeleteVars(iPtr, &iPtr->globalTable);
    TclDeleteVars(iPtr, &iPtr->stateTable);
    /*
     * Free up the result *after* deleting variables, since variable
     * deletion could have transferred ownership of the result string
     * to Tcl.
     */

    Tcl_FreeResult(interp);
    if (iPtr->errorInfo != NULL) {
	ckfree(iPtr->errorInfo);
    }
    if (iPtr->errorCode != NULL) {
	ckfree(iPtr->errorCode);
    }

/* BEGIN MODIFICATION (RSG)
 * All history-list related code has been removed.
 * END MODIFICATION (RSG)
 */

    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
    }
    for (i = 0; i < NUM_REGEXPS; i++) 
    {
      if (iPtr->patterns[i] != NULL) 
      {
	ckfree(iPtr->patterns[i]);
	ckfree((char *) iPtr->regexps[i]);
      }
    }
    while (iPtr->tracePtr != NULL) {
	Trace *nextPtr = iPtr->tracePtr->nextPtr;

	ckfree((char *) iPtr->tracePtr);
	iPtr->tracePtr = nextPtr;
    }
    ckfree((char *) iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateCommand and Tcl_CreateIntCommand --
 *
 *	Define a new command in a command table.  Tcl_CreateCommand marks
 *      the command as non-interruptable -- i.e. a state image can not be
 *      taken from inside the command -- while Tcl_CreateIntCommand marks
 *	the command as non-interruptable.
 *
 * Results:
 *	The return value is a token for the command, which can
 *	be used in future calls to Tcl_NameOfCommand.
 *
 * 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.  When the command
 *	is deleted from the table, deleteProc will be called.  See the
 *	manual entry for details on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command TclCreateCommand (interp, cmdName, proc, clientData, deleteProc, commandFlag)
	Tcl_Interp *interp;            /* token for command interpreter     */
	char *cmdName;                 /* name of command                   */
	Tcl_CmdProc *proc;             /* command procedure                 */
	ClientData clientData;         /* one word value to pass to proc    */
	Tcl_CmdDeleteProc *deleteProc; /* NULL or deletion procedure        */
	unsigned char commandFlag;     /* command flags                     */
{
  Interp *iPtr = (Interp *) interp;
  register Command *cmdPtr;
  Tcl_HashEntry *hPtr;
  int new;

  hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);

  if (!new) {

      /* command already exists so delete the old one */

    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
    if (cmdPtr->deleteProc != NULL) {
      (*cmdPtr->deleteProc)(cmdPtr->deleteData);
    }

  } else {

      /* command is new so allocate space */

    cmdPtr = (Command *) ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
  }

    /* initialize the command */

  cmdPtr->hPtr        = hPtr;
  cmdPtr->proc        = proc;
  cmdPtr->clientData  = clientData;
  cmdPtr->deleteProc  = deleteProc;
  cmdPtr->deleteData  = clientData;
  cmdPtr->commandFlag = commandFlag;
  return (Tcl_Command) cmdPtr;
}
 
Tcl_Command Tcl_CreateCommand (interp, cmdName, proc, clientData, deleteProc)
	Tcl_Interp *interp;            /* token for command interpreter     */
	char *cmdName;                 /* name of command                   */
	Tcl_CmdProc *proc;             /* command procedure                 */
	ClientData clientData;         /* one word value to pass to proc    */
	Tcl_CmdDeleteProc *deleteProc; /* NULL or deletion procedure        */
{
  Tcl_Command command;

  command = TclCreateCommand 
		(interp, cmdName, proc, clientData, deleteProc, 0);

  return (command);
}

Tcl_Command Tcl_CreateIntCommand (interp, cmdName, proc, clientData, deleteProc)
	Tcl_Interp *interp;            /* token for command interpreter     */
	char *cmdName;                 /* name of command                   */
	Tcl_CmdProc *proc;             /* command procedure                 */
	ClientData clientData;         /* one word value to pass to proc    */
	Tcl_CmdDeleteProc *deleteProc; /* NULL or deletion procedure        */
{
  Tcl_Command command;

  command = TclCreateCommand
		(interp, cmdName, proc, clientData, deleteProc, TCL_INTERRUPT);

  return (command);
}  

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetCommandInfo --
 *
 *	Modifies various information about a Tcl command.
 *
 * 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 store information about
					 * command. */
{
    Tcl_HashEntry *hPtr;
    Command *cmdPtr;

    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
    if (hPtr == NULL) {
	return 0;
    }
    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
    cmdPtr->proc = infoPtr->proc;
    cmdPtr->clientData = infoPtr->clientData;
    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_HashEntry *hPtr;
    Command *cmdPtr;

    hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
    if (hPtr == NULL) {
	return 0;
    }
    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
    infoPtr->proc = cmdPtr->proc;
    infoPtr->clientData = cmdPtr->clientData;
    infoPtr->deleteProc = cmdPtr->deleteProc;
    infoPtr->deleteData = cmdPtr->deleteData;
    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 the command, returned by a
				 * previous call to Tcl_CreateCommand.
				 * The command must not have been deleted. */
{
    Command *cmdPtr = (Command *) command;
    Interp *iPtr = (Interp *) interp;

    return Tcl_GetHashKey(&iPtr->commandTable, cmdPtr->hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * 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 call to Tcl_CreateInterp). */
    char *cmdName;		/* Name of command to remove. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Command *cmdPtr;

    hPtr = Tcl_FindHashEntry(&iPtr->commandTable, cmdName);
    if (hPtr == NULL) {
	return -1;
    }
    cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
    if (cmdPtr->deleteProc != NULL) {
	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
    }
    ckfree((char *) cmdPtr);
    Tcl_DeleteHashEntry(hPtr);
    return 0;
}

/* BEGIN MODIFCATION (RSG)
 *
 * Tcl_Eval has moved to tclStackRun.c
 *
 */

/*
 *----------------------------------------------------------------------
 *
 * 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 the trace. */
    int level;			/* Only call proc for commands at nesting level
				 * <= level (1 => top level). */
    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
				 * command. */
    ClientData clientData;	/* Arbitrary one-word value to pass to proc. */
{
    register Trace *tracePtr;
    register Interp *iPtr = (Interp *) interp;

    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);
		return;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddErrorInfo --
 *
 *	Add information to a message being accumulated 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.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddErrorInfo(interp, message)
    Tcl_Interp *interp;		/* Interpreter to which error information
				 * pertains. */
    char *message;		/* Message to record. */
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * If an error is already being logged, then the new errorInfo
     * is the concatenation of the old info and the new message.
     * If this is the first piece of info for the error, then the
     * new errorInfo is the concatenation of the message in
     * interp->result and the new message.
     */

    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
	Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
		TCL_GLOBAL_ONLY);
	iPtr->flags |= ERR_IN_PROGRESS;

	/*
	 * 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);
	}
    }
    Tcl_SetVar2(interp, "errorInfo", (char *) NULL, message,
	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
}

/*
 *----------------------------------------------------------------------
 *
 * 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
#ifndef lint
Tcl_VarEval(va_alist)
#else
Tcl_VarEval(iPtr, p, va_alist)
    Tcl_Interp *iPtr;		/* Interpreter in which to execute command. */
    char *p;			/* One or more strings to concatenate,
				 * terminated with a NULL string. */
#endif
    va_dcl
{
    va_list argList;
#define FIXED_SIZE 200
    char fixedSpace[FIXED_SIZE+1];
    int spaceAvl, spaceUsed, length;
    char *string, *cmd;
    Tcl_Interp *interp;
    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.
     */

    va_start(argList);
    interp = va_arg(argList, Tcl_Interp *);
    spaceAvl = FIXED_SIZE;
    spaceUsed = 0;
    cmd = fixedSpace;
    while (1) {
	string = va_arg(argList, char *);
	if (string == NULL) {
	    break;
	}
	length = strlen(string);
	if ((spaceUsed + length) > spaceAvl) {
	    char *new;

	    spaceAvl = spaceUsed + length;
	    spaceAvl += spaceAvl/2;
	    new = ckalloc((unsigned) spaceAvl);
	    memcpy((VOID *) new, (VOID *) cmd, (size_t) spaceUsed);
	    if (cmd != fixedSpace) {
		ckfree(cmd);
	    }
	    cmd = new;
	}
	strcpy(cmd + spaceUsed, string);
	spaceUsed += length;
    }
    va_end(argList);
    cmd[spaceUsed] = '\0';

    result = Tcl_Eval(interp, cmd);
    if (cmd != fixedSpace) {
	ckfree(cmd);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalEval --
 *
 *	Evaluate a command at global level in an interpreter.
 *
 * Results:
 *	A standard Tcl result is returned, and interp->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;
}

/* BEGIN MODIFICATION (RSG)
 * Tcl_AllowExceptions has been moved to tclStackRun.c
 * END MODIFICATION (RSG)
 */
