tclInterp.c

/* 
 * tclInterp.c --
 *
 *	This file implements the "interp" command which allows creation
 *	and manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclInterp.c 1.79 96/09/20 17:20:16
 */

#include <ast.h>
#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"

/*
 * Counter for how many aliases were created (global)
 */

static int aliasCounter = 0;

/*
 *
 * struct Slave:
 *
 * Used by the "interp" command to record and find information about slave
 * interpreters. Maps from a command name in the master to information about
 * a slave interpreter, e.g. what aliases are defined in it.
 */

typedef struct {
    Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */
    Tcl_HashEntry *slaveEntry;	/* Hash entry in masters slave table for
                                 * this slave interpreter. Used to find
                                 * this record, and used when deleting the
                                 * slave interpreter to delete it from the
                                 * masters table. */
    Tcl_Interp	*slaveInterp;	/* The slave interpreter. */
    Tcl_Command interpCmd;	/* Interpreter object command. */
    Tcl_HashTable aliasTable;	/* Table which maps from names of commands
                                 * in slave interpreter to struct Alias
                                 * defined below. */
} Slave;

/*
 * struct Alias:
 *
 * Stores information about an alias. Is stored in the slave interpreter
 * and used by the source command to find the target command in the master
 * when the source command is invoked.
 */

typedef struct {
    char	*aliasName;	/* Name of alias command. */
    char	*targetName;	/* Name of target command in master interp. */
    Tcl_Interp	*targetInterp;	/* Master interpreter. */
    int		argc;		/* Count of additional args to pass. */
    char	**argv;		/* Actual additional args to pass. */    
    Tcl_HashEntry *aliasEntry;	/* Entry for the alias hash table in slave.
                                 * This is used by alias deletion to remove
                                 * the alias from the slave interpreter
                                 * alias table. */
    Tcl_HashEntry *targetEntry;	/* Entry for target command in master.
                                 * This is used in the master interpreter to
                                 * map back from the target command to aliases
                                 * redirecting to it. Random access to this
                                 * hash table is never required - we are using
                                 * a hash table only for convenience. */
    Tcl_Command slaveCmd;	/* Source command in slave interpreter. */
} Alias;

/*
 * struct Target:
 *
 * Maps from master interpreter commands back to the source commands in slave
 * interpreters. This is needed because aliases can be created between sibling
 * interpreters and must be deleted when the target interpreter is deleted. In
 * case they would not be deleted the source interpreter would be left with a
 * "dangling pointer". One such record is stored in the Master record of the
 * master interpreter (in the targetTable hashtable, see below) with the
 * master for each alias which directs to a command in the master. These
 * records are used to remove the source command for an from a slave if/when
 * the master is deleted.
 */

typedef struct {
    Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */
    Tcl_Interp *slaveInterp;	/* Slave Interpreter. */
} Target;

/*
 * struct Master:
 *
 * This record is used for three purposes: First, slaveTable (a hashtable)
 * maps from names of commands to slave interpreters. This hashtable is
 * used to store information about slave interpreters of this interpreter,
 * to map over all slaves, etc. The second purpose is to store information
 * about all aliases in slaves (or siblings) which direct to target commands
 * in this interpreter (using the targetTable hashtable). The third field in
 * the record, isSafe, denotes whether the interpreter is safe or not. Safe
 * interpreters have restricted functionality, can only create safe slave
 * interpreters and can only load safe extensions.
 */

typedef struct {
    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.
                                 * Maps from command names to Slave records. */
    int isSafe;			/* Am I a "safe" interpreter? */
    Tcl_HashTable targetTable;	/* Hash table for Target Records. Contains
                                 * all Target records which denote aliases
                                 * from slaves or sibling interpreters that
                                 * direct to commands in this interpreter. This
                                 * table is used to remove dangling pointers
                                 * from the slave (or sibling) interpreters
                                 * when this interpreter is deleted. */
} Master;

/*
 * Prototypes for local static procedures:
 */

static int		AliasCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *currentInterp, int argc, char **argv));
static void		AliasCmdDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
static int		AliasHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
			    Master *masterPtr, char *aliasName,
			    char *targetName, int argc, char **argv));
static int		CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
			   int argc, char **argv));
static Tcl_Interp	*CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
			    char *slavePath, int safe));
static int		DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, char *aliasName));
static int		DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, char *aliasName));
static int		DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv));
static int		DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
		            char *path));
static Tcl_Interp	*GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, char *path,
			    Master **masterPtrPtr));
static int		GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
			    char *aliasName));
static void		MasterRecordDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static int		MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
static int		SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    int argc, char **argv));
static int		SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int argc, char **argv));
static void		SlaveObjectDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
static void		SlaveRecordDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));

/*
 * These are all the Tcl core commands which are available in a safe
 * interpeter:
 */

static char *TclCommandsToKeep[] = {
    "after", "append", "array",
    "break",
    "case", "catch", "clock", "close", "concat", "continue",
    "eof", "error", "eval", "expr",
    "fblocked", "fileevent", "flush", "for", "foreach", "format",
    "gets", "global",
    "history",
    "if", "incr", "info", "interp",
    "join",
    "lappend", "lindex", "linsert", "list", "llength",
    "lower", "lrange", "lreplace", "lsearch", "lsort",
    "package", "pid", "proc", "puts",
    "read", "regexp", "regsub", "rename", "return",
    "scan", "seek", "set", "split", "string", "subst", "switch",
    "tell", "time", "trace",
    "unset", "unsupported0", "update", "uplevel", "upvar",
    "vwait",
    "while",
    NULL};
static int TclCommandsToKeepCt =
	(sizeof (TclCommandsToKeep) / sizeof (char *)) -1 ;

/*
 *----------------------------------------------------------------------
 *
 * TclPreventAliasLoop --
 *
 *	When defining an alias or renaming a command, prevent an alias
 *	loop from being formed.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If TCL_ERROR is returned, the function also sets interp->result
 *	to an error message.
 *
 * NOTE:
 *	This function is public internal (instead of being static to
 *	this file) because it is also used from Tcl_RenameCmd.
 *
 *----------------------------------------------------------------------
 */

int
TclPreventAliasLoop(interp, cmdInterp, cmdName, proc, clientData)
    Tcl_Interp *interp;			/* Interp in which to report errors. */
    Tcl_Interp *cmdInterp;		/* Interp in which the command is
                                         * being defined. */
    char *cmdName;			/* Name of Tcl command we are
                                         * attempting to define. */
    Tcl_CmdProc *proc;			/* The command procedure for the
                                         * command being created. */
    ClientData clientData;		/* The client data associated with the
                                         * command to be created. */
{
    Alias *aliasPtr, *nextAliasPtr;
    Tcl_CmdInfo cmdInfo;
    
    /*
     * If we are not creating or renaming an alias, then it is
     * always OK to create or rename the command.
     */
    
    if (proc != AliasCmd) {
        return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases.
     * If we encounter the alias we are defining (or renaming to) any in
     * the chain then we have a loop.
     */

    aliasPtr = (Alias *) clientData;
    nextAliasPtr = aliasPtr;
    while (1) {

        /*
         * If the target of the next alias in the chain is the same as the
         * source alias, we have a loop.
         */
        
        if ((strcmp(nextAliasPtr->targetName, cmdName) == 0) &&
                (nextAliasPtr->targetInterp == cmdInterp)) {
            Tcl_AppendResult(interp, "cannot define or rename alias \"",
                    aliasPtr->aliasName, "\": would create a loop",
                    (char *) NULL);
            return TCL_ERROR;
        }

        /*
         * Otherwise, follow the chain one step further. If the target
         * command is undefined then there is no loop.
         */
        
        if (Tcl_GetCommandInfo(nextAliasPtr->targetInterp,
                nextAliasPtr->targetName, &cmdInfo) == 0) {
            return TCL_OK;
        }

        /*
         * See if the target command is an alias - if so, follow the
         * loop to its target command. Otherwise we do not have a loop.
         */

        if (cmdInfo.proc != AliasCmd) {
            return TCL_OK;
        }
        nextAliasPtr = (Alias *) cmdInfo.clientData;
    }

    /* NOTREACHED */
}

/*
 *----------------------------------------------------------------------
 *
 * MakeSafe --
 *
 *	Makes its argument interpreter contain only functionality that is
 *	defined to be part of Safe Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Removes commands from its argument interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
MakeSafe(interp)
    Tcl_Interp *interp;		/* Interpreter to be made safe. */
{
    char **argv;				/* Args for Tcl_Eval. */
    int argc, keep, i, j;			/* Loop indices. */
    char *cmdGetGlobalCmds = "info commands";	/* What command to run. */
    char *cmdNoEnv = "unset env";		/* How to get rid of env. */
    Master *masterPtr;				/* Master record of interp
                                                 * to be made safe. */
    Tcl_Channel chan;				/* Channel to remove from
                                                 * safe interpreter. */

    /*
     * Below, Tcl_Eval sets interp->result, so we do not.
     */

    Tcl_ResetResult(interp);
    if ((Tcl_Eval(interp, cmdGetGlobalCmds) == TCL_ERROR) ||
            (Tcl_SplitList(interp, interp->result, &argc, &argv) != TCL_OK)) {
        return TCL_ERROR;
    }
    for (i = 0; i < argc; i++) {
        for (keep = 0, j = 0; j < TclCommandsToKeepCt; j++) {
            if (strcmp(TclCommandsToKeep[j], argv[i]) == 0) {
                keep = 1;
                break;
            }
        }
        if (keep == 0) {
            (void) Tcl_DeleteCommand(interp, argv[i]);
        }
    }
    ckfree((char *) argv);
    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
            NULL);
    if (masterPtr == (Master *) NULL) {
        panic("MakeSafe: could not find master record");
    }
    masterPtr->isSafe = 1;
    if (Tcl_Eval(interp, cmdNoEnv) == TCL_ERROR) {
        return TCL_ERROR;
    }

    /*
     * Remove the standard channels from the interpreter; safe interpreters
     * do not ordinarily have access to stdin, stdout and stderr.
     *
     * NOTE: These channels are not added to the interpreter by the
     * Tcl_CreateInterp call, but may be added later, by another I/O
     * operation. We want to ensure that the interpreter does not have
     * these channels even if it is being made safe after being used for
     * some time..
     */

    chan = Tcl_GetStdChannel(TCL_STDIN);
    if (chan != (Tcl_Channel) NULL) {
        Tcl_UnregisterChannel(interp, chan);
    }
    chan = Tcl_GetStdChannel(TCL_STDOUT);
    if (chan != (Tcl_Channel) NULL) {
        Tcl_UnregisterChannel(interp, chan);
    }
    chan = Tcl_GetStdChannel(TCL_STDERR);
    if (chan != (Tcl_Channel) NULL) {
        Tcl_UnregisterChannel(interp, chan);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetInterp --
 *
 *	Helper function to find a slave interpreter given a pathname.
 *
 * Results:
 *	Returns the slave interpreter known by that name in the calling
 *	interpreter, or NULL if no interpreter known by that name exists. 
 *
 * Side effects:
 *	Assigns to the pointer variable passed in, if not NULL.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Interp *
GetInterp(interp, masterPtr, path, masterPtrPtr)
    Tcl_Interp *interp;		/* Interp. to start search from. */
    Master *masterPtr;		/* Its master record. */
    char *path;			/* The path (name) of interp. to be found. */
    Master **masterPtrPtr;	/* (Return) its master record. */
{
    Tcl_HashEntry *hPtr;	/* Search element. */
    Slave *slavePtr;		/* Interim slave record. */
    char **argv;		/* Split-up path (name) for interp to find. */
    int argc, i;		/* Loop indices. */
    Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */

    if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
    
    if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
        return (Tcl_Interp *) NULL;
    }

    for (searchInterp = interp, i = 0; i < argc; i++) {
        
        hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
        if (hPtr == (Tcl_HashEntry *) NULL) {
            ckfree((char *) argv);
            return (Tcl_Interp *) NULL;
        }
        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
        searchInterp = slavePtr->slaveInterp;
        if (searchInterp == (Tcl_Interp *) NULL) {
            ckfree((char *) argv);
            return (Tcl_Interp *) NULL;
        }
        masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
                "tclMasterRecord", NULL);
        if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
        if (masterPtr == (Master *) NULL) {
            ckfree((char *) argv);
            return (Tcl_Interp *) NULL;
        }
    }
    ckfree((char *) argv);
    return searchInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSlave --
 *
 *	Helper function to do the actual work of creating a slave interp
 *	and new object command. Also optionally makes the new slave
 *	interpreter "safe".
 *
 * Results:
 *	Returns the new Tcl_Interp * if successful or NULL if not. If failed,
 *	the result of the invoking interpreter contains an error message.
 *
 * Side effects:
 *	Creates a new slave interpreter and a new object command.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Interp *
CreateSlave(interp, slavePath, safe)
    Tcl_Interp *interp;			/* Interp. to start search from. */
    char *slavePath;			/* Path (name) of slave to create. */
    int safe;				/* Should we make it "safe"? */
{
    Master *masterPtr;			/* Master record. */
    Tcl_Interp *slaveInterp;		/* Ptr to slave interpreter. */
    Tcl_Interp *masterInterp;		/* Ptr to master interp for slave. */
    Slave *slavePtr;			/* Slave record. */
    Tcl_HashEntry *hPtr;		/* Entry into interp hashtable. */
    int new;				/* Indicates whether new entry. */
    int argc;				/* Count of elements in slavePath. */
    char **argv;			/* Elements in slavePath. */
    char *masterPath;			/* Path to its master. */

    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
            NULL); 
    if (masterPtr == (Master *) NULL) {
        panic("CreatSlave: could not find master record");
    }

    if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
        return (Tcl_Interp *) NULL;
    }

    if (argc < 2) {
        masterInterp = interp;
        if (argc == 1) {
            slavePath = argv[0];
        }
    } else {
        masterPath = Tcl_Merge(argc-1, argv);
        masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
        if (masterInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "interpreter named \"", masterPath,
                    "\" not found", (char *) NULL);
            ckfree((char *) argv);
            ckfree((char *) masterPath);
            return (Tcl_Interp *) NULL;
        }
        ckfree((char *) masterPath);
        slavePath = argv[argc-1];
        if (!safe) {
            safe = masterPtr->isSafe;
        }
    }
    hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
    if (new == 0) {
        Tcl_AppendResult(interp, "interpreter named \"", slavePath,
                "\" already exists, cannot create", (char *) NULL);
        ckfree((char *) argv);
        return (Tcl_Interp *) NULL;
    }
    slaveInterp = Tcl_CreateInterp();
    if (slaveInterp == (Tcl_Interp *) NULL) {
        panic("CreateSlave: out of memory while creating a new interpreter");
    }
    slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
    slavePtr->masterInterp = masterInterp;
    slavePtr->slaveEntry = hPtr;
    slavePtr->slaveInterp = slaveInterp;
    slavePtr->interpCmd = Tcl_CreateCommand(masterInterp, slavePath,
            SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
    Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
    (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
            SlaveRecordDeleteProc, (ClientData) slavePtr);
    Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
    Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
    
    if (((safe) && (MakeSafe(slaveInterp) == TCL_ERROR)) ||
            ((!safe) && (Tcl_Init(slaveInterp) == TCL_ERROR))) {
        Tcl_ResetResult(interp);
        Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
                NULL, TCL_GLOBAL_ONLY));
        Tcl_SetVar2(interp, "errorCode", (char *) NULL,
                Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
                        TCL_GLOBAL_ONLY),
                TCL_GLOBAL_ONLY);
        if (slaveInterp->freeProc != NULL) {
            interp->result = slaveInterp->result;
            interp->freeProc = slaveInterp->freeProc;
            slaveInterp->freeProc = 0;
        } else {
            Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
        }
        Tcl_ResetResult(slaveInterp);
        (void) Tcl_DeleteCommand(masterInterp, slavePath);
        slaveInterp = (Tcl_Interp *) NULL;
    }
    ckfree((char *) argv);
    return slaveInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateInterpObject -
 *
 *	Helper function to do the actual work of creating a new interpreter
 *	and an object command. 
 *
 * Results:
 *	A Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
CreateInterpObject(interp, argc, argv)
    Tcl_Interp *interp;			/* Invoking interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int safe;				/* Create a safe interpreter? */
    Master *masterPtr;			/* Master record. */
    int moreFlags;			/* Expecting more flag args? */
    char *slavePath;			/* Name of slave. */
    char localSlaveName[200];		/* Local area for creating names. */
    int i;				/* Loop counter. */
    size_t len;				/* Length of option argument. */
    static int interpCounter = 0;	/* Unique id for created names. */

    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL); 
    if (masterPtr == (Master *) NULL) {
        panic("CreateInterpObject: could not find master record");
    }
    moreFlags = 1;
    slavePath = NULL;
    safe = masterPtr->isSafe;
    
    if (argc < 2 || argc > 5) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " create ?-safe? ?--? ?path?\"", (char *) NULL);
        return TCL_ERROR;
    }
    for (i = 2; i < argc; i++) {
        len = strlen(argv[i]);
        if ((argv[i][0] == '-') && (moreFlags != 0)) {
            if ((argv[i][1] == 's') && (strncmp(argv[i], "-safe", len) == 0)
                && (len > 1)){
                safe = 1;
            } else if ((strncmp(argv[i], "--", len) == 0) && (len > 1)) {
                moreFlags = 0;
            } else {
                Tcl_AppendResult(interp, "bad option \"", argv[i],
                        "\": should be -safe", (char *) NULL);
                return TCL_ERROR;
            }
        } else {
            slavePath = argv[i];
        }
    }
    if (slavePath == (char *) NULL) {
        sprintf(localSlaveName, "interp%d", interpCounter);
        interpCounter++;
        slavePath = localSlaveName;
    }
    if (CreateSlave(interp, slavePath, safe) != NULL) {
        Tcl_AppendResult(interp, slavePath, (char *) NULL);
        return TCL_OK;
    } else {
        /*
         * CreateSlave already set interp->result if there was an error,
         * so we do not do it here.
         */
        return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteOneInterpObject --
 *
 *	Helper function for DeleteInterpObject. It deals with deleting one
 *	interpreter at a time.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes an interpreter and its interpreter object command.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteOneInterpObject(interp, path)
    Tcl_Interp *interp;			/* Interpreter for reporting errors. */
    char *path;				/* Path of interpreter to delete. */
{
    Master *masterPtr;			/* Interim storage for master record.*/
    Slave *slavePtr;			/* Interim storage for slave record. */
    Tcl_Interp *masterInterp;		/* Master of interp. to delete. */
    Tcl_HashEntry *hPtr;		/* Search element. */
    int localArgc;			/* Local copy of count of elements in
                                         * path (name) of interp. to delete. */
    char **localArgv;			/* Local copy of path. */
    char *slaveName;			/* Last component in path. */
    char *masterPath;			/* One-before-last component in path.*/

    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("DeleteInterpObject: could not find master record");
    }
    if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
        Tcl_AppendResult(interp, "bad interpreter path \"", path,
                "\"", (char *) NULL);
        return TCL_ERROR;
    }
    if (localArgc < 2) {
        masterInterp = interp;
        if (localArgc == 0) {
            slaveName = "";
        } else {
            slaveName = localArgv[0];
        }
    } else {
        masterPath = Tcl_Merge(localArgc-1, localArgv);
        masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
        if (masterInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "interpreter named \"", masterPath,
                    "\" not found", (char *) NULL);
            ckfree((char *) localArgv);
            ckfree((char *) masterPath);
            return TCL_ERROR;
        }
        ckfree((char *) masterPath);
        slaveName = localArgv[localArgc-1];
    }
    hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        ckfree((char *) localArgv);
        Tcl_AppendResult(interp, "interpreter named \"", path,
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
    slaveName = Tcl_GetCommandName(masterInterp, slavePtr->interpCmd);
    if (Tcl_DeleteCommand(masterInterp, slaveName) != 0) {
        ckfree((char *) localArgv);
        Tcl_AppendResult(interp, "interpreter named \"", path,
                "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    ckfree((char *) localArgv);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteInterpObject --
 *
 *	Helper function to do the work of deleting zero or more
 *	interpreters and their interpreter object commands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes interpreters and their interpreter object command.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteInterpObject(interp, argc, argv)
    Tcl_Interp *interp;			/* Interpreter start search from. */
    int argc;				/* Number of arguments in vector. */
    char **argv;			/* Contains path to interps to
                                         * delete. */
{
    int i;
    
    for (i = 2; i < argc; i++) {
        if (DeleteOneInterpObject(interp, argv[i]) != TCL_OK) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasHelper --
 *
 *	Helper function to do the work to actually create an alias or
 *	delete an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	An alias command is created and entered into the alias table
 *	for the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
     aliasName, targetName, argc, argv)
    Tcl_Interp *curInterp;		/* Interp that invoked this proc. */
    Tcl_Interp *slaveInterp;		/* Interp where alias cmd will live
                                         * or from which alias will be
                                         * deleted. */
    Tcl_Interp *masterInterp;		/* Interp where target cmd will be. */
    Master *masterPtr;			/* Master record for target interp. */
    char *aliasName;			/* Name of alias cmd. */
    char *targetName;			/* Name of target cmd. */
    int argc;				/* Additional arguments to store */
    char **argv;			/* with alias. */
{
    Alias *aliasPtr;			/* Storage for alias data. */
    Alias *tmpAliasPtr;			/* Temp storage for alias to delete. */
    char *tmpAliasName;			/* Temp storage for name of alias
                                         * to delete. */
    Tcl_HashEntry *hPtr;		/* Entry into interp hashtable. */
    int i;				/* Loop index. */
    int new;				/* Is it a new hash entry? */
    Target *targetPtr;			/* Maps from target command in master
                                         * to source command in slave. */
    Slave *slavePtr;			/* Maps from source command in slave
                                         * to target command in master. */

    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);

    /*
     * Fix it up if there is no slave record. This can happen if someone
     * uses "" as the source for an alias.
     */
    
    if (slavePtr == (Slave *) NULL) {
        slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
        slavePtr->masterInterp = (Tcl_Interp *) NULL;
        slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
        slavePtr->slaveInterp = slaveInterp;
        slavePtr->interpCmd = (Tcl_Command) NULL;
        Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
        (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
                SlaveRecordDeleteProc, (ClientData) slavePtr);
    }

    if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
        if (argc != 0) {
            Tcl_AppendResult(curInterp, "malformed command: should be",
                " \"alias ",  aliasName, " {}\"", (char *) NULL);
            return TCL_ERROR;
        }

        return DeleteAlias(curInterp, slaveInterp, aliasName);
    }
    
    aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
    aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
    aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
    strcpy(aliasPtr->aliasName, aliasName);
    strcpy(aliasPtr->targetName, targetName);
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->argv = (char **) NULL;
    aliasPtr->argc = argc;
    if (aliasPtr->argc > 0) {
        aliasPtr->argv = (char **) ckalloc((unsigned) sizeof(char *) *
                aliasPtr->argc);
        for (i = 0; i < argc; i++) {
            aliasPtr->argv[i] = (char *) ckalloc((unsigned) strlen(argv[i])+1);
            strcpy(aliasPtr->argv[i], argv[i]);
        }
    }

    if (TclPreventAliasLoop(curInterp, slaveInterp, aliasName, AliasCmd,
            (ClientData) aliasPtr) != TCL_OK) {
        for (i = 0; i < argc; i++) {
            ckfree(aliasPtr->argv[i]);
        }
        if (aliasPtr->argv != (char **) NULL) {
            ckfree((char *) aliasPtr->argv);
        }
        ckfree(aliasPtr->aliasName);
        ckfree(aliasPtr->targetName);
        ckfree((char *) aliasPtr);
        
        return TCL_ERROR;
    }
    
    aliasPtr->slaveCmd = Tcl_CreateCommand(slaveInterp, aliasName, AliasCmd,
            (ClientData) aliasPtr, AliasCmdDeleteProc);

    /*
     * Make an entry in the alias table. If it already exists delete
     * the alias command. Then retry.
     */

    do {
        hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
        if (new == 0) {
            tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
            tmpAliasName = Tcl_GetCommandName(slaveInterp,
                    tmpAliasPtr->slaveCmd);
            (void) Tcl_DeleteCommand(slaveInterp, tmpAliasName);

            /*
             * The hash entry should be deleted by the Tcl_DeleteCommand
             * above, in its command deletion callback (most likely this
             * will be AliasCmdDeleteProc, which does the deletion).
             */
        }
    } while (new == 0);
    aliasPtr->aliasEntry = hPtr;
    Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
    
    /*
     * Create the new command. We must do it after deleting any old command,
     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    do {
        hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
                (char *) aliasCounter, &new);
	aliasCounter++;
    } while (new == 0);

    Tcl_SetHashValue(hPtr, (ClientData) targetPtr);

    aliasPtr->targetEntry = hPtr;

    curInterp->result = aliasPtr->aliasName;
            
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveAliasHelper -
 *
 *	Handles the different forms of the "interp alias" command:
 *	- interp alias slavePath aliasName
 *		Describes an alias.
 *	- interp alias slavePath aliasName {}
 *		Deletes an alias.
 *	- interp alias slavePath srcCmd masterPath targetCmd args...
 *		Creates an alias.
 *
 * Results:
 *	A Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
SlaveAliasHelper(interp, argc, argv)
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Master *masterPtr;			/* Master record for current interp. */
    Tcl_Interp *slaveInterp,		/* Interpreters used when */
        *masterInterp;			/* creating an alias btn siblings. */
    Master *masterMasterPtr;		/* Master record for master interp. */

    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("SlaveAliasHelper: could not find master record");
    }
    if (argc < 4) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
                (char *) NULL);
        return TCL_ERROR;
    }
    slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendResult(interp, "could not find interpreter \"",
            argv[2], "\"", (char *) NULL);
        return TCL_ERROR;
    }
    if (argc == 4) {
        return DescribeAlias(interp, slaveInterp, argv[3]);
    }
    if (argc == 5 && strcmp(argv[4], "") == 0) {
        return DeleteAlias(interp, slaveInterp, argv[3]);
    }
    if (argc < 6) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
                (char *) NULL);
        return TCL_ERROR;
    }
    masterInterp = GetInterp(interp, masterPtr, argv[4], &masterMasterPtr);
    if (masterInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendResult(interp, "could not find interpreter \"",
            argv[4], "\"", (char *) NULL);
        return TCL_ERROR;
    }
    return AliasHelper(interp, slaveInterp, masterInterp, masterMasterPtr,
            argv[3], argv[5], argc-6, argv+6);
}

/*
 *----------------------------------------------------------------------
 *
 * DescribeAlias --
 *
 *	Sets interp->result to a Tcl list describing the given alias in the
 *	given interpreter: its target command and the additional arguments
 *	to prepend to any invocation of the alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DescribeAlias(interp, slaveInterp, aliasName)
    Tcl_Interp *interp;		/* Interpreter for result and errors. */
    Tcl_Interp *slaveInterp;	/* Interpreter defining alias. */
    char *aliasName;		/* Name of alias to describe. */
{
    Slave *slavePtr;		/* Slave record for slave interpreter. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Alias *aliasPtr;		/* Structure describing alias. */
    int i;			/* Loop variable. */

    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
            NULL);
    if (slavePtr == (Slave *) NULL) {

        /*
         * It's possible that the interpreter still does not have a slave
         * record. If so, create such a record now. This is only possible
         * for interpreters that were created with Tcl_CreateInterp, not
         * those created with Tcl_CreateSlave, so this interpreter does
         * not have a master.
         */
        
        slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
        slavePtr->masterInterp = (Tcl_Interp *) NULL;
        slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
        slavePtr->slaveInterp = slaveInterp;
        slavePtr->interpCmd = (Tcl_Command) NULL;
        Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
        (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
                SlaveRecordDeleteProc, (ClientData) slavePtr);
    }
    hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        return TCL_OK;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    Tcl_AppendResult(interp, aliasPtr->targetName, (char *) NULL);
    for (i = 0; i < aliasPtr->argc; i++) {
        Tcl_AppendElement(interp, aliasPtr->argv[i]);
    }
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteAlias --
 *
 *	Deletes the given alias from the slave interpreter given.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes the alias from the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
DeleteAlias(interp, slaveInterp, aliasName)
    Tcl_Interp *interp;		/* Interpreter for result and errors. */
    Tcl_Interp *slaveInterp;	/* Interpreter defining alias. */
    char *aliasName;		/* Name of alias to delete. */
{
    Slave *slavePtr;		/* Slave record for slave interpreter. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Alias *aliasPtr;		/* Structure describing alias to delete. */

    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
            NULL);
    if (slavePtr == (Slave *) NULL) {
        Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
                (char *) NULL);
        return TCL_ERROR;
    }
    
    /*
     * Get the alias from the alias table, determine the current
     * true name of the alias (it may have been renamed!) and then
     * delete the true command name. The deleteProc on the alias
     * command will take care of removing the entry from the alias
     * table.
     */

    hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
                (char *) NULL);
        return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    aliasName = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);

    /*
     * NOTE: The deleteProc for this command will delete the
     * alias from the hash table. The deleteProc will also
     * delete the target information from the master interpreter
     * target table.
     */

    if (Tcl_DeleteCommand(slaveInterp, aliasName) != 0) {
        panic("DeleteAlias: did not find alias to be deleted");
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInterpPath --
 *
 *	Sets the result of the asking interpreter to a proper Tcl list
 *	containing the names of interpreters between the asking and
 *	target interpreters. The target interpreter must be either the
 *	same as the asking interpreter or one of its slaves (including
 *	recursively).
 *
 * Results:
 *	TCL_OK if the target interpreter is the same as, or a descendant
 *	of, the asking interpreter; TCL_ERROR else. This way one can
 *	distinguish between the case where the asking and target interps
 *	are the same (an empty list is the result, and TCL_OK is returned)
 *	and when the target is not a descendant of the asking interpreter
 *	(in which case the Tcl result is an error message and the function
 *	returns TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetInterpPath(askingInterp, targetInterp)
    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
    Tcl_Interp *targetInterp;	/* Interpreter to find. */
{
    Master *masterPtr;		/* Interim storage for Master record. */
    Slave *slavePtr;		/* Interim storage for Slave record. */
    
    if (targetInterp == askingInterp) {
        return TCL_OK;
    }
    if (targetInterp == (Tcl_Interp *) NULL) {
        return TCL_ERROR;
    }
    slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
            NULL);
    if (slavePtr == (Slave *) NULL) {
        return TCL_ERROR;
    }
    if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
        /*
         * AskingInterp->result was set by recursive call.
         */
        return TCL_ERROR;
    }
    masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
            "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("Tcl_GetInterpPath: could not find master record");
    }
    Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
            slavePtr->slaveEntry));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetTarget --
 *
 *	Sets the result of the invoking interpreter to a path name for
 *	the target interpreter of an alias in one of the slaves.
 *
 * Results:
 *	TCL_OK if the target interpreter of the alias is a slave of the
 *	invoking interpreter, TCL_ERROR else.
 *
 * Side effects:
 *	Sets the result of the invoking interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
GetTarget(askingInterp, path, aliasName)
    Tcl_Interp *askingInterp;	/* Interpreter to start search from. */
    char *path;			/* The path of the interp to find. */
    char *aliasName;		/* The target of this allias. */
{
    Tcl_Interp *slaveInterp;	/* Interim storage for slave. */
    Slave *slaveSlavePtr;	/* Its Slave record. */
    Master *masterPtr;		/* Interim storage for Master record. */
    Tcl_HashEntry *hPtr;	/* Search element. */
    Alias *aliasPtr;		/* Data describing the alias. */

    Tcl_ResetResult(askingInterp);

    masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
            NULL);
    if (masterPtr == (Master *) NULL) {
        panic("GetTarget: could not find master record");
    }
    slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
    if (slaveInterp == (Tcl_Interp *) NULL) {
        Tcl_AppendResult(askingInterp, "could not find interpreter \"",
            path, "\"", (char *) NULL);
        return TCL_ERROR;
    }
    slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
            NULL);
    if (slaveSlavePtr == (Slave *) NULL) {
        panic("GetTarget: could not find slave record");
    }
    hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        Tcl_AppendResult(askingInterp, "alias \"", aliasName, "\" in path \"",
                path, "\" not found", (char *) NULL);
        return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    if (aliasPtr == (Alias *) NULL) {
        panic("GetTarget: could not find alias record");
    }
    if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
        Tcl_ResetResult(askingInterp);
        Tcl_AppendResult(askingInterp, "target interpreter for alias \"",
                aliasName, "\" in path \"", path, "\" is not my descendant",
                (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpCmd --
 *
 *	This procedure is invoked to process the "interp" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
int
Tcl_InterpCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Unused. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Tcl_Interp *slaveInterp;		/* A slave. */
    Tcl_Interp *masterInterp;		/* A master. */
    Master *masterPtr;			/* Master record for current interp. */
    Slave *slavePtr;			/* Record for slave interp. */
    Tcl_HashEntry *hPtr;		/* Search variable. */
    Tcl_HashSearch hSearch;		/* Iteration variable. */
    size_t len;				/* Length of command name. */
    int result;				/* Result of eval. */
    char *cmdName;			/* Name of sub command to do. */
    char *cmd;				/* Command to eval. */
    Tcl_Channel chan;			/* Channel to share or transfer. */

    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " cmd ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }
    cmdName = argv[1];

    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("Tcl_InterpCmd: could not find master record");
    }

    len = strlen(cmdName);
    
    if (cmdName[0] == 'a') {
        if ((strncmp(cmdName, "alias", len) == 0) && (len <= 5)) {
            return SlaveAliasHelper(interp, argc, argv);
        }

        if (strcmp(cmdName, "aliases") == 0) {
            if (argc != 2 && argc != 3) {
                Tcl_AppendResult(interp, "wrong # args: should be \"",
                        argv[0], " aliases ?path?\"", (char *) NULL);
                return TCL_ERROR;
            }
            if (argc == 3) {
                slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
                if (slaveInterp == (Tcl_Interp *) NULL) {
                    Tcl_AppendResult(interp, "interpreter \"",
                            argv[2], "\" not found", (char *) NULL);
                    return TCL_ERROR;
                }
            } else {
                slaveInterp = interp;
            }
            slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
                    "tclSlaveRecord", NULL);
            if (slavePtr == (Slave *) NULL) {
                return TCL_OK;
            }
            for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
                 hPtr != NULL;
                 hPtr = Tcl_NextHashEntry(&hSearch)) {
                Tcl_AppendElement(interp,
                        Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr));
            }
            return TCL_OK;
        }
    }

    if ((cmdName[0] == 'c') && (strncmp(cmdName, "create", len) == 0)) {
        return CreateInterpObject(interp, argc, argv);
    }

    if ((cmdName[0] == 'd') && (strncmp(cmdName, "delete", len) == 0)) {
        return DeleteInterpObject(interp, argc, argv);
    }

    if (cmdName[0] == 'e') {
        if ((strncmp(cmdName, "eval", len) == 0) && (len > 1)) {
            if (argc < 4) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " eval path arg ?arg ...?\"", (char *) NULL);
                return TCL_ERROR;
            }
            slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
            if (slaveInterp == (Tcl_Interp *) NULL) {
                Tcl_AppendResult(interp, "interpreter named \"", argv[2],
                        "\" not found", (char *) NULL);
                return TCL_ERROR;
            }
            cmd = Tcl_Concat(argc-3, argv+3);
            Tcl_Preserve((ClientData) slaveInterp);
            result = Tcl_Eval(slaveInterp, cmd);
            ckfree((char *) cmd);

            /*
             * Now make the result and any error information accessible. We
             * have to be careful because the slave interpreter and the current
             * interpreter can be the same - do not destroy the result.. This
             * can happen if an interpreter contains an alias which is directed
             * at a target command in the same interpreter.
             */

            if (interp != slaveInterp) {
                if (result == TCL_ERROR) {

                    /*
                     * An error occurred, so transfer error information from
                     * the target interpreter back to our interpreter.  Must
                     * clear interp's result before calling Tcl_AddErrorInfo,
                     * since Tcl_AddErrorInfo will store the interp's result in
                     * errorInfo before appending slaveInterp's $errorInfo;
                     * we've already got everything we need in the slave
                     * interpreter's $errorInfo.
                     */

                    Tcl_ResetResult(interp);
                    Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
                            "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
                    Tcl_SetVar2(interp, "errorCode", (char *) NULL,
                            Tcl_GetVar2(slaveInterp, "errorCode", (char *)
                                    NULL, TCL_GLOBAL_ONLY),
                            TCL_GLOBAL_ONLY);
                }
                if (slaveInterp->freeProc != NULL) {
                    interp->result = slaveInterp->result;
                    interp->freeProc = slaveInterp->freeProc;
                    slaveInterp->freeProc = 0;
                } else {
                    Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
                }
                Tcl_ResetResult(slaveInterp);
            }
            Tcl_Release((ClientData) slaveInterp);
            return result;        
        }
        if ((strncmp(cmdName, "exists", len) == 0) && (len > 2)) {
            if (argc > 3) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " exists ?path?\"", (char *) NULL);
                return TCL_ERROR;
            }
            if (argc == 3) {
                if (GetInterp(interp, masterPtr, argv[2], NULL) ==
                        (Tcl_Interp *) NULL) {
                    Tcl_AppendResult(interp, "0", (char *) NULL);
                } else {
                    Tcl_AppendResult(interp, "1", (char *) NULL);
                }
            } else {
                Tcl_AppendResult(interp, "1", (char *) NULL);
            }
            return TCL_OK;
        }
    }
                
    if (cmdName[0] == 'i') {
        if ((len > 1) && (strncmp(cmdName, "issafe", len) == 0)) {
            if (argc > 3) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " issafe ?path?\"", (char *) NULL);
                return TCL_ERROR;
            }
            if (argc == 3) {
                slaveInterp = GetInterp(interp, masterPtr, argv[2],
                        &masterPtr);
                if (slaveInterp == (Tcl_Interp *) NULL) {
                    Tcl_AppendResult(interp, "interpreter \"", argv[2],
                            "\" not found", (char *) NULL);
                    return TCL_ERROR;
                }
            }
            if (masterPtr->isSafe == 0) {
                Tcl_AppendResult(interp, "0", (char *) NULL);
            } else {
                Tcl_AppendResult(interp, "1", (char *) NULL);
            }
            return TCL_OK;
        }
    }
    
    if (cmdName[0] == 's') {
        if ((strncmp(cmdName, "slaves", len) == 0) && (len > 1)) {
            if (argc != 2 && argc != 3) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " slaves ?path?\"", (char *) NULL);
                return TCL_ERROR;
            }
            if (argc == 3) {
                if (GetInterp(interp, masterPtr, argv[2], &masterPtr) ==
                        (Tcl_Interp *) NULL) {
                    Tcl_AppendResult(interp, "interpreter \"", argv[2],
                            "\" not found", (char *) NULL);
                    return TCL_ERROR;
                }
            }
            for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
                 hPtr != NULL;
                 hPtr = Tcl_NextHashEntry(&hSearch)) {
                Tcl_AppendElement(interp,
                        Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr));
            }
            return TCL_OK;
        }
        if ((strncmp(cmdName, "share", len) == 0) && (len > 1)) {
            if (argc != 5) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " share srcPath channelId destPath\"", (char *) NULL);
                return TCL_ERROR;
            }
            masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
            if (masterInterp == (Tcl_Interp *) NULL) {
                Tcl_AppendResult(interp, "interpreter \"", argv[2],
                        "\" not found", (char *) NULL);
                return TCL_ERROR;
            }
            slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
            if (slaveInterp == (Tcl_Interp *) NULL) {
                Tcl_AppendResult(interp, "interpreter \"", argv[4],
                        "\" not found", (char *) NULL);
                return TCL_ERROR;
            }
            chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
            if (chan == (Tcl_Channel) NULL) {
                if (interp != masterInterp) {
                    Tcl_AppendResult(interp, masterInterp->result,
                            (char *) NULL);
                    Tcl_ResetResult(masterInterp);
                }
                return TCL_ERROR;
            }
            Tcl_RegisterChannel(slaveInterp, chan);
            return TCL_OK;
        }
    }

    if ((cmdName[0] == 't') && (strncmp(cmdName, "target", len) == 0)) {
        if (argc != 4) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                    " target path alias\"", (char *) NULL);
            return TCL_ERROR;
        }
        return GetTarget(interp, argv[2], argv[3]);
    }

    if ((cmdName[0] == 't') && (strncmp(cmdName, "transfer", len) == 0)) {
        if (argc != 5) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                    " transfer srcPath channelId destPath\"", (char *) NULL);
            return TCL_ERROR;
        }
        masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
        if (masterInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "interpreter \"", argv[2],
                    "\" not found", (char *) NULL);
            return TCL_ERROR;
        }
        slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
        if (slaveInterp == (Tcl_Interp *) NULL) {
            Tcl_AppendResult(interp, "interpreter \"", argv[4],
                    "\" not found", (char *) NULL);
            return TCL_ERROR;
        }
        chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
        if (chan == (Tcl_Channel) NULL) {
            if (interp != masterInterp) {
                Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
                Tcl_ResetResult(masterInterp);
            }
            return TCL_ERROR;
        }
        Tcl_RegisterChannel(slaveInterp, chan);
        if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
            if (interp != masterInterp) {
                Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
                Tcl_ResetResult(masterInterp);
            }
            return TCL_ERROR;
        }

        return TCL_OK;
    }
        
    Tcl_AppendResult(interp, "bad option \"", argv[1],
            "\": should be alias, aliases, create, delete, exists, eval, ",
            "issafe, share, slaves, target or transfer", (char *) NULL);
    return TCL_ERROR;    
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjectCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it
 *	to be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

static int
SlaveObjectCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Slave interpreter. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Master *masterPtr;			/* Master record for slave interp. */
    Slave *slavePtr;			/* Slave record. */
    Tcl_Interp *slaveInterp;		/* Slave interpreter. */
    char *cmdName;			/* Name of command to do. */
    char *cmd;				/* Command to evaluate in slave
                                         * interpreter. */
    Alias *aliasPtr;			/* Alias information. */
    Tcl_HashEntry *hPtr;		/* For local searches. */
    Tcl_HashSearch hSearch;		/* For local searches. */
    int result;				/* Loop counter, status return. */
    size_t len;				/* Length of command name. */
    
    if (argc < 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
            " cmd ?arg ...?\"", (char *) NULL);
        return TCL_ERROR;
    }

    slaveInterp = (Tcl_Interp *) clientData;
    if (slaveInterp == (Tcl_Interp *) NULL) {
	Tcl_AppendResult(interp, "interpreter ", argv[0], " has been deleted",
		(char *) NULL);
	return TCL_ERROR;
    }

    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
            "tclSlaveRecord", NULL);
    if (slavePtr == (Slave *) NULL) {
        panic("SlaveObjectCmd: could not find slave record");
    }

    cmdName = argv[1];
    len = strlen(cmdName);

    if (cmdName[0] == 'a') {
        if (strncmp(cmdName, "alias", len) == 0) {
            switch (argc-2) {
                case 0:
                    Tcl_AppendResult(interp, "wrong # args: should be \"",
                            argv[0], " alias aliasName ?targetName? ?args..?",
                            (char *) NULL);
                    return TCL_ERROR;

                case 1:

                    /*
                     * Return the name of the command in the current
                     * interpreter for which the argument is an alias in the
                     * slave interpreter, and the list of saved arguments
                     */

                    return DescribeAlias(interp, slaveInterp, argv[2]);

                default:
                    masterPtr = (Master *) Tcl_GetAssocData(interp,
                            "tclMasterRecord", NULL);
                    if (masterPtr == (Master *) NULL) {
                        panic("SlaveObjectCmd: could not find master record");
                    }
                    return AliasHelper(interp, slaveInterp, interp, masterPtr,
                            argv[2], argv[3], argc-4, argv+4);
            }
        }

        if (strncmp(cmdName, "aliases", len) == 0) {

            /*
             * Return the names of all the aliases created in the
             * slave interpreter.
             */

            for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
                    &hSearch);
                 hPtr != (Tcl_HashEntry *) NULL;
                 hPtr = Tcl_NextHashEntry(&hSearch)) {
                aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
                Tcl_AppendElement(interp, aliasPtr->aliasName);
            }
            return TCL_OK;
        }
    }
    
    if (cmdName[0] == 'e') {
        if ((len > 1) && (strncmp(cmdName, "eval", len) == 0)) {
            if (argc < 3) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " eval arg ?arg ...?\"", (char *) NULL);
                return TCL_ERROR;
            }

            cmd = Tcl_Concat(argc-2, argv+2);
            Tcl_Preserve((ClientData) slaveInterp);
            result = Tcl_Eval(slaveInterp, cmd);
            ckfree((char *) cmd);

	    /*
             * Make the result and any error information accessible. We have
             * to be careful because the slave interpreter and the current
             * interpreter can be the same - do not destroy the result.. This
             * can happen if an interpreter contains an alias which is directed
             * at a target command in the same interpreter.
             */

            if (interp != slaveInterp) {
                if (result == TCL_ERROR) {

                   /*
                    * An error occurred, so transfer error information from the
                    * destination interpreter back to our interpreter.  Clear
                    * interp's result before calling Tcl_AddErrorInfo, since
                    * Tcl_AddErrorInfo stores the interp's result in errorInfo
                    * before appending slaveInterp's $errorInfo;
                    * we've already got everything we need in the slave
                    * interpreter's $errorInfo.
                    */

                    Tcl_ResetResult(interp);
                    Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
                            "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
                    Tcl_SetVar2(interp, "errorCode", (char *) NULL,
                            Tcl_GetVar2(slaveInterp, "errorCode",
                                    (char *) NULL, TCL_GLOBAL_ONLY),
                            TCL_GLOBAL_ONLY);
                }
                if (slaveInterp->freeProc != NULL) {
                    interp->result = slaveInterp->result;
                    interp->freeProc = slaveInterp->freeProc;
                    slaveInterp->freeProc = 0;
                } else {
                    Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
                }
                Tcl_ResetResult(slaveInterp);
            }
            Tcl_Release((ClientData) slaveInterp);
            return result;
        }
    }

    if (cmdName[0] == 'i') {
        if ((len > 1) && (strncmp(cmdName, "issafe", len) == 0)) {
            if (argc > 2) {
                Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                        " issafe\"", (char *) NULL);
                return TCL_ERROR;
            }
            masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
                    "tclMasterRecord", NULL);
            if (masterPtr == (Master *) NULL) {
                panic("SlaveObjectCmd: could not find master record");
            }
            if (masterPtr->isSafe == 1) {
                Tcl_AppendResult(interp, "1", (char *) NULL);
            } else {
                Tcl_AppendResult(interp, "0", (char *) NULL);
            }
            return TCL_OK;
        }
    }

    Tcl_AppendResult(interp, "bad option \"", argv[1],
            "\": should be alias, aliases, eval, or issafe", (char *) NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveObjectDeleteProc --
 *
 *	Invoked when an object command for a slave interpreter is deleted;
 *	cleans up all state associated with the slave interpreter and destroys
 *	the slave interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up all state associated with the slave interpreter and
 *	destroys the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
SlaveObjectDeleteProc(clientData)
    ClientData clientData;		/* The SlaveRecord for the command. */
{
    Slave *slavePtr;			/* Interim storage for Slave record. */
    Tcl_Interp *slaveInterp;		/* And for a slave interp. */

    slaveInterp = (Tcl_Interp *) clientData;
    slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL); 
    if (slavePtr == (Slave *) NULL) {
        panic("SlaveObjectDeleteProc: could not find slave record");
    }

    /*
     * Delete the entry in the slave table in the master interpreter now.
     * This is to avoid an infinite loop in the Master hash table cleanup in
     * the master interpreter. This can happen if this slave is being deleted
     * because the master is being deleted and the slave deletion is deferred
     * because it is still active.
     */

    Tcl_DeleteHashEntry(slavePtr->slaveEntry);

    /*
     * Set to NULL so that when the slave record is cleaned up in the slave
     * it does not try to delete the command causing all sorts of grief.
     * See SlaveRecordDeleteProc().
     */

    slavePtr->interpCmd = NULL;

    /*
     * Destroy the interpreter - this will cause all the deleteProcs for
     * all commands (including aliases) to run.
     *
     * NOTE: WE ASSUME THAT THE INTERPRETER HAS NOT BEEN DELETED YET!!
     */

    Tcl_DeleteInterp(slavePtr->slaveInterp);
}

/*
 *----------------------------------------------------------------------
 *
 * AliasCmd --
 *
 *	This is the procedure that services invocations of aliases in a
 *	slave interpreter. One such command exists for each alias. When
 *	invoked, this procedure redirects the invocation to the target
 *	command in the master interpreter as designated by the Alias
 *	record associated with this command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Causes forwarding of the invocation; all possible side effects
 *	may occur as a result of invoking the command to which the
 *	invocation is forwarded.
 *
 *----------------------------------------------------------------------
 */

static int
AliasCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Alias record. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    Alias *aliasPtr;			/* Describes the alias. */
    Tcl_CmdInfo cmdInfo;		/* Info about target command. */
    int result;				/* Result of execution. */
    int i, j, addArgc;			/* Loop counters. */
    int localArgc;			/* Local argument count. */
    char **localArgv;			/* Local argument vector. */
    Interp *iPtr;			/* The target interpreter. */
    
    aliasPtr = (Alias *) clientData;

    result = Tcl_GetCommandInfo(aliasPtr->targetInterp, aliasPtr->targetName,
            &cmdInfo);
    if (result == 0) {
        Tcl_AppendResult(interp, "aliased target \"", aliasPtr->targetName,
                "\" for \"", argv[0], "\" not found", (char *) NULL); 
        return TCL_ERROR;
    }
    if (aliasPtr->argc <= 0) {
        localArgv = argv;
        localArgc = argc;
    } else {
        addArgc = aliasPtr->argc;
        localArgc = argc + addArgc;
        localArgv = (char **) ckalloc((unsigned) sizeof(char *) * localArgc);
        localArgv[0] = argv[0];
        for (i = 0, j = 1; i < addArgc; i++, j++) {
            localArgv[j] = aliasPtr->argv[i];
        }
        for (i = 1; i < argc; i++, j++) {
            localArgv[j] = argv[i];
        }
    }

    /*
     * Invoke the redirected command in the target interpreter. Note
     * that we are not calling eval because of possible security holes with
     * $ substitution and bracketed command evaluation.
     *
     * We duplicate some code here from Tcl_Eval to implement recursion
     * level counting and correct deletion of the target interpreter if
     * that was requested but delayed because of in-progress evaluations.
     */

    iPtr = (Interp *) aliasPtr->targetInterp;
    iPtr->numLevels++;
    Tcl_Preserve((ClientData) iPtr);
    Tcl_ResetResult((Tcl_Interp *) iPtr);
    result = (cmdInfo.proc)(cmdInfo.clientData, (Tcl_Interp *) iPtr,
            localArgc, localArgv);
    iPtr->numLevels--;
    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR)) {
	    Tcl_ResetResult((Tcl_Interp *) iPtr);
	    if (result == TCL_BREAK) {
		iPtr->result = "invoked \"break\" outside of a loop";
	    } else if (result == TCL_CONTINUE) {
		iPtr->result = "invoked \"continue\" outside of a loop";
	    } else {
		iPtr->result = iPtr->resultSpace;
		sprintf(iPtr->resultSpace, "command returned bad code: %d",
			result);
	    }
	    result = TCL_ERROR;
	}
    }

    /*
     * Clean up any locally allocated argument vector structure.
     */
    
    if (localArgv != argv) {
        ckfree((char *) localArgv);
    }
    
    /*
     *
     * NOTE: Need to be careful if the target interpreter and the current
     * interpreter are the same - must not destroy result. This may happen
     * if an alias is created which redirects to a command in the same
     * interpreter as the one in which the source command will be defined.
     * Also: We cannot use aliasPtr any more because the alias may have
     * been deleted.
     */

    if (interp != (Tcl_Interp *) iPtr) {
        if (result == TCL_ERROR) {
	    /*
	     * An error occurred, so transfer error information from the
	     * destination interpreter back to our interpreter.  Some tricky
	     * points:
	     * 1. Must call Tcl_AddErrorInfo in destination interpreter to
	     *    make sure that the errorInfo variable has been initialized
	     *    (it's initialized lazily and might not have been initialized
	     *    yet).
	     * 2. Must clear interp's result before calling Tcl_AddErrorInfo,
	     *    since Tcl_AddErrorInfo will store the interp's result in
	     *    errorInfo before appending aliasPtr->interp's $errorInfo;
	     *    we've already got everything we need in the redirected
	     *    interpreter's $errorInfo.
	     */

	    if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
		Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
	    }
	    iPtr->flags &= ~ERR_ALREADY_LOGGED;
            Tcl_ResetResult(interp);
            Tcl_AddErrorInfo(interp, Tcl_GetVar2((Tcl_Interp *) iPtr,
                    "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
            Tcl_SetVar2(interp, "errorCode", (char *) NULL,
                    Tcl_GetVar2((Tcl_Interp *) iPtr, "errorCode",
                    (char *) NULL, TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
        }
        if (iPtr->freeProc != NULL) {
            interp->result = iPtr->result;
            interp->freeProc = iPtr->freeProc;
            iPtr->freeProc = 0;
        } else {
            Tcl_SetResult(interp, iPtr->result, TCL_VOLATILE);
        }
        Tcl_ResetResult((Tcl_Interp *) iPtr);
    }
    Tcl_Release((ClientData) iPtr);
    return result;        
}

/*
 *----------------------------------------------------------------------
 *
 * AliasCmdDeleteProc --
 *
 *	Is invoked when an alias command is deleted in a slave. Cleans up
 *	all storage associated with this alias.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the alias record and its entry in the alias table for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
AliasCmdDeleteProc(clientData)
    ClientData clientData;		/* The alias record for this alias. */
{
    Alias *aliasPtr;			/* Alias record for alias to delete. */
    Target *targetPtr;			/* Record for target of this alias. */
    int i;				/* Loop counter. */

    aliasPtr = (Alias *) clientData;
    
    targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
    ckfree((char *) targetPtr);
    Tcl_DeleteHashEntry(aliasPtr->targetEntry);

    ckfree((char *) aliasPtr->targetName);
    ckfree((char *) aliasPtr->aliasName);
    for (i = 0; i < aliasPtr->argc; i++) {
        ckfree((char *) aliasPtr->argv[i]);
    }
    if (aliasPtr->argv != (char **) NULL) {
        ckfree((char *) aliasPtr->argv);
    }

    Tcl_DeleteHashEntry(aliasPtr->aliasEntry);

    ckfree((char *) aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * MasterRecordDeleteProc -
 *
 *	Is invoked when an interpreter (which is using the "interp" facility)
 *	is deleted, and it cleans up the storage associated with the
 *	"tclMasterRecord" assoc-data entry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up storage.
 *
 *----------------------------------------------------------------------
 */

static void
MasterRecordDeleteProc(clientData, interp)
    ClientData	clientData;		/* Master record for deleted interp. */
    Tcl_Interp *interp;			/* Interpreter being deleted. */
{
    Target *targetPtr;			/* Loop variable. */
    Tcl_HashEntry *hPtr;		/* Search element. */
    Tcl_HashSearch hSearch;		/* Search record (internal). */
    Slave *slavePtr;			/* Loop variable. */
    char *cmdName;			/* Name of command to delete. */
    Master *masterPtr;			/* Interim storage. */

    masterPtr = (Master *) clientData;
    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
         hPtr != NULL;
         hPtr = Tcl_NextHashEntry(&hSearch)) {
        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
        cmdName = Tcl_GetCommandName(interp, slavePtr->interpCmd);
        (void) Tcl_DeleteCommand(interp, cmdName);
    }
    Tcl_DeleteHashTable(&(masterPtr->slaveTable));

    for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
         hPtr != NULL;
         hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
        targetPtr = (Target *) Tcl_GetHashValue(hPtr);
        cmdName = Tcl_GetCommandName(targetPtr->slaveInterp,
            targetPtr->slaveCmd);
        (void) Tcl_DeleteCommand(targetPtr->slaveInterp, cmdName);
    }
    Tcl_DeleteHashTable(&(masterPtr->targetTable));

    ckfree((char *) masterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SlaveRecordDeleteProc --
 *
 *	Is invoked when an interpreter (which is using the interp facility)
 *	is deleted, and it cleans up the storage associated with the
 *	tclSlaveRecord assoc-data entry.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Cleans up storage.
 *
 *----------------------------------------------------------------------
 */

static void
SlaveRecordDeleteProc(clientData, interp)
    ClientData	clientData;		/* Slave record for deleted interp. */
    Tcl_Interp *interp;			/* Interpreter being deleted. */
{
    Slave *slavePtr;			/* Interim storage. */
    Alias *aliasPtr;
    Tcl_HashTable *hTblPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    
    slavePtr = (Slave *) clientData;

    /*
     * In every case that we call SetAssocData on "tclSlaveRecord",
     * slavePtr is not NULL. Otherwise we panic.
     */

    if (slavePtr == NULL) {
	panic("SlaveRecordDeleteProc: NULL slavePtr");
    }

    if (slavePtr->interpCmd != (Tcl_Command) NULL) {
	Command *cmdPtr = (Command *) slavePtr->interpCmd;

	/*
	 * The interpCmd has not been deleted in the master yet,  since
	 * it's callback sets interpCmd to NULL.
	 *
	 * Probably Tcl_DeleteInterp() was called on this interpreter directly,
	 * rather than via "interp delete", or equivalent (deletion of the
	 * command in the master).
	 *
	 * Perform the cleanup done by SlaveObjectDeleteProc() directly,
	 * and turn off the callback now (since we are about to free slavePtr
	 * and this interpreter is going away, while the deletion of commands
	 * in the master may be deferred).
	 */

	Tcl_DeleteHashEntry(slavePtr->slaveEntry);
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;

        /*
         * Get the command name from the master interpreter instead of
         * relying on the stored name; the command may have been renamed.
         */
        
	Tcl_DeleteCommand(slavePtr->masterInterp,
                Tcl_GetCommandName(slavePtr->masterInterp,
                        slavePtr->interpCmd));
    }

    /*
     * If there are any aliases, delete those now. This removes any
     * dependency on the order of deletion between commands and the
     * slave record.
     */

    hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
             hPtr != (Tcl_HashEntry *) NULL;
             hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
        aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

        /*
         * The call to Tcl_DeleteCommand will release the storage
         * occuppied by the hash entry and the alias record.
         * NOTE that we cannot use the alias name directly because its
         * storage will be deleted in the command deletion callback. Hence
         * we must use the name for the command as stored in the hash table.
         */

        Tcl_DeleteCommand(interp,
                Tcl_GetCommandName(interp, aliasPtr->slaveCmd));
    }
        
    /*
     * Finally dispose of the hash table and the slave record.
     */

    Tcl_DeleteHashTable(hTblPtr);
    ckfree((char *) slavePtr);    
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpInit --
 *
 *	Initializes the invoking interpreter for using the "interp"
 *	facility. This is called from inside Tcl_Init.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds the "interp" command to an interpreter and initializes several
 *	records in the associated data of the invoking interpreter.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpInit(interp)
    Tcl_Interp *interp;			/* Interpreter to initialize. */
{
    Master *masterPtr;			/* Its Master record. */

    masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
    masterPtr->isSafe = 0;
    Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
    Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);

    (void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
            (ClientData) masterPtr);
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsSafe --
 *
 *	Determines whether an interpreter is safe
 *
 * Results:
 *	1 if it is safe, 0 if it is not.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_IsSafe(interp)
    Tcl_Interp *interp;		/* Is this interpreter "safe" ? */
{
    Master *masterPtr;		/* Its master record. */

    if (interp == (Tcl_Interp *) NULL) {
        return 0;
    }
    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("Tcl_IsSafe: could not find master record");
    }
    return masterPtr->isSafe;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeSafe --
 *
 *	Makes an interpreter safe.
 *
 * Results:
 *	TCL_OK if it succeeds, TCL_ERROR else.
 *
 * Side effects:
 *	Removes functionality from an interpreter.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_MakeSafe(interp)
    Tcl_Interp *interp;		/* Make this interpreter "safe". */
{
    if (interp == (Tcl_Interp *) NULL) {
        return TCL_ERROR;
    }
    return MakeSafe(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateSlave --
 *
 *	Creates a slave interpreter. The slavePath argument denotes the
 *	name of the new slave relative to the current interpreter; the
 *	slave is a direct descendant of the one-before-last component of
 *	the path, e.g. it is a descendant of the current interpreter if
 *	the slavePath argument contains only one component. Optionally makes
 *	the slave interpreter safe.
 *
 * Results:
 *	Returns the interpreter structure created, or NULL if an error
 *	occurred.
 *
 * Side effects:
 *	Creates a new interpreter and a new interpreter object command in
 *	the interpreter indicated by the slavePath argument.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_CreateSlave(interp, slavePath, isSafe)
    Tcl_Interp *interp;		/* Interpreter to start search at. */
    char *slavePath;		/* Name of slave to create. */
    int isSafe;			/* Should new slave be "safe" ? */
{
    if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
        return NULL;
    }
    return CreateSlave(interp, slavePath, isSafe);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetSlave --
 *
 *	Finds a slave interpreter by its path name.
 *
 * Results:
 *	Returns a Tcl_Interp * for the named interpreter or NULL if not
 *	found.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_GetSlave(interp, slavePath)
    Tcl_Interp *interp;		/* Interpreter to start search from. */
    char *slavePath;		/* Path of slave to find. */
{
    Master *masterPtr;		/* Interim storage for Master record. */

    if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
        return NULL;
    }
    masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
    if (masterPtr == (Master *) NULL) {
        panic("Tcl_GetSlave: could not find master record");
    }
    return GetInterp(interp, masterPtr, slavePath, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMaster --
 *
 *	Finds the master interpreter of a slave interpreter.
 *
 * Results:
 *	Returns a Tcl_Interp * for the master interpreter or NULL if none.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_GetMaster(interp)
    Tcl_Interp *interp;		/* Get the master of this interpreter. */
{
    Slave *slavePtr;		/* Slave record of this interpreter. */

    if (interp == (Tcl_Interp *) NULL) {
        return NULL;
    }
    slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
    if (slavePtr == (Slave *) NULL) {
        return NULL;
    }
    return slavePtr->masterInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateAlias --
 *
 *	Creates an alias between two interpreters.
 *
 * Results:
 *	TCL_OK if successful, TCL_ERROR if failed. If TCL_ERROR is returned
 *	the result of slaveInterp will contain an error message.
 *
 * Side effects:
 *	Creates a new alias, manipulates the result field of slaveInterp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
    Tcl_Interp *slaveInterp;		/* Interpreter for source command. */
    char *slaveCmd;			/* Command to install in slave. */
    Tcl_Interp *targetInterp;		/* Interpreter for target command. */
    char *targetCmd;			/* Name of target command. */
    int argc;				/* How many additional arguments? */
    char **argv;			/* These are the additional args. */
{
    Master *masterPtr;			/* Master record for target interp. */

    if ((slaveInterp == (Tcl_Interp *) NULL) ||
            (targetInterp == (Tcl_Interp *) NULL) ||
            (slaveCmd == (char *) NULL) ||
            (targetCmd == (char *) NULL)) {
        return TCL_ERROR;
    }
    masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
            NULL);
    if (masterPtr == (Master *) NULL) {
        panic("Tcl_CreateAlias: could not find master record");
    }
    return AliasHelper(slaveInterp, slaveInterp, targetInterp, masterPtr,
            slaveCmd, targetCmd, argc, argv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAlias --
 *
 *	Gets information about an alias.
 *
 * Results:
 *	TCL_OK if successful, TCL_ERROR else. If TCL_ERROR is returned, the
 *	result field of the interpreter given as argument will contain an
 *	error message.
 *
 * Side effects:
 *	Manipulates the result field of the interpreter given as argument.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
        argvPtr)
    Tcl_Interp *interp;			/* Interp to start search from. */
    char *aliasName;			/* Name of alias to find. */
    Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */
    char **targetNamePtr;		/* (Return) name of target command. */
    int *argcPtr;			/* (Return) count of addnl args. */
    char ***argvPtr;			/* (Return) additional arguments. */
{
    Slave *slavePtr;			/* Slave record for slave interp. */
    Tcl_HashEntry *hPtr;		/* Search element. */
    Alias *aliasPtr;			/* Storage for alias found. */

    if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
        return TCL_ERROR;
    }
    slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
    if (slavePtr == (Slave *) NULL) {
        panic("Tcl_GetAlias: could not find slave record");
    }
    hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
    if (hPtr == (Tcl_HashEntry *) NULL) {
        Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
                (char *) NULL);
        return TCL_ERROR;
    }
    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
    if (targetInterpPtr != (Tcl_Interp **) NULL) {
        *targetInterpPtr = aliasPtr->targetInterp;
    }
    if (targetNamePtr != (char **) NULL) {
        *targetNamePtr = aliasPtr->targetName;
    }
    if (argcPtr != (int *) NULL) {
        *argcPtr = aliasPtr->argc;
    }
    if (argvPtr != (char ***) NULL) {
        *argvPtr = aliasPtr->argv;
    }
    return TCL_OK;
}