/* 

  * tclInterp.c --

  *

  *	This file implements the "interp" command which allows creation

  *	and manipulation of Tcl interpreters from within Tcl scripts.

  *

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

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

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclInterp.c,v 1.20.2.3 2006/11/28 22:20:02 andreas_kupries Exp $

  */

 #include "tclInt.h"

 #include "tclPort.h"

 #include <stdio.h>

 /*

  * Counter for how many aliases were created (global)

  */

 static int aliasCounter = 0;

 TCL_DECLARE_MUTEX(cntMutex)

 /*

  * 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 Alias {

     Tcl_Obj *namePtr;		/* Name of alias command in slave interp. */

     Tcl_Interp *targetInterp;	/* Interp in which target command will be

 				 * invoked. */

     Tcl_Command slaveCmd;	/* Source command in slave interpreter,

 				 * bound to command that invokes the target

 				 * command in the target interpreter. */

     Tcl_HashEntry *aliasEntryPtr;

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

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

     int objc;                   /* Count of Tcl_Obj in the prefix of the

 				 * target command to be invoked in the

 				 * target interpreter. Additional arguments

 				 * specified when calling the alias in the

 				 * slave interp will be appended to the prefix

 				 * before the command is invoked. */

     Tcl_Obj *objPtr;            /* The first actual prefix object - the target

 				 * command name; this has to be at the end of the 

 				 * structure, which will be extended to accomodate 

 				 * the remaining objects in the prefix. */

 } Alias;

 /*

  *

  * 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 Slave {

     Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */

     Tcl_HashEntry *slaveEntryPtr;

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

                                  * master's 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 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 Target {

     Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */

     Tcl_Interp *slaveInterp;	/* Slave Interpreter. */

 } Target;

 /*

  * struct Master:

  *

  * This record is used for two 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).

  * 

  * NB: the flags field in the interp structure, used with SAFE_INTERP

  * mask 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 Master {

     Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.

                                  * Maps from command names to Slave records. */

     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;

 /*

  * The following structure keeps track of all the Master and Slave information

  * on a per-interp basis.

  */

 typedef struct InterpInfo {

     Master master;		/* Keeps track of all interps for which this

 				 * interp is the Master. */

     Slave slave;		/* Information necessary for this interp to

 				 * function as a slave. */

 } InterpInfo;

 /*

  * Prototypes for local static procedures:

  */

 static int		AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,

 			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,

 			    Tcl_Obj *CONST objv[]));

 static int		AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));

 static int		AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));

 static int		AliasList _ANSI_ARGS_((Tcl_Interp *interp,

 		            Tcl_Interp *slaveInterp));

 static int		AliasObjCmd _ANSI_ARGS_((ClientData dummy,

 			    Tcl_Interp *currentInterp, int objc,

 		            Tcl_Obj *CONST objv[]));

 static void		AliasObjCmdDeleteProc _ANSI_ARGS_((

 			    ClientData clientData));

 static Tcl_Interp *	GetInterp _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Obj *pathPtr));

 static Tcl_Interp *	GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,

 			    Tcl_Obj *CONST objv[]));

 static void		InterpInfoDeleteProc _ANSI_ARGS_((

 			    ClientData clientData, Tcl_Interp *interp));

 static Tcl_Interp *	SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,

 		            Tcl_Obj *pathPtr, int safe));

 static int		SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, int objc,

 			    Tcl_Obj *CONST objv[]));

 static int		SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, int objc,

 			    Tcl_Obj *CONST objv[]));

 static int		SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, int objc,

 			    Tcl_Obj *CONST objv[]));

 static int		SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp));

 static int		SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, int global, int objc,

 			    Tcl_Obj *CONST objv[]));

 static int		SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp));

 static int		SlaveObjCmd _ANSI_ARGS_((ClientData dummy,

 			    Tcl_Interp *interp, int objc,

 			    Tcl_Obj *CONST objv[]));

 static void		SlaveObjCmdDeleteProc _ANSI_ARGS_((

 			    ClientData clientData));

 static int		SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,

 			    Tcl_Interp *slaveInterp, int objc,

 			    Tcl_Obj *CONST objv[]));

 /*

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

  *

  * TclInterpInit --

  *

  *	Initializes the invoking interpreter for using the master, slave

  *	and safe interp facilities.  This is called from inside

  *	Tcl_CreateInterp().

  *

  * Results:

  *	Always returns TCL_OK for backwards compatibility.

  *

  * Side effects:

  *	Adds the "interp" command to an interpreter and initializes the

  *	interpInfoPtr field of the invoking interpreter.

  *

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

  */

 int

 TclInterpInit(interp)

     Tcl_Interp *interp;			/* Interpreter to initialize. */

 {

     InterpInfo *interpInfoPtr;

     Master *masterPtr;

     Slave *slavePtr;	

     interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));

     ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;

     masterPtr = &interpInfoPtr->master;

     Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);

     Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);

     slavePtr = &interpInfoPtr->slave;

     slavePtr->masterInterp	= NULL;

     slavePtr->slaveEntryPtr	= NULL;

     slavePtr->slaveInterp	= interp;

     slavePtr->interpCmd		= NULL;

     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);

     Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);

     Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);

     return TCL_OK;

 }

 /*

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

  *

  * InterpInfoDeleteProc --

  *

  *	Invoked when an interpreter is being deleted.  It releases all

  *	storage used by the master/slave/safe interpreter facilities.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Cleans up storage.  Sets the interpInfoPtr field of the interp

  *	to NULL.

  *

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

  */

 static void

 InterpInfoDeleteProc(clientData, interp)

     ClientData clientData;	/* Ignored. */

     Tcl_Interp *interp;		/* Interp being deleted.  All commands for

 				 * slave interps should already be deleted. */

 {

     InterpInfo *interpInfoPtr;

     Slave *slavePtr;

     Master *masterPtr;

     Tcl_HashSearch hSearch;

     Tcl_HashEntry *hPtr;

     Target *targetPtr;

     interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

     /*

      * There shouldn't be any commands left.

      */

     masterPtr = &interpInfoPtr->master;

     if (masterPtr->slaveTable.numEntries != 0) {

 	panic("InterpInfoDeleteProc: still exist commands");

     }

     Tcl_DeleteHashTable(&masterPtr->slaveTable);

     /*

      * Tell any interps that have aliases to this interp that they should

      * delete those aliases.  If the other interp was already dead, it

      * would have removed the target record already. 

      */

     hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);

     while (hPtr != NULL) {

 	targetPtr = (Target *) Tcl_GetHashValue(hPtr);

 	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,

 		targetPtr->slaveCmd);

 	hPtr = Tcl_NextHashEntry(&hSearch);

     }

     Tcl_DeleteHashTable(&masterPtr->targetTable);

     slavePtr = &interpInfoPtr->slave;

     if (slavePtr->interpCmd != NULL) {

 	/*

 	 * Tcl_DeleteInterp() was called on this interpreter, rather

 	 * "interp delete" or the equivalent deletion of the command in the

 	 * master.  First ensure that the cleanup callback doesn't try to

 	 * delete the interp again.

 	 */

 	slavePtr->slaveInterp = NULL;

         Tcl_DeleteCommandFromToken(slavePtr->masterInterp,

 		slavePtr->interpCmd);

     }

     /*

      * There shouldn't be any aliases left.

      */

     if (slavePtr->aliasTable.numEntries != 0) {

 	panic("InterpInfoDeleteProc: still exist aliases");

     }

     Tcl_DeleteHashTable(&slavePtr->aliasTable);

     ckfree((char *) interpInfoPtr);    

 }

 /*

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

  *

  * Tcl_InterpObjCmd --

  *

  *	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_InterpObjCmd(clientData, interp, objc, objv)

     ClientData clientData;		/* Unused. */

     Tcl_Interp *interp;			/* Current interpreter. */

     int objc;				/* Number of arguments. */

     Tcl_Obj *CONST objv[];		/* Argument objects. */

 {

     int index;

     static CONST char *options[] = {

         "alias",	"aliases",	"create",	"delete", 

 	"eval",		"exists",	"expose",	"hide", 

 	"hidden",	"issafe",	"invokehidden",	"marktrusted", 

 	"recursionlimit",		"slaves",	"share",

 	"target",	"transfer",

         NULL

     };

     enum option {

 	OPT_ALIAS,	OPT_ALIASES,	OPT_CREATE,	OPT_DELETE,

 	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,

 	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_MARKTRUSTED,

 	OPT_RECLIMIT,			OPT_SLAVES,	OPT_SHARE,

 	OPT_TARGET,	OPT_TRANSFER

     };

     if (objc < 2) {

         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");

         return TCL_ERROR;

     }

     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 

 	    &index) != TCL_OK) {

 	return TCL_ERROR;

     }

     switch ((enum option) index) {

 	case OPT_ALIAS: {

 	    Tcl_Interp *slaveInterp, *masterInterp;

 	    if (objc < 4) {

 		aliasArgs:

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"slavePath slaveCmd ?masterPath masterCmd? ?args ..?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == (Tcl_Interp *) NULL) {

 		return TCL_ERROR;

 	    }

 	    if (objc == 4) {

 		return AliasDescribe(interp, slaveInterp, objv[3]);

 	    }

 	    if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {

 		return AliasDelete(interp, slaveInterp, objv[3]);

 	    }

 	    if (objc > 5) {

 		masterInterp = GetInterp(interp, objv[4]);

 		if (masterInterp == (Tcl_Interp *) NULL) {

 		    return TCL_ERROR;

 		}

 		if (Tcl_GetString(objv[5])[0] == '\0') {

 		    if (objc == 6) {

 			return AliasDelete(interp, slaveInterp, objv[3]);

 		    }

 		} else {

 		    return AliasCreate(interp, slaveInterp, masterInterp,

 			    objv[3], objv[5], objc - 6, objv + 6);

 		}

 	    }

 	    goto aliasArgs;

 	}

 	case OPT_ALIASES: {

 	    Tcl_Interp *slaveInterp;

 	    slaveInterp = GetInterp2(interp, objc, objv);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return AliasList(interp, slaveInterp);

 	}

 	case OPT_CREATE: {

 	    int i, last, safe;

 	    Tcl_Obj *slavePtr;

 	    char buf[16 + TCL_INTEGER_SPACE];

 	    static CONST char *options[] = {

 		"-safe",	"--",		NULL

 	    };

 	    enum option {

 		OPT_SAFE,	OPT_LAST

 	    };

 	    safe = Tcl_IsSafe(interp);

 	    /*

 	     * Weird historical rules: "-safe" is accepted at the end, too.

 	     */

 	    slavePtr = NULL;

 	    last = 0;

 	    for (i = 2; i < objc; i++) {

 		if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {

 		    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",

 			    0, &index) != TCL_OK) {

 			return TCL_ERROR;

 		    }

 		    if (index == OPT_SAFE) {

 			safe = 1;

 			continue;

 		    }

 		    i++;

 		    last = 1;

 		}

 		if (slavePtr != NULL) {

 		    Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");

 		    return TCL_ERROR;

 		}

 		if (i < objc) {

 		    slavePtr = objv[i];

 		}

 	    }

 	    buf[0] = '\0';

 	    if (slavePtr == NULL) {

 		/*

 		 * Create an anonymous interpreter -- we choose its name and

 		 * the name of the command. We check that the command name

 		 * that we use for the interpreter does not collide with an

 		 * existing command in the master interpreter.

 		 */

 		for (i = 0; ; i++) {

 		    Tcl_CmdInfo cmdInfo;

 		    sprintf(buf, "interp%d", i);

 		    if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {

 			break;

 		    }

 		}

 		slavePtr = Tcl_NewStringObj(buf, -1);

 	    }

 	    if (SlaveCreate(interp, slavePtr, safe) == NULL) {

 		if (buf[0] != '\0') {

 		    Tcl_DecrRefCount(slavePtr);

 		}

 		return TCL_ERROR;

 	    }

 	    Tcl_SetObjResult(interp, slavePtr);

 	    return TCL_OK;

 	}

 	case OPT_DELETE: {

 	    int i;

 	    InterpInfo *iiPtr;

 	    Tcl_Interp *slaveInterp;

 	    for (i = 2; i < objc; i++) {

 		slaveInterp = GetInterp(interp, objv[i]);

 		if (slaveInterp == NULL) {

 		    return TCL_ERROR;

 		} else if (slaveInterp == interp) {

 		    Tcl_ResetResult(interp);

 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			    "cannot delete the current interpreter",

 			    (char *) NULL);

 		    return TCL_ERROR;

 		}

 		iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;

 		Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,

 			iiPtr->slave.interpCmd);

 	    }

 	    return TCL_OK;

 	}

 	case OPT_EVAL: {

 	    Tcl_Interp *slaveInterp;

 	    if (objc < 4) {

 		Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);

 	}

 	case OPT_EXISTS: {

 	    int exists;

 	    Tcl_Interp *slaveInterp;

 	    exists = 1;

 	    slaveInterp = GetInterp2(interp, objc, objv);

 	    if (slaveInterp == NULL) {

 		if (objc > 3) {

 		    return TCL_ERROR;

 		}

 		Tcl_ResetResult(interp);

 		exists = 0;

 	    }

 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), exists);

 	    return TCL_OK;

 	}

 	case OPT_EXPOSE: {

 	    Tcl_Interp *slaveInterp;

 	    if ((objc < 4) || (objc > 5)) {

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"path hiddenCmdName ?cmdName?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);

 	}

 	case OPT_HIDE: {

 	    Tcl_Interp *slaveInterp;		/* A slave. */

 	    if ((objc < 4) || (objc > 5)) {

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"path cmdName ?hiddenCmdName?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == (Tcl_Interp *) NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);

 	}

 	case OPT_HIDDEN: {

 	    Tcl_Interp *slaveInterp;		/* A slave. */

 	    slaveInterp = GetInterp2(interp, objc, objv);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveHidden(interp, slaveInterp);

 	}

 	case OPT_ISSAFE: {

 	    Tcl_Interp *slaveInterp;

 	    slaveInterp = GetInterp2(interp, objc, objv);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));

 	    return TCL_OK;

 	}

 	case OPT_INVOKEHID: {

 	    int i, index, global;

 	    Tcl_Interp *slaveInterp;

 	    static CONST char *hiddenOptions[] = {

 		"-global",	"--",		NULL

 	    };

 	    enum hiddenOption {

 		OPT_GLOBAL,	OPT_LAST

 	    };

 	    global = 0;

 	    for (i = 3; i < objc; i++) {

 		if (Tcl_GetString(objv[i])[0] != '-') {

 		    break;

 		}

 		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,

 			"option", 0, &index) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 		if (index == OPT_GLOBAL) {

 		    global = 1;

 		} else {

 		    i++;

 		    break;

 		}

 	    }

 	    if (objc - i < 1) {

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"path ?-global? ?--? cmd ?arg ..?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == (Tcl_Interp *) NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,

 		    objv + i);

 	}

 	case OPT_MARKTRUSTED: {

 	    Tcl_Interp *slaveInterp;

 	    if (objc != 3) {

 		Tcl_WrongNumArgs(interp, 2, objv, "path");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveMarkTrusted(interp, slaveInterp);

 	}

 	case OPT_RECLIMIT: {

 	    Tcl_Interp *slaveInterp;

 	    if (objc != 3 && objc != 4) {

 		Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);

 	}

 	case OPT_SLAVES: {

 	    Tcl_Interp *slaveInterp;

 	    InterpInfo *iiPtr;

 	    Tcl_Obj *resultPtr;

 	    Tcl_HashEntry *hPtr;

 	    Tcl_HashSearch hashSearch;

 	    char *string;

 	    slaveInterp = GetInterp2(interp, objc, objv);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;

 	    resultPtr = Tcl_GetObjResult(interp);

 	    hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);

 	    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {

 		string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);

 		Tcl_ListObjAppendElement(NULL, resultPtr,

 			Tcl_NewStringObj(string, -1));

 	    }

 	    return TCL_OK;

 	}

 	case OPT_SHARE: {

 	    Tcl_Interp *slaveInterp;		/* A slave. */

 	    Tcl_Interp *masterInterp;		/* Its master. */

 	    Tcl_Channel chan;

 	    if (objc != 5) {

 		Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");

 		return TCL_ERROR;

 	    }

 	    masterInterp = GetInterp(interp, objv[2]);

 	    if (masterInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]),

 		    NULL);

 	    if (chan == NULL) {

 		TclTransferResult(masterInterp, TCL_OK, interp);

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[4]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    Tcl_RegisterChannel(slaveInterp, chan);

 	    return TCL_OK;

 	}

 	case OPT_TARGET: {

 	    Tcl_Interp *slaveInterp;

 	    InterpInfo *iiPtr;

 	    Tcl_HashEntry *hPtr;	

 	    Alias *aliasPtr;		

 	    char *aliasName;

 	    if (objc != 4) {

 		Tcl_WrongNumArgs(interp, 2, objv, "path alias");

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[2]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    aliasName = Tcl_GetString(objv[3]);

 	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;

 	    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);

 	    if (hPtr == NULL) {

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			"alias \"", aliasName, "\" in path \"",

 			Tcl_GetString(objv[2]), "\" not found",

 			(char *) NULL);

 		return TCL_ERROR;

 	    }

 	    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

 	    if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {

 		Tcl_ResetResult(interp);

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			"target interpreter for alias \"", aliasName,

 			"\" in path \"", Tcl_GetString(objv[2]),

 			"\" is not my descendant", (char *) NULL);

 		return TCL_ERROR;

 	    }

 	    return TCL_OK;

 	}

 	case OPT_TRANSFER: {

 	    Tcl_Interp *slaveInterp;		/* A slave. */

 	    Tcl_Interp *masterInterp;		/* Its master. */

 	    Tcl_Channel chan;

 	    if (objc != 5) {

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"srcPath channelId destPath");

 		return TCL_ERROR;

 	    }

 	    masterInterp = GetInterp(interp, objv[2]);

 	    if (masterInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]), NULL);

 	    if (chan == NULL) {

 		TclTransferResult(masterInterp, TCL_OK, interp);

 		return TCL_ERROR;

 	    }

 	    slaveInterp = GetInterp(interp, objv[4]);

 	    if (slaveInterp == NULL) {

 		return TCL_ERROR;

 	    }

 	    Tcl_RegisterChannel(slaveInterp, chan);

 	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {

 		TclTransferResult(masterInterp, TCL_OK, interp);

 		return TCL_ERROR;

 	    }

 	    return TCL_OK;

 	}

     }

     return TCL_OK;

 }

 /*

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

  *

  * GetInterp2 --

  *

  *	Helper function for Tcl_InterpObjCmd() to convert the interp name

  *	potentially specified on the command line to an Tcl_Interp.

  *

  * Results:

  *	The return value is the interp specified on the command line,

  *	or the interp argument itself if no interp was specified on the

  *	command line.  If the interp could not be found or the wrong

  *	number of arguments was specified on the command line, the return

  *	value is NULL and an error message is left in the interp's result.

  *

  * Side effects:

  *	None.

  *

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

  */

 static Tcl_Interp *

 GetInterp2(interp, objc, objv)

     Tcl_Interp *interp;		/* Default interp if no interp was specified

 				 * on the command line. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     if (objc == 2) {

 	return interp;

     } else if (objc == 3) {

 	return GetInterp(interp, objv[2]);

     } else {

 	Tcl_WrongNumArgs(interp, 2, objv, "?path?");

 	return NULL;

     }

 }

 /*

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

  *

  * Tcl_CreateAlias --

  *

  *	Creates an alias between two interpreters.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Creates a new alias, manipulates the result field of slaveInterp.

  *

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

  */

 EXPORT_C int

 Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)

     Tcl_Interp *slaveInterp;	/* Interpreter for source command. */

     CONST char *slaveCmd;	/* Command to install in slave. */

     Tcl_Interp *targetInterp;	/* Interpreter for target command. */

     CONST char *targetCmd;	/* Name of target command. */

     int argc;			/* How many additional arguments? */

     CONST char * CONST *argv;	/* These are the additional args. */

 {

     Tcl_Obj *slaveObjPtr, *targetObjPtr;

     Tcl_Obj **objv;

     int i;

     int result;

     objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);

     for (i = 0; i < argc; i++) {

         objv[i] = Tcl_NewStringObj(argv[i], -1);

         Tcl_IncrRefCount(objv[i]);

     }

     slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);

     Tcl_IncrRefCount(slaveObjPtr);

     targetObjPtr = Tcl_NewStringObj(targetCmd, -1);

     Tcl_IncrRefCount(targetObjPtr);

     result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,

 	    targetObjPtr, argc, objv);

     for (i = 0; i < argc; i++) {

 	Tcl_DecrRefCount(objv[i]);

     }

     ckfree((char *) objv);

     Tcl_DecrRefCount(targetObjPtr);

     Tcl_DecrRefCount(slaveObjPtr);

     return result;

 }

 /*

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

  *

  * Tcl_CreateAliasObj --

  *

  *	Object version: Creates an alias between two interpreters.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Creates a new alias.

  *

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

  */

 EXPORT_C int

 Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)

     Tcl_Interp *slaveInterp;	/* Interpreter for source command. */

     CONST char *slaveCmd;	/* Command to install in slave. */

     Tcl_Interp *targetInterp;	/* Interpreter for target command. */

     CONST char *targetCmd;	/* Name of target command. */

     int objc;			/* How many additional arguments? */

     Tcl_Obj *CONST objv[];	/* Argument vector. */

 {

     Tcl_Obj *slaveObjPtr, *targetObjPtr;

     int result;

     slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);

     Tcl_IncrRefCount(slaveObjPtr);

     targetObjPtr = Tcl_NewStringObj(targetCmd, -1);

     Tcl_IncrRefCount(targetObjPtr);

     result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,

 	    targetObjPtr, objc, objv);

     Tcl_DecrRefCount(slaveObjPtr);

     Tcl_DecrRefCount(targetObjPtr);

     return result;

 }

 /*

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

  *

  * Tcl_GetAlias --

  *

  *	Gets information about an alias.

  *

  * Results:

  *	A standard Tcl result. 

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,

         argvPtr)

     Tcl_Interp *interp;			/* Interp to start search from. */

     CONST char *aliasName;			/* Name of alias to find. */

     Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */

     CONST char **targetNamePtr;		/* (Return) name of target command. */

     int *argcPtr;			/* (Return) count of addnl args. */

     CONST char ***argvPtr;		/* (Return) additional arguments. */

 {

     InterpInfo *iiPtr;

     Tcl_HashEntry *hPtr;

     Alias *aliasPtr;

     int i, objc;

     Tcl_Obj **objv;

     iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);

     if (hPtr == NULL) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "alias \"", aliasName, "\" not found", (char *) NULL);

 	return TCL_ERROR;

     }

     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

     objc = aliasPtr->objc;

     objv = &aliasPtr->objPtr;

     if (targetInterpPtr != NULL) {

 	*targetInterpPtr = aliasPtr->targetInterp;

     }

     if (targetNamePtr != NULL) {

 	*targetNamePtr = Tcl_GetString(objv[0]);

     }

     if (argcPtr != NULL) {

 	*argcPtr = objc - 1;

     }

     if (argvPtr != NULL) {

         *argvPtr = (CONST char **) 

 		ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));

         for (i = 1; i < objc; i++) {

             *argvPtr[i - 1] = Tcl_GetString(objv[i]);

         }

     }

     return TCL_OK;

 }

 /*

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

  *

  * Tcl_GetAliasObj --

  *

  *	Object version: Gets information about an alias.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	None.

  *

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

  */

 EXPORT_C int

 Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,

         objvPtr)

     Tcl_Interp *interp;			/* Interp to start search from. */

     CONST char *aliasName;		/* Name of alias to find. */

     Tcl_Interp **targetInterpPtr;	/* (Return) target interpreter. */

     CONST char **targetNamePtr;		/* (Return) name of target command. */

     int *objcPtr;			/* (Return) count of addnl args. */

     Tcl_Obj ***objvPtr;			/* (Return) additional args. */

 {

     InterpInfo *iiPtr;

     Tcl_HashEntry *hPtr;

     Alias *aliasPtr;	

     int objc;

     Tcl_Obj **objv;

     iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

     hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);

     if (hPtr == (Tcl_HashEntry *) NULL) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "alias \"", aliasName, "\" not found", (char *) NULL);

         return TCL_ERROR;

     }

     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

     objc = aliasPtr->objc;

     objv = &aliasPtr->objPtr;

     if (targetInterpPtr != (Tcl_Interp **) NULL) {

         *targetInterpPtr = aliasPtr->targetInterp;

     }

     if (targetNamePtr != (CONST char **) NULL) {

         *targetNamePtr = Tcl_GetString(objv[0]);

     }

     if (objcPtr != (int *) NULL) {

         *objcPtr = objc - 1;

     }

     if (objvPtr != (Tcl_Obj ***) NULL) {

         *objvPtr = objv + 1;

     }

     return TCL_OK;

 }

 /*

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

  *

  * TclPreventAliasLoop --

  *

  *	When defining an alias or renaming a command, prevent an alias

  *	loop from being formed.

  *

  * Results:

  *	A standard Tcl object result.

  *

  * Side effects:

  *	If TCL_ERROR is returned, the function also stores an error message

  *	in the interpreter's result object.

  *

  * NOTE:

  *	This function is public internal (instead of being static to

  *	this file) because it is also used from TclRenameCommand.

  *

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

  */

 int

 TclPreventAliasLoop(interp, cmdInterp, cmd)

     Tcl_Interp *interp;			/* Interp in which to report errors. */

     Tcl_Interp *cmdInterp;		/* Interp in which the command is

                                          * being defined. */

     Tcl_Command cmd;                    /* Tcl command we are attempting

                                          * to define. */

 {

     Command *cmdPtr = (Command *) cmd;

     Alias *aliasPtr, *nextAliasPtr;

     Tcl_Command aliasCmd;

     Command *aliasCmdPtr;

     /*

      * If we are not creating or renaming an alias, then it is

      * always OK to create or rename the command.

      */

     if (cmdPtr->objProc != AliasObjCmd) {

         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 *) cmdPtr->objClientData;

     nextAliasPtr = aliasPtr;

     while (1) {

 	Tcl_Obj *cmdNamePtr;

         /*

          * If the target of the next alias in the chain is the same as

          * the source alias, we have a loop.

 	 */

 	if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {

 	    /*

 	     * The slave interpreter can be deleted while creating the alias.

 	     * [Bug #641195]

 	     */

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "cannot define or rename alias \"",

 		    Tcl_GetString(aliasPtr->namePtr),

 		    "\": interpreter deleted", (char *) NULL);

 	    return TCL_ERROR;

 	}

 	cmdNamePtr = nextAliasPtr->objPtr;

 	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,

                 Tcl_GetString(cmdNamePtr),

 		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),

 		/*flags*/ 0);

         if (aliasCmd == (Tcl_Command) NULL) {

             return TCL_OK;

         }

 	aliasCmdPtr = (Command *) aliasCmd;

         if (aliasCmdPtr == cmdPtr) {

             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "cannot define or rename alias \"",

 		    Tcl_GetString(aliasPtr->namePtr),

 		    "\": would create a loop", (char *) NULL);

             return TCL_ERROR;

         }

         /*

 	 * Otherwise, follow the chain one step further. 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 (aliasCmdPtr->objProc != AliasObjCmd) {

             return TCL_OK;

         }

         nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;

     }

     /* NOTREACHED */

 }

 /*

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

  *

  * AliasCreate --

  *

  *	Helper function to do the work to actually create 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

 AliasCreate(interp, slaveInterp, masterInterp, namePtr, targetNamePtr,

 	objc, objv)

     Tcl_Interp *interp;		/* Interp for error reporting. */

     Tcl_Interp *slaveInterp;	/* Interp where alias cmd will live or from

 				 * which alias will be deleted. */

     Tcl_Interp *masterInterp;	/* Interp in which target command will be

 				 * invoked. */

     Tcl_Obj *namePtr;		/* Name of alias cmd. */

     Tcl_Obj *targetNamePtr;	/* Name of target cmd. */

     int objc;			/* Additional arguments to store */

     Tcl_Obj *CONST objv[];	/* with alias. */

 {

     Alias *aliasPtr;

     Tcl_HashEntry *hPtr;

     Target *targetPtr;

     Slave *slavePtr;

     Master *masterPtr;

     Tcl_Obj **prefv;

     int new, i;

     aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) 

             + objc * sizeof(Tcl_Obj *)));

     aliasPtr->namePtr		= namePtr;

     Tcl_IncrRefCount(aliasPtr->namePtr);

     aliasPtr->targetInterp	= masterInterp;

     aliasPtr->objc = objc + 1;

     prefv = &aliasPtr->objPtr;

     *prefv = targetNamePtr;

     Tcl_IncrRefCount(targetNamePtr);

     for (i = 0; i < objc; i++) {

 	*(++prefv) = objv[i];

 	Tcl_IncrRefCount(objv[i]);

     }

     Tcl_Preserve(slaveInterp);

     Tcl_Preserve(masterInterp);

     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,

 	    Tcl_GetString(namePtr), AliasObjCmd, (ClientData) aliasPtr,

 	    AliasObjCmdDeleteProc);

     if (TclPreventAliasLoop(interp, slaveInterp,

 	    aliasPtr->slaveCmd) != TCL_OK) {

 	/*

 	 * Found an alias loop!	 The last call to Tcl_CreateObjCommand made

 	 * the alias point to itself.  Delete the command and its alias

 	 * record.  Be careful to wipe out its client data first, so the

 	 * command doesn't try to delete itself.

 	 */

 	Command *cmdPtr;

 	Tcl_DecrRefCount(aliasPtr->namePtr);

 	Tcl_DecrRefCount(targetNamePtr);

 	for (i = 0; i < objc; i++) {

 	    Tcl_DecrRefCount(objv[i]);

 	}

 	cmdPtr = (Command *) aliasPtr->slaveCmd;

 	cmdPtr->clientData = NULL;

 	cmdPtr->deleteProc = NULL;

 	cmdPtr->deleteData = NULL;

 	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

 	ckfree((char *) aliasPtr);

 	/*

 	 * The result was already set by TclPreventAliasLoop.

 	 */

 	Tcl_Release(slaveInterp);

 	Tcl_Release(masterInterp);

 	return TCL_ERROR;

     }

     /*

      * Make an entry in the alias table. If it already exists delete

      * the alias command. Then retry.

      */

     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     while (1) {

 	Alias *oldAliasPtr;

 	char *string;

 	string = Tcl_GetString(namePtr);

 	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);

 	if (new != 0) {

 	    break;

 	}

 	oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

 	Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd);

     }

     aliasPtr->aliasEntryPtr = 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;

     Tcl_MutexLock(&cntMutex);

     masterPtr = &((InterpInfo *) ((Interp *) masterInterp)->interpInfo)->master;

     do {

         hPtr = Tcl_CreateHashEntry(&masterPtr->targetTable,

                 (char *) aliasCounter, &new);

 	aliasCounter++;

     } while (new == 0);

     Tcl_MutexUnlock(&cntMutex);

     Tcl_SetHashValue(hPtr, (ClientData) targetPtr);

     aliasPtr->targetEntryPtr = hPtr;

     Tcl_SetObjResult(interp, namePtr);

     Tcl_Release(slaveInterp);

     Tcl_Release(masterInterp);

     return TCL_OK;

 }

 /*

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

  *

  * AliasDelete --

  *

  *	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

 AliasDelete(interp, slaveInterp, namePtr)

     Tcl_Interp *interp;		/* Interpreter for result & errors. */

     Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */

     Tcl_Obj *namePtr;		/* Name of alias to delete. */

 {

     Slave *slavePtr;

     Alias *aliasPtr;

     Tcl_HashEntry *hPtr;

     /*

      * If the alias has been renamed in the slave, the master can still use

      * the original name (with which it was created) to find the alias to

      * delete it.

      */

     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));

     if (hPtr == NULL) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"",

 		Tcl_GetString(namePtr), "\" not found", NULL);

         return TCL_ERROR;

     }

     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

     Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

     return TCL_OK;

 }

 /*

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

  *

  * AliasDescribe --

  *

  *	Sets the interpreter's result object 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

 AliasDescribe(interp, slaveInterp, namePtr)

     Tcl_Interp *interp;		/* Interpreter for result & errors. */

     Tcl_Interp *slaveInterp;	/* Interpreter containing alias. */

     Tcl_Obj *namePtr;		/* Name of alias to describe. */

 {

     Slave *slavePtr;

     Tcl_HashEntry *hPtr;

     Alias *aliasPtr;	

     Tcl_Obj *prefixPtr;

     /*

      * If the alias has been renamed in the slave, the master can still use

      * the original name (with which it was created) to find the alias to

      * describe it.

      */

     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));

     if (hPtr == NULL) {

         return TCL_OK;

     }

     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);

     prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);

     Tcl_SetObjResult(interp, prefixPtr);

     return TCL_OK;

 }

 /*

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

  *

  * AliasList --

  *

  *	Computes a list of aliases defined in a slave interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	None.

  *

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

  */

 static int

 AliasList(interp, slaveInterp)

     Tcl_Interp *interp;		/* Interp for data return. */

     Tcl_Interp *slaveInterp;	/* Interp whose aliases to compute. */

 {

     Tcl_HashEntry *entryPtr;

     Tcl_HashSearch hashSearch;

     Tcl_Obj *resultPtr;	

     Alias *aliasPtr;

     Slave *slavePtr;

     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     resultPtr = Tcl_GetObjResult(interp);

     entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);

     for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {

         aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);

         Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);

     }

     return TCL_OK;

 }

 /*

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

  *

  * AliasObjCmd --

  *

  *	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

 AliasObjCmd(clientData, interp, objc, objv)

     ClientData clientData;	/* Alias record. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument vector. */	

 {

 #define ALIAS_CMDV_PREALLOC 10

     Tcl_Interp *targetInterp;	

     Alias *aliasPtr;		

     int result, prefc, cmdc, i;

     Tcl_Obj **prefv, **cmdv;

     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];

     aliasPtr = (Alias *) clientData;

     targetInterp = aliasPtr->targetInterp;

     /*

      * Append the arguments to the command prefix and invoke the command

      * in the target interp's global namespace.

      */

     prefc = aliasPtr->objc;

     prefv = &aliasPtr->objPtr;

     cmdc = prefc + objc - 1;

     if (cmdc <= ALIAS_CMDV_PREALLOC) {

 	cmdv = cmdArr;

     } else {

 	cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));

     }

     prefv = &aliasPtr->objPtr;

     memcpy((VOID *) cmdv, (VOID *) prefv, 

             (size_t) (prefc * sizeof(Tcl_Obj *)));

     memcpy((VOID *) (cmdv+prefc), (VOID *) (objv+1), 

 	    (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

     Tcl_ResetResult(targetInterp);

     for (i=0; i<cmdc; i++) {

 	Tcl_IncrRefCount(cmdv[i]);

     }

     if (targetInterp != interp) {

 	Tcl_Preserve((ClientData) targetInterp);

 	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);

 	TclTransferResult(targetInterp, result, interp);	

 	Tcl_Release((ClientData) targetInterp);

     } else {

 	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);

     }

     for (i=0; i<cmdc; i++) {

 	Tcl_DecrRefCount(cmdv[i]);

     }

     if (cmdv != cmdArr) {

 	ckfree((char *) cmdv);

     }

     return result;        

 #undef ALIAS_CMDV_PREALLOC

 }

 /*

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

  *

  * AliasObjCmdDeleteProc --

  *

  *	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

 AliasObjCmdDeleteProc(clientData)

     ClientData clientData;	/* The alias record for this alias. */

 {

     Alias *aliasPtr;		

     Target *targetPtr;		

     int i;

     Tcl_Obj **objv;

     aliasPtr = (Alias *) clientData;

     Tcl_DecrRefCount(aliasPtr->namePtr);

     objv = &aliasPtr->objPtr;

     for (i = 0; i < aliasPtr->objc; i++) {

 	Tcl_DecrRefCount(objv[i]);

     }

     Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);

     targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);

     ckfree((char *) targetPtr);

     Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);

     ckfree((char *) aliasPtr);

 }

 /*

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

  *

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

  *

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

  */

 EXPORT_C Tcl_Interp *

 Tcl_CreateSlave(interp, slavePath, isSafe)

     Tcl_Interp *interp;		/* Interpreter to start search at. */

     CONST char *slavePath;	/* Name of slave to create. */

     int isSafe;			/* Should new slave be "safe" ? */

 {

     Tcl_Obj *pathPtr;

     Tcl_Interp *slaveInterp;

     pathPtr = Tcl_NewStringObj(slavePath, -1);

     slaveInterp = SlaveCreate(interp, pathPtr, isSafe);

     Tcl_DecrRefCount(pathPtr);

     return slaveInterp;

 }

 /*

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

  *

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

  *

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

  */

 EXPORT_C Tcl_Interp *

 Tcl_GetSlave(interp, slavePath)

     Tcl_Interp *interp;		/* Interpreter to start search from. */

     CONST char *slavePath;	/* Path of slave to find. */

 {

     Tcl_Obj *pathPtr;

     Tcl_Interp *slaveInterp;

     pathPtr = Tcl_NewStringObj(slavePath, -1);

     slaveInterp = GetInterp(interp, pathPtr);

     Tcl_DecrRefCount(pathPtr);

     return slaveInterp;

 }

 /*

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

  *

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

  *

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

  */

 EXPORT_C 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 = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;

     return slavePtr->masterInterp;

 }

 /*

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

  *

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

  *

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

  */

 EXPORT_C int

 Tcl_GetInterpPath(askingInterp, targetInterp)

     Tcl_Interp *askingInterp;	/* Interpreter to start search from. */

     Tcl_Interp *targetInterp;	/* Interpreter to find. */

 {

     InterpInfo *iiPtr;

     if (targetInterp == askingInterp) {

         return TCL_OK;

     }

     if (targetInterp == NULL) {

 	return TCL_ERROR;

     }

     iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;

     if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {

         return TCL_ERROR;

     }

     Tcl_AppendElement(askingInterp,

 	    Tcl_GetHashKey(&iiPtr->master.slaveTable,

 		    iiPtr->slave.slaveEntryPtr));

     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, pathPtr)

     Tcl_Interp *interp;		/* Interp. to start search from. */

     Tcl_Obj *pathPtr;		/* List object containing name of interp. to 

 				 * be found. */

 {

     Tcl_HashEntry *hPtr;	/* Search element. */

     Slave *slavePtr;		/* Interim slave record. */

     Tcl_Obj **objv;

     int objc, i;	

     Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */

     InterpInfo *masterInfoPtr;

     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {

 	return NULL;

     }

     searchInterp = interp;

     for (i = 0; i < objc; i++) {

 	masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;

         hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,

 		Tcl_GetString(objv[i]));

         if (hPtr == NULL) {

 	    searchInterp = NULL;

 	    break;

 	}

         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);

         searchInterp = slavePtr->slaveInterp;

         if (searchInterp == NULL) {

 	    break;

 	}

     }

     if (searchInterp == NULL) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"could not find interpreter \"",

                 Tcl_GetString(pathPtr), "\"", (char *) NULL);

     }

     return searchInterp;

 }

 /*

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

  *

  * SlaveCreate --

  *

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

 SlaveCreate(interp, pathPtr, safe)

     Tcl_Interp *interp;		/* Interp. to start search from. */

     Tcl_Obj *pathPtr;		/* Path (name) of slave to create. */

     int safe;			/* Should we make it "safe"? */

 {

     Tcl_Interp *masterInterp, *slaveInterp;

     Slave *slavePtr;

     InterpInfo *masterInfoPtr;

     Tcl_HashEntry *hPtr;

     char *path;

     int new, objc;

     Tcl_Obj **objv;

     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {

 	return NULL;

     }

     if (objc < 2) {

 	masterInterp = interp;

 	path = Tcl_GetString(pathPtr);

     } else {

 	Tcl_Obj *objPtr;

 	objPtr = Tcl_NewListObj(objc - 1, objv);

 	masterInterp = GetInterp(interp, objPtr);

 	Tcl_DecrRefCount(objPtr);

 	if (masterInterp == NULL) {

 	    return NULL;

 	}

 	path = Tcl_GetString(objv[objc - 1]);

     }

     if (safe == 0) {

 	safe = Tcl_IsSafe(masterInterp);

     }

     masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;

     hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);

     if (new == 0) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "interpreter named \"", path,

 		"\" already exists, cannot create", (char *) NULL);

         return NULL;

     }

     slaveInterp = Tcl_CreateInterp();

     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     slavePtr->masterInterp = masterInterp;

     slavePtr->slaveEntryPtr = hPtr;

     slavePtr->slaveInterp = slaveInterp;

     slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,

             SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);

     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);

     Tcl_SetHashValue(hPtr, (ClientData) slavePtr);

     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

     /*

      * Inherit the recursion limit.

      */

     ((Interp *) slaveInterp)->maxNestingDepth =

 	((Interp *) masterInterp)->maxNestingDepth ;

     if (safe) {

         if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {

             goto error;

         }

     } else {

         if (Tcl_Init(slaveInterp) == TCL_ERROR) {

             goto error;

         }

 	/*

 	 * This will create the "memory" command in slave interpreters

 	 * if we compiled with TCL_MEM_DEBUG, otherwise it does nothing.

 	 */

 	Tcl_InitMemory(slaveInterp);

     }

     return slaveInterp;

     error:

     TclTransferResult(slaveInterp, TCL_ERROR, interp);

     Tcl_DeleteInterp(slaveInterp);

     return NULL;

 }

 /*

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

  *

  * SlaveObjCmd --

  *

  *	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

 SlaveObjCmd(clientData, interp, objc, objv)

     ClientData clientData;	/* Slave interpreter. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     Tcl_Interp *slaveInterp;

     int index;

     static CONST char *options[] = {

         "alias",	"aliases",	"eval",		"expose",

         "hide",		"hidden",	"issafe",	"invokehidden",

         "marktrusted",	"recursionlimit", NULL

     };

     enum options {

 	OPT_ALIAS,	OPT_ALIASES,	OPT_EVAL,	OPT_EXPOSE,

 	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHIDDEN,

 	OPT_MARKTRUSTED, OPT_RECLIMIT

     };

     slaveInterp = (Tcl_Interp *) clientData;

     if (slaveInterp == NULL) {

 	panic("SlaveObjCmd: interpreter has been deleted");

     }

     if (objc < 2) {

         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");

         return TCL_ERROR;

     }

     if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,

 	    &index) != TCL_OK) {

 	return TCL_ERROR;

     }

     switch ((enum options) index) {

 	case OPT_ALIAS: {

 	    if (objc > 2) {

 		if (objc == 3) {

 		    return AliasDescribe(interp, slaveInterp, objv[2]);

 		}

 		if (Tcl_GetString(objv[3])[0] == '\0') {

 		    if (objc == 4) {

 			return AliasDelete(interp, slaveInterp, objv[2]);

 		    }

 		} else {

 		    return AliasCreate(interp, slaveInterp, interp, objv[2],

 			    objv[3], objc - 4, objv + 4);

 		}

 	    }

 	    Tcl_WrongNumArgs(interp, 2, objv,

 		    "aliasName ?targetName? ?args..?");

             return TCL_ERROR;

 	}

 	case OPT_ALIASES: {

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);

 		return TCL_ERROR;

 	    }

 	    return AliasList(interp, slaveInterp);

 	}

 	case OPT_EVAL: {

 	    if (objc < 3) {

 		Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");

 		return TCL_ERROR;

 	    }

 	    return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);

 	}

         case OPT_EXPOSE: {

 	    if ((objc < 3) || (objc > 4)) {

 		Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");

 		return TCL_ERROR;

 	    }

             return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);

 	}

 	case OPT_HIDE: {

 	    if ((objc < 3) || (objc > 4)) {

 		Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");

 		return TCL_ERROR;

 	    }

             return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);

 	}

         case OPT_HIDDEN: {

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, NULL);

 		return TCL_ERROR;

 	    }

             return SlaveHidden(interp, slaveInterp);

 	}

         case OPT_ISSAFE: {

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);

 		return TCL_ERROR;

 	    }

 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), Tcl_IsSafe(slaveInterp));

 	    return TCL_OK;

 	}

         case OPT_INVOKEHIDDEN: {

 	    int global, i, index;

 	    static CONST char *hiddenOptions[] = {

 		"-global",	"--",		NULL

 	    };

 	    enum hiddenOption {

 		OPT_GLOBAL,	OPT_LAST

 	    };

 	    global = 0;

 	    for (i = 2; i < objc; i++) {

 		if (Tcl_GetString(objv[i])[0] != '-') {

 		    break;

 		}

 		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,

 			"option", 0, &index) != TCL_OK) {

 		    return TCL_ERROR;

 		}

 		if (index == OPT_GLOBAL) {

 		    global = 1;

 		} else {

 		    i++;

 		    break;

 		}

 	    }

 	    if (objc - i < 1) {

 		Tcl_WrongNumArgs(interp, 2, objv,

 			"?-global? ?--? cmd ?arg ..?");

 		return TCL_ERROR;

 	    }

 	    return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,

 		    objv + i);

 	}

 	case OPT_MARKTRUSTED: {

 	    if (objc != 2) {

 		Tcl_WrongNumArgs(interp, 2, objv, NULL);

 		return TCL_ERROR;

 	    }

             return SlaveMarkTrusted(interp, slaveInterp);

 	}

 	case OPT_RECLIMIT: {

 	    if (objc != 2 && objc != 3) {

 		Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");

 		return TCL_ERROR;

 	    }

 	    return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);

 	}

     }

     return TCL_ERROR;

 }

 /*

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

  *

  * SlaveObjCmdDeleteProc --

  *

  *	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

 SlaveObjCmdDeleteProc(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 = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

     /*

      * Unlink the slave from its master interpreter.

      */

     Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);

     /*

      * Set to NULL so that when the InterpInfo is cleaned up in the slave

      * it does not try to delete the command causing all sorts of grief.

      * See SlaveRecordDeleteProc().

      */

     slavePtr->interpCmd = NULL;

     if (slavePtr->slaveInterp != NULL) {

 	Tcl_DeleteInterp(slavePtr->slaveInterp);

     }

 }

 /*

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

  *

  * SlaveEval --

  *

  *	Helper function to evaluate a command in a slave interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Whatever the command does.

  *

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

  */

 static int

 SlaveEval(interp, slaveInterp, objc, objv)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp *slaveInterp;	/* The slave interpreter in which command

 				 * will be evaluated. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     int result;

     Tcl_Obj *objPtr;

     Tcl_Preserve((ClientData) slaveInterp);

     Tcl_AllowExceptions(slaveInterp);

     if (objc == 1) {

 #ifndef TCL_TIP280

 	result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);

 #else

         /* TIP #280 : Make invoker available to eval'd script */

         Interp* iPtr = (Interp*) interp;

 	result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr,0);

 #endif

     } else {

 	objPtr = Tcl_ConcatObj(objc, objv);

 	Tcl_IncrRefCount(objPtr);

 	result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);

 	Tcl_DecrRefCount(objPtr);

     }

     TclTransferResult(slaveInterp, result, interp);

     Tcl_Release((ClientData) slaveInterp);

     return result;

 }

 /*

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

  *

  * SlaveExpose --

  *

  *	Helper function to expose a command in a slave interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	After this call scripts in the slave will be able to invoke

  *	the newly exposed command.

  *

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

  */

 static int

 SlaveExpose(interp, slaveInterp, objc, objv)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument strings. */

 {

     char *name;

     if (Tcl_IsSafe(interp)) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"permission denied: safe interpreter cannot expose commands",

 		(char *) NULL);

 	return TCL_ERROR;

     }

     name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);

     if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),

 	    name) != TCL_OK) {

 	TclTransferResult(slaveInterp, TCL_ERROR, interp);

 	return TCL_ERROR;

     }

     return TCL_OK;

 }

 /*

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

  *

  * SlaveRecursionLimit --

  *

  *	Helper function to set/query the Recursion limit of an interp

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *      When (objc == 1), slaveInterp will be set to a new recursion

  *	limit of objv[0].

  *

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

  */

 static int

 SlaveRecursionLimit(interp, slaveInterp, objc, objv)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp	*slaveInterp;	/* Interp in which limit is set/queried. */

     int objc;			/* Set or Query. */

     Tcl_Obj *CONST objv[];	/* Argument strings. */

 {

     Interp *iPtr;

     int limit;

     if (objc) {

 	if (Tcl_IsSafe(interp)) {

 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		    "permission denied: ",

 		    "safe interpreters cannot change recursion limit",

 		    (char *) NULL);

 	    return TCL_ERROR;

 	}

 	if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {

 	    return TCL_ERROR;

 	}

 	if (limit <= 0) {

 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(

 		    "recursion limit must be > 0", -1));

 	    return TCL_ERROR;

 	}

 	Tcl_SetRecursionLimit(slaveInterp, limit);

 	iPtr = (Interp *) slaveInterp;

 	if (interp == slaveInterp && iPtr->numLevels > limit) {

 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(

 		    "falling back due to new recursion limit", -1));

 	    return TCL_ERROR;

 	}

 	Tcl_SetObjResult(interp, objv[0]);

         return TCL_OK;

     } else {

 	limit = Tcl_SetRecursionLimit(slaveInterp, 0);

 	Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));

         return TCL_OK;

     }

 }

 /*

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

  *

  * SlaveHide --

  *

  *	Helper function to hide a command in a slave interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	After this call scripts in the slave will no longer be able

  *	to invoke the named command.

  *

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

  */

 static int

 SlaveHide(interp, slaveInterp, objc, objv)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp	*slaveInterp;	/* Interp in which command will be exposed. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument strings. */

 {

     char *name;

     if (Tcl_IsSafe(interp)) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"permission denied: safe interpreter cannot hide commands",

 		(char *) NULL);

 	return TCL_ERROR;

     }

     name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);

     if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),

 	    name) != TCL_OK) {

 	TclTransferResult(slaveInterp, TCL_ERROR, interp);

 	return TCL_ERROR;

     }

     return TCL_OK;

 }

 /*

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

  *

  * SlaveHidden --

  *

  *	Helper function to compute list of hidden commands in a slave

  *	interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	None.

  *

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

  */

 static int

 SlaveHidden(interp, slaveInterp)

     Tcl_Interp *interp;		/* Interp for data return. */

     Tcl_Interp *slaveInterp;	/* Interp whose hidden commands to query. */

 {

     Tcl_Obj *listObjPtr;		/* Local object pointer. */

     Tcl_HashTable *hTblPtr;		/* For local searches. */

     Tcl_HashEntry *hPtr;		/* For local searches. */

     Tcl_HashSearch hSearch;		/* For local searches. */

     listObjPtr = Tcl_GetObjResult(interp);

     hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;

     if (hTblPtr != (Tcl_HashTable *) NULL) {

 	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);

 	     hPtr != (Tcl_HashEntry *) NULL;

 	     hPtr = Tcl_NextHashEntry(&hSearch)) {

 	    Tcl_ListObjAppendElement(NULL, listObjPtr,

 		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));

 	}

     }

     return TCL_OK;

 }

 /*

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

  *

  * SlaveInvokeHidden --

  *

  *	Helper function to invoke a hidden command in a slave interpreter.

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	Whatever the hidden command does.

  *

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

  */

 static int

 SlaveInvokeHidden(interp, slaveInterp, global, objc, objv)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp *slaveInterp;	/* The slave interpreter in which command

 				 * will be invoked. */

     int global;			/* Non-zero to invoke in global namespace. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* Argument objects. */

 {

     int result;

     if (Tcl_IsSafe(interp)) {

 	Tcl_SetStringObj(Tcl_GetObjResult(interp),

 		"not allowed to invoke hidden commands from safe interpreter",

 		-1);

 	return TCL_ERROR;

     }

     Tcl_Preserve((ClientData) slaveInterp);

     Tcl_AllowExceptions(slaveInterp);

     if (global) {

         result = TclObjInvokeGlobal(slaveInterp, objc, objv,

                 TCL_INVOKE_HIDDEN);

     } else {

         result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);

     }

     TclTransferResult(slaveInterp, result, interp);

     Tcl_Release((ClientData) slaveInterp);

     return result;        

 }

 /*

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

  *

  * SlaveMarkTrusted --

  *

  *	Helper function to mark a slave interpreter as trusted (unsafe).

  *

  * Results:

  *	A standard Tcl result.

  *

  * Side effects:

  *	After this call the hard-wired security checks in the core no

  *	longer prevent the slave from performing certain operations.

  *

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

  */

 static int

 SlaveMarkTrusted(interp, slaveInterp)

     Tcl_Interp *interp;		/* Interp for error return. */

     Tcl_Interp *slaveInterp;	/* The slave interpreter which will be

 				 * marked trusted. */

 {

     if (Tcl_IsSafe(interp)) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"permission denied: safe interpreter cannot mark trusted",

 		(char *) NULL);

 	return TCL_ERROR;

     }

     ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;

     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.

  *

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

  */

 EXPORT_C int

 Tcl_IsSafe(interp)

     Tcl_Interp *interp;		/* Is this interpreter "safe" ? */

 {

     Interp *iPtr;

     if (interp == (Tcl_Interp *) NULL) {

         return 0;

     }

     iPtr = (Interp *) interp;

     return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;

 }

 /*

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

  *

  * Tcl_MakeSafe --

  *

  *	Makes its argument interpreter contain only functionality that is

  *	defined to be part of Safe Tcl. Unsafe commands are hidden, the

  *	env array is unset, and the standard channels are removed.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Hides commands in its argument interpreter, and removes settings

  *	and channels.

  *

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

  */

 EXPORT_C int

 Tcl_MakeSafe(interp)

     Tcl_Interp *interp;		/* Interpreter to be made safe. */

 {

     Tcl_Channel chan;				/* Channel to remove from

                                                  * safe interpreter. */

     Interp *iPtr = (Interp *) interp;

     TclHideUnsafeCommands(interp);

     iPtr->flags |= SAFE_INTERP;

     /*

      *  Unsetting variables : (which should not have been set 

      *  in the first place, but...)

      */

     /*

      * No env array in a safe slave.

      */

     Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);

     /* 

      * Remove unsafe parts of tcl_platform

      */

     Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);

     Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);

     Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);

     Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);

     /*

      * Unset path informations variables

      * (the only one remaining is [info nameofexecutable])

      */

     Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);

     Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);

     Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);

     /*

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

 }