home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclInterp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  122.1 KB  |  3,827 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclInterp.c --
  3.  *
  4.  *    This file implements the "interp" command which allows creation
  5.  *    and manipulation of Tcl interpreters from within Tcl scripts.
  6.  *
  7.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  8.  *
  9.  * See the file "license.terms" for information on usage and redistribution
  10.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11.  *
  12.  * SCCS: @(#) tclInterp.c 1.125 97/08/05 15:22:51
  13.  */
  14.  
  15. #include <stdio.h>
  16. #include "tclInt.h"
  17. #include "tclPort.h"
  18.  
  19. /*
  20.  * Counter for how many aliases were created (global)
  21.  */
  22.  
  23. static int aliasCounter = 0;
  24.  
  25. /*
  26.  *
  27.  * struct Slave:
  28.  *
  29.  * Used by the "interp" command to record and find information about slave
  30.  * interpreters. Maps from a command name in the master to information about
  31.  * a slave interpreter, e.g. what aliases are defined in it.
  32.  */
  33.  
  34. typedef struct {
  35.     Tcl_Interp *masterInterp;    /* Master interpreter for this slave. */
  36.     Tcl_HashEntry *slaveEntry;    /* Hash entry in masters slave table for
  37.                                  * this slave interpreter. Used to find
  38.                                  * this record, and used when deleting the
  39.                                  * slave interpreter to delete it from the
  40.                                  * masters table. */
  41.     Tcl_Interp    *slaveInterp;    /* The slave interpreter. */
  42.     Tcl_Command interpCmd;    /* Interpreter object command. */
  43.     Tcl_HashTable aliasTable;    /* Table which maps from names of commands
  44.                                  * in slave interpreter to struct Alias
  45.                                  * defined below. */
  46. } Slave;
  47.  
  48. /*
  49.  * struct Alias:
  50.  *
  51.  * Stores information about an alias. Is stored in the slave interpreter
  52.  * and used by the source command to find the target command in the master
  53.  * when the source command is invoked.
  54.  */
  55.  
  56. typedef struct {
  57.     char    *aliasName;    /* Name of alias command. */
  58.     char    *targetName;    /* Name of target command in master interp. */
  59.     Tcl_Interp    *targetInterp;    /* Master interpreter. */
  60.     int        objc;        /* Count of additional args to pass. */
  61.     Tcl_Obj    **objv;        /* Actual additional args to pass. */
  62.     Tcl_HashEntry *aliasEntry;    /* Entry for the alias hash table in slave.
  63.                                  * This is used by alias deletion to remove
  64.                                  * the alias from the slave interpreter
  65.                                  * alias table. */
  66.     Tcl_HashEntry *targetEntry;    /* Entry for target command in master.
  67.                                  * This is used in the master interpreter to
  68.                                  * map back from the target command to aliases
  69.                                  * redirecting to it. Random access to this
  70.                                  * hash table is never required - we are using
  71.                                  * a hash table only for convenience. */
  72.     Tcl_Command slaveCmd;    /* Source command in slave interpreter. */
  73. } Alias;
  74.  
  75. /*
  76.  * struct Target:
  77.  *
  78.  * Maps from master interpreter commands back to the source commands in slave
  79.  * interpreters. This is needed because aliases can be created between sibling
  80.  * interpreters and must be deleted when the target interpreter is deleted. In
  81.  * case they would not be deleted the source interpreter would be left with a
  82.  * "dangling pointer". One such record is stored in the Master record of the
  83.  * master interpreter (in the targetTable hashtable, see below) with the
  84.  * master for each alias which directs to a command in the master. These
  85.  * records are used to remove the source command for an from a slave if/when
  86.  * the master is deleted.
  87.  */
  88.  
  89. typedef struct {
  90.     Tcl_Command    slaveCmd;    /* Command for alias in slave interp. */
  91.     Tcl_Interp *slaveInterp;    /* Slave Interpreter. */
  92. } Target;
  93.  
  94. /*
  95.  * struct Master:
  96.  *
  97.  * This record is used for two purposes: First, slaveTable (a hashtable)
  98.  * maps from names of commands to slave interpreters. This hashtable is
  99.  * used to store information about slave interpreters of this interpreter,
  100.  * to map over all slaves, etc. The second purpose is to store information
  101.  * about all aliases in slaves (or siblings) which direct to target commands
  102.  * in this interpreter (using the targetTable hashtable).
  103.  * 
  104.  * NB: the flags field in the interp structure, used with SAFE_INTERP
  105.  * mask denotes whether the interpreter is safe or not. Safe
  106.  * interpreters have restricted functionality, can only create safe slave
  107.  * interpreters and can only load safe extensions.
  108.  */
  109.  
  110. typedef struct {
  111.     Tcl_HashTable slaveTable;    /* Hash table for slave interpreters.
  112.                                  * Maps from command names to Slave records. */
  113.     Tcl_HashTable targetTable;    /* Hash table for Target Records. Contains
  114.                                  * all Target records which denote aliases
  115.                                  * from slaves or sibling interpreters that
  116.                                  * direct to commands in this interpreter. This
  117.                                  * table is used to remove dangling pointers
  118.                                  * from the slave (or sibling) interpreters
  119.                                  * when this interpreter is deleted. */
  120. } Master;
  121.  
  122. /*
  123.  * Prototypes for local static procedures:
  124.  */
  125.  
  126. static int        AliasCmd _ANSI_ARGS_((ClientData dummy,
  127.                 Tcl_Interp *currentInterp, int objc,
  128.                     Tcl_Obj *CONST objv[]));
  129. static void        AliasCmdDeleteProc _ANSI_ARGS_((
  130.                 ClientData clientData));
  131. static int        AliasCreationHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
  132.                 Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
  133.                 Master *masterPtr, char *aliasName,
  134.                 char *targetName, int objc,
  135.                 Tcl_Obj *CONST objv[]));
  136. static int        CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  137.                 Master *masterPtr, int objc,
  138.                     Tcl_Obj *CONST objv[]));
  139. static Tcl_Interp    *CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
  140.                     Master *masterPtr, char *slavePath, int safe));
  141. static int        DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
  142.                 Tcl_Interp *slaveInterp, char *aliasName));
  143. static int        DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
  144.                 Tcl_Interp *slaveInterp, char *aliasName));
  145. static int        DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  146.                 Master *masterPtr, int objc,
  147.                     Tcl_Obj *CONST objv[]));
  148. static int        DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  149.                 Master *masterPtr, char *path));
  150. static Tcl_Interp    *GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
  151.                 Master *masterPtr, char *path,
  152.                 Master **masterPtrPtr));
  153. static int        GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
  154.                 char *aliasName));
  155. static int        InterpAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
  156.                     Master *masterPtr, int objc,
  157.                     Tcl_Obj *CONST objv[]));
  158. static int        InterpAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
  159.                     Master *masterPtr, int objc,
  160.                     Tcl_Obj *CONST objv[]));
  161. static int        InterpExistsHelper _ANSI_ARGS_((Tcl_Interp *interp,
  162.                 Master *masterPtr, int objc,
  163.                     Tcl_Obj *CONST objv[]));
  164. static int        InterpEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
  165.                 Master *masterPtr, int objc,
  166.                     Tcl_Obj *CONST objv[]));
  167. static int        InterpExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
  168.                 Master *masterPtr, int objc,
  169.                     Tcl_Obj *CONST objv[]));
  170. static int        InterpIsSafeHelper _ANSI_ARGS_((Tcl_Interp *interp,
  171.                 Master *masterPtr, int objc,
  172.                     Tcl_Obj *CONST objv[]));
  173. static int        InterpHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
  174.                 Master *masterPtr, int objc,
  175.                     Tcl_Obj *CONST objv[]));
  176. static int        InterpHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
  177.                 Master *masterPtr, int objc,
  178.                     Tcl_Obj *CONST objv[]));
  179. static int        InterpInvokeHiddenHelper _ANSI_ARGS_((
  180.                     Tcl_Interp *interp, Master *masterPtr, int objc,
  181.                     Tcl_Obj *CONST objv[]));
  182. static int        InterpMarkTrustedHelper _ANSI_ARGS_((
  183.                     Tcl_Interp *interp, Master *masterPtr, int objc,
  184.                     Tcl_Obj *CONST objv[]));
  185. static int        InterpSlavesHelper _ANSI_ARGS_((Tcl_Interp *interp,
  186.                 Master *masterPtr, int objc,
  187.                     Tcl_Obj *CONST objv[]));
  188. static int        InterpShareHelper _ANSI_ARGS_((Tcl_Interp *interp,
  189.                 Master *masterPtr, int objc,
  190.                     Tcl_Obj *CONST objv[]));
  191. static int        InterpTargetHelper _ANSI_ARGS_((Tcl_Interp *interp,
  192.                 Master *masterPtr, int objc,
  193.                     Tcl_Obj *CONST objv[]));
  194. static int        InterpTransferHelper _ANSI_ARGS_((Tcl_Interp *interp,
  195.                 Master *masterPtr, int objc,
  196.                     Tcl_Obj *CONST objv[]));
  197. static int        MarkTrusted _ANSI_ARGS_((Tcl_Interp *interp));
  198. static void        MasterRecordDeleteProc _ANSI_ARGS_((
  199.                 ClientData clientData, Tcl_Interp *interp));
  200. static int        SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
  201.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  202.                     int objc, Tcl_Obj *CONST objv[]));
  203. static int        SlaveAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
  204.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  205.                     int objc, Tcl_Obj *CONST objv[]));
  206. static int        SlaveEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
  207.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  208.                     int objc, Tcl_Obj *CONST objv[]));
  209. static int        SlaveExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
  210.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  211.                     int objc, Tcl_Obj *CONST objv[]));
  212. static int        SlaveHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
  213.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  214.                     int objc, Tcl_Obj *CONST objv[]));
  215. static int        SlaveHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
  216.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  217.                     int objc, Tcl_Obj *CONST objv[]));
  218. static int        SlaveIsSafeHelper _ANSI_ARGS_((
  219.                     Tcl_Interp *interp, Tcl_Interp *slaveInterp,
  220.                             Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
  221. static int        SlaveInvokeHiddenHelper _ANSI_ARGS_((
  222.                     Tcl_Interp *interp, Tcl_Interp *slaveInterp,
  223.                             Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
  224. static int        SlaveMarkTrustedHelper _ANSI_ARGS_((Tcl_Interp *interp,
  225.                     Tcl_Interp *slaveInterp, Slave *slavePtr,
  226.                     int objc, Tcl_Obj *CONST objv[]));
  227. static int        SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
  228.                 Tcl_Interp *interp, int objc,
  229.                 Tcl_Obj *CONST objv[]));
  230. static void        SlaveObjectDeleteProc _ANSI_ARGS_((
  231.                 ClientData clientData));
  232. static void        SlaveRecordDeleteProc _ANSI_ARGS_((
  233.                 ClientData clientData, Tcl_Interp *interp));
  234.  
  235. /*
  236.  *----------------------------------------------------------------------
  237.  *
  238.  * TclPreventAliasLoop --
  239.  *
  240.  *    When defining an alias or renaming a command, prevent an alias
  241.  *    loop from being formed.
  242.  *
  243.  * Results:
  244.  *    A standard Tcl object result.
  245.  *
  246.  * Side effects:
  247.  *    If TCL_ERROR is returned, the function also stores an error message
  248.  *    in the interpreter's result object.
  249.  *
  250.  * NOTE:
  251.  *    This function is public internal (instead of being static to
  252.  *    this file) because it is also used from TclRenameCommand.
  253.  *
  254.  *----------------------------------------------------------------------
  255.  */
  256.  
  257. int
  258. TclPreventAliasLoop(interp, cmdInterp, cmd)
  259.     Tcl_Interp *interp;            /* Interp in which to report errors. */
  260.     Tcl_Interp *cmdInterp;        /* Interp in which the command is
  261.                                          * being defined. */
  262.     Tcl_Command cmd;                    /* Tcl command we are attempting
  263.                                          * to define. */
  264. {
  265.     Command *cmdPtr = (Command *) cmd;
  266.     Alias *aliasPtr, *nextAliasPtr;
  267.     Tcl_Command aliasCmd;
  268.     Command *aliasCmdPtr;
  269.     
  270.     /*
  271.      * If we are not creating or renaming an alias, then it is
  272.      * always OK to create or rename the command.
  273.      */
  274.     
  275.     if (cmdPtr->objProc != AliasCmd) {
  276.         return TCL_OK;
  277.     }
  278.  
  279.     /*
  280.      * OK, we are dealing with an alias, so traverse the chain of aliases.
  281.      * If we encounter the alias we are defining (or renaming to) any in
  282.      * the chain then we have a loop.
  283.      */
  284.  
  285.     aliasPtr = (Alias *) cmdPtr->objClientData;
  286.     nextAliasPtr = aliasPtr;
  287.     while (1) {
  288.  
  289.         /*
  290.          * If the target of the next alias in the chain is the same as
  291.          * the source alias, we have a loop.
  292.      */
  293.  
  294.     aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
  295.                 nextAliasPtr->targetName,
  296.         Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
  297.         /*flags*/ 0);
  298.         if (aliasCmd == (Tcl_Command) NULL) {
  299.             return TCL_OK;
  300.         }
  301.     aliasCmdPtr = (Command *) aliasCmd;
  302.         if (aliasCmdPtr == cmdPtr) {
  303.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  304.         "cannot define or rename alias \"", aliasPtr->aliasName,
  305.         "\": would create a loop", (char *) NULL);
  306.             return TCL_ERROR;
  307.         }
  308.  
  309.         /*
  310.      * Otherwise, follow the chain one step further. See if the target
  311.          * command is an alias - if so, follow the loop to its target
  312.          * command. Otherwise we do not have a loop.
  313.      */
  314.  
  315.         if (aliasCmdPtr->objProc != AliasCmd) {
  316.             return TCL_OK;
  317.         }
  318.         nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
  319.     }
  320.  
  321.     /* NOTREACHED */
  322. }
  323.  
  324. /*
  325.  *----------------------------------------------------------------------
  326.  *
  327.  * MarkTrusted --
  328.  *
  329.  *    Mark an interpreter as unsafe (i.e. remove the "safe" mark).
  330.  *
  331.  * Results:
  332.  *    A standard Tcl result.
  333.  *
  334.  * Side effects:
  335.  *    Removes the "safe" mark from an interpreter.
  336.  *
  337.  *----------------------------------------------------------------------
  338.  */
  339.  
  340. static int
  341. MarkTrusted(interp)
  342.     Tcl_Interp *interp;        /* Interpreter to be marked unsafe. */
  343. {
  344.     Interp *iPtr = (Interp *) interp;
  345.  
  346.     iPtr->flags &= ~SAFE_INTERP;
  347.     return TCL_OK;
  348. }
  349.  
  350. /*
  351.  *----------------------------------------------------------------------
  352.  *
  353.  * Tcl_MakeSafe --
  354.  *
  355.  *    Makes its argument interpreter contain only functionality that is
  356.  *    defined to be part of Safe Tcl. Unsafe commands are hidden, the
  357.  *    env array is unset, and the standard channels are removed.
  358.  *
  359.  * Results:
  360.  *    None.
  361.  *
  362.  * Side effects:
  363.  *    Hides commands in its argument interpreter, and removes settings
  364.  *    and channels.
  365.  *
  366.  *----------------------------------------------------------------------
  367.  */
  368.  
  369. int
  370. Tcl_MakeSafe(interp)
  371.     Tcl_Interp *interp;        /* Interpreter to be made safe. */
  372. {
  373.     Tcl_Channel chan;                /* Channel to remove from
  374.                                                  * safe interpreter. */
  375.     Interp *iPtr = (Interp *) interp;
  376.  
  377.     TclHideUnsafeCommands(interp);
  378.     
  379.     iPtr->flags |= SAFE_INTERP;
  380.  
  381.     /*
  382.      *  Unsetting variables : (which should not have been set 
  383.      *  in the first place, but...)
  384.      */
  385.  
  386.     /*
  387.      * No env array in a safe slave.
  388.      */
  389.  
  390.     Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
  391.  
  392.     /* 
  393.      * Remove unsafe parts of tcl_platform
  394.      */
  395.  
  396.     Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
  397.     Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
  398.     Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
  399.  
  400.     /*
  401.      * Unset path informations variables
  402.      * (the only one remaining is [info nameofexecutable])
  403.      */
  404.  
  405.     Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
  406.     Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
  407.     
  408.     /*
  409.      * Remove the standard channels from the interpreter; safe interpreters
  410.      * do not ordinarily have access to stdin, stdout and stderr.
  411.      *
  412.      * NOTE: These channels are not added to the interpreter by the
  413.      * Tcl_CreateInterp call, but may be added later, by another I/O
  414.      * operation. We want to ensure that the interpreter does not have
  415.      * these channels even if it is being made safe after being used for
  416.      * some time..
  417.      */
  418.  
  419.     chan = Tcl_GetStdChannel(TCL_STDIN);
  420.     if (chan != (Tcl_Channel) NULL) {
  421.         Tcl_UnregisterChannel(interp, chan);
  422.     }
  423.     chan = Tcl_GetStdChannel(TCL_STDOUT);
  424.     if (chan != (Tcl_Channel) NULL) {
  425.         Tcl_UnregisterChannel(interp, chan);
  426.     }
  427.     chan = Tcl_GetStdChannel(TCL_STDERR);
  428.     if (chan != (Tcl_Channel) NULL) {
  429.         Tcl_UnregisterChannel(interp, chan);
  430.     }
  431.  
  432.     return TCL_OK;
  433. }
  434.  
  435. /*
  436.  *----------------------------------------------------------------------
  437.  *
  438.  * GetInterp --
  439.  *
  440.  *    Helper function to find a slave interpreter given a pathname.
  441.  *
  442.  * Results:
  443.  *    Returns the slave interpreter known by that name in the calling
  444.  *    interpreter, or NULL if no interpreter known by that name exists. 
  445.  *
  446.  * Side effects:
  447.  *    Assigns to the pointer variable passed in, if not NULL.
  448.  *
  449.  *----------------------------------------------------------------------
  450.  */
  451.  
  452. static Tcl_Interp *
  453. GetInterp(interp, masterPtr, path, masterPtrPtr)
  454.     Tcl_Interp *interp;        /* Interp. to start search from. */
  455.     Master *masterPtr;        /* Its master record. */
  456.     char *path;            /* The path (name) of interp. to be found. */
  457.     Master **masterPtrPtr;    /* (Return) its master record. */
  458. {
  459.     Tcl_HashEntry *hPtr;    /* Search element. */
  460.     Slave *slavePtr;        /* Interim slave record. */
  461.     char **argv;        /* Split-up path (name) for interp to find. */
  462.     int argc, i;        /* Loop indices. */
  463.     Tcl_Interp *searchInterp;    /* Interim storage for interp. to find. */
  464.  
  465.     if (masterPtrPtr != (Master **) NULL) {
  466.         *masterPtrPtr = masterPtr;
  467.     }
  468.     
  469.     if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
  470.         return (Tcl_Interp *) NULL;
  471.     }
  472.  
  473.     for (searchInterp = interp, i = 0; i < argc; i++) {
  474.         
  475.         hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
  476.         if (hPtr == (Tcl_HashEntry *) NULL) {
  477.             ckfree((char *) argv);
  478.             return (Tcl_Interp *) NULL;
  479.         }
  480.         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  481.         searchInterp = slavePtr->slaveInterp;
  482.         if (searchInterp == (Tcl_Interp *) NULL) {
  483.             ckfree((char *) argv);
  484.             return (Tcl_Interp *) NULL;
  485.         }
  486.         masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
  487.                 "tclMasterRecord", NULL);
  488.         if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
  489.         if (masterPtr == (Master *) NULL) {
  490.             ckfree((char *) argv);
  491.             return (Tcl_Interp *) NULL;
  492.         }
  493.     }
  494.     ckfree((char *) argv);
  495.     return searchInterp;
  496. }
  497.  
  498. /*
  499.  *----------------------------------------------------------------------
  500.  *
  501.  * CreateSlave --
  502.  *
  503.  *    Helper function to do the actual work of creating a slave interp
  504.  *    and new object command. Also optionally makes the new slave
  505.  *    interpreter "safe".
  506.  *
  507.  * Results:
  508.  *    Returns the new Tcl_Interp * if successful or NULL if not. If failed,
  509.  *    the result of the invoking interpreter contains an error message.
  510.  *
  511.  * Side effects:
  512.  *    Creates a new slave interpreter and a new object command.
  513.  *
  514.  *----------------------------------------------------------------------
  515.  */
  516.  
  517. static Tcl_Interp *
  518. CreateSlave(interp, masterPtr, slavePath, safe)
  519.     Tcl_Interp *interp;            /* Interp. to start search from. */
  520.     Master *masterPtr;            /* Master record. */
  521.     char *slavePath;            /* Path (name) of slave to create. */
  522.     int safe;                /* Should we make it "safe"? */
  523. {
  524.     Tcl_Interp *slaveInterp;        /* Ptr to slave interpreter. */
  525.     Tcl_Interp *masterInterp;        /* Ptr to master interp for slave. */
  526.     Slave *slavePtr;            /* Slave record. */
  527.     Tcl_HashEntry *hPtr;        /* Entry into interp hashtable. */
  528.     int new;                /* Indicates whether new entry. */
  529.     int argc;                /* Count of elements in slavePath. */
  530.     char **argv;            /* Elements in slavePath. */
  531.     char *masterPath;            /* Path to its master. */
  532.  
  533.     if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
  534.         return (Tcl_Interp *) NULL;
  535.     }
  536.  
  537.     if (argc < 2) {
  538.         masterInterp = interp;
  539.         if (argc == 1) {
  540.             slavePath = argv[0];
  541.         }
  542.     } else {
  543.         masterPath = Tcl_Merge(argc-1, argv);
  544.         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
  545.         if (masterInterp == (Tcl_Interp *) NULL) {
  546.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  547.                     "interpreter named \"", masterPath,
  548.                     "\" not found", (char *) NULL);
  549.             ckfree((char *) argv);
  550.             ckfree((char *) masterPath);
  551.             return (Tcl_Interp *) NULL;
  552.         }
  553.         ckfree((char *) masterPath);
  554.         slavePath = argv[argc-1];
  555.         if (!safe) {
  556.             safe = Tcl_IsSafe(masterInterp);
  557.         }
  558.     }
  559.     hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
  560.     if (new == 0) {
  561.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  562.                 "interpreter named \"", slavePath,
  563.                 "\" already exists, cannot create", (char *) NULL);
  564.         ckfree((char *) argv);
  565.         return (Tcl_Interp *) NULL;
  566.     }
  567.     slaveInterp = Tcl_CreateInterp();
  568.     if (slaveInterp == (Tcl_Interp *) NULL) {
  569.         panic("CreateSlave: out of memory while creating a new interpreter");
  570.     }
  571.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
  572.     slavePtr->masterInterp = masterInterp;
  573.     slavePtr->slaveEntry = hPtr;
  574.     slavePtr->slaveInterp = slaveInterp;
  575.     slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, slavePath,
  576.             SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
  577.     Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
  578.     (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
  579.             SlaveRecordDeleteProc, (ClientData) slavePtr);
  580.     Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
  581.     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
  582.     
  583.     if (safe) {
  584.         if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
  585.             goto error;
  586.         }
  587.     } else {
  588.         if (Tcl_Init(slaveInterp) == TCL_ERROR) {
  589.             goto error;
  590.         }
  591.     }
  592.  
  593.     ckfree((char *) argv);
  594.     return slaveInterp;
  595.  
  596. error:
  597.  
  598.     Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
  599.             NULL, TCL_GLOBAL_ONLY));
  600.     Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  601.             Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
  602.                     TCL_GLOBAL_ONLY),
  603.             TCL_GLOBAL_ONLY);
  604.  
  605.     Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  606.     Tcl_ResetResult(slaveInterp);
  607.  
  608.     (void) Tcl_DeleteCommand(masterInterp, slavePath);
  609.     return (Tcl_Interp *) NULL;
  610. }
  611.  
  612. /*
  613.  *----------------------------------------------------------------------
  614.  *
  615.  * CreateInterpObject -
  616.  *
  617.  *    Helper function to do the actual work of creating a new interpreter
  618.  *    and an object command. 
  619.  *
  620.  * Results:
  621.  *    A Tcl result.
  622.  *
  623.  * Side effects:
  624.  *    See user documentation for details.
  625.  *
  626.  *----------------------------------------------------------------------
  627.  */
  628.  
  629. static int
  630. CreateInterpObject(interp, masterPtr, objc, objv)
  631.     Tcl_Interp *interp;            /* Invoking interpreter. */
  632.     Master *masterPtr;            /* Master record for same. */
  633.     int objc;                /* Number of arguments. */
  634.     Tcl_Obj *CONST objv[];        /* with alias. */
  635. {
  636.     int safe;                /* Create a safe interpreter? */
  637.     int moreFlags;            /* Expecting more flag args? */
  638.     char *string;            /* Local pointer to object string. */
  639.     char *slavePath;            /* Name of slave. */
  640.     char localSlaveName[200];        /* Local area for creating names. */
  641.     int i;                /* Loop counter. */
  642.     int len;                /* Length of option argument. */
  643.     static int interpCounter = 0;    /* Unique id for created names. */
  644.  
  645.     moreFlags = 1;
  646.     slavePath = NULL;
  647.     safe = Tcl_IsSafe(interp);
  648.     
  649.     if ((objc < 2) || (objc > 5)) {
  650.         Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
  651.         return TCL_ERROR;
  652.     }
  653.     for (i = 2; i < objc; i++) {
  654.         string = Tcl_GetStringFromObj(objv[i], &len);
  655.         if ((string[0] == '-') && (moreFlags != 0)) {
  656.             if ((string[1] == 's') &&
  657.                 (strncmp(string, "-safe", (size_t) len) == 0) &&
  658.                 (len > 1)){
  659.                 safe = 1;
  660.             } else if ((strncmp(string, "--", (size_t) len) == 0) &&
  661.                        (len > 1)) {
  662.                 moreFlags = 0;
  663.             } else {
  664.                 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  665.                         "bad option \"", string, "\": should be -safe",
  666.                         (char *) NULL);
  667.                 return TCL_ERROR;
  668.             }
  669.         } else {
  670.             slavePath = string;
  671.         }
  672.     }
  673.     if (slavePath == (char *) NULL) {
  674.  
  675.         /*
  676.          * Create an anonymous interpreter -- we choose its name and
  677.          * the name of the command. We check that the command name that
  678.          * we use for the interpreter does not collide with an existing
  679.          * command in the master interpreter.
  680.          */
  681.         
  682.         while (1) {
  683.             Tcl_CmdInfo cmdInfo;
  684.             
  685.             sprintf(localSlaveName, "interp%d", interpCounter);
  686.             interpCounter++;
  687.             if (!(Tcl_GetCommandInfo(interp, localSlaveName, &cmdInfo))) {
  688.                 break;
  689.             }
  690.         }
  691.         slavePath = localSlaveName;
  692.     }
  693.     if (CreateSlave(interp, masterPtr, slavePath, safe) != NULL) {
  694.         Tcl_SetObjResult(interp, Tcl_NewStringObj(slavePath, -1));
  695.         return TCL_OK;
  696.     } else {
  697.         /*
  698.          * CreateSlave already set the result if there was an error,
  699.          * so we do not do it here.
  700.          */
  701.         return TCL_ERROR;
  702.     }
  703. }
  704.  
  705. /*
  706.  *----------------------------------------------------------------------
  707.  *
  708.  * DeleteOneInterpObject --
  709.  *
  710.  *    Helper function for DeleteInterpObject. It deals with deleting one
  711.  *    interpreter at a time.
  712.  *
  713.  * Results:
  714.  *    A standard Tcl result.
  715.  *
  716.  * Side effects:
  717.  *    Deletes an interpreter and its interpreter object command.
  718.  *
  719.  *----------------------------------------------------------------------
  720.  */
  721.  
  722. static int
  723. DeleteOneInterpObject(interp, masterPtr, path)
  724.     Tcl_Interp *interp;            /* Interpreter for reporting errors. */
  725.     Master *masterPtr;            /* Interim storage for master record.*/
  726.     char *path;                /* Path of interpreter to delete. */
  727. {
  728.     Slave *slavePtr;            /* Interim storage for slave record. */
  729.     Tcl_Interp *masterInterp;        /* Master of interp. to delete. */
  730.     Tcl_HashEntry *hPtr;        /* Search element. */
  731.     int localArgc;            /* Local copy of count of elements in
  732.                                          * path (name) of interp. to delete. */
  733.     char **localArgv;            /* Local copy of path. */
  734.     char *slaveName;            /* Last component in path. */
  735.     char *masterPath;            /* One-before-last component in path.*/
  736.  
  737.     if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
  738.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  739.                 "bad interpreter path \"", path, "\"", (char *) NULL);
  740.         return TCL_ERROR;
  741.     }
  742.     if (localArgc < 2) {
  743.         masterInterp = interp;
  744.         if (localArgc == 0) {
  745.             slaveName = "";
  746.         } else {
  747.             slaveName = localArgv[0];
  748.         }
  749.     } else {
  750.         masterPath = Tcl_Merge(localArgc-1, localArgv);
  751.         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
  752.         if (masterInterp == (Tcl_Interp *) NULL) {
  753.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  754.                     "interpreter named \"", masterPath, "\" not found",
  755.                     (char *) NULL);
  756.             ckfree((char *) localArgv);
  757.             ckfree((char *) masterPath);
  758.             return TCL_ERROR;
  759.         }
  760.         ckfree((char *) masterPath);
  761.         slaveName = localArgv[localArgc-1];
  762.     }
  763.     hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
  764.     if (hPtr == (Tcl_HashEntry *) NULL) {
  765.         ckfree((char *) localArgv);
  766.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  767.                 "interpreter named \"", path, "\" not found", (char *) NULL);
  768.         return TCL_ERROR;
  769.     }
  770.     slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  771.     if (Tcl_DeleteCommandFromToken(masterInterp, slavePtr->interpCmd) != 0) {
  772.         ckfree((char *) localArgv);
  773.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  774.                 "interpreter named \"", path, "\" not found", (char *) NULL);
  775.         return TCL_ERROR;
  776.     }
  777.     ckfree((char *) localArgv);
  778.  
  779.     return TCL_OK;
  780. }
  781.  
  782. /*
  783.  *----------------------------------------------------------------------
  784.  *
  785.  * DeleteInterpObject --
  786.  *
  787.  *    Helper function to do the work of deleting zero or more
  788.  *    interpreters and their interpreter object commands.
  789.  *
  790.  * Results:
  791.  *    A standard Tcl result.
  792.  *
  793.  * Side effects:
  794.  *    Deletes interpreters and their interpreter object command.
  795.  *
  796.  *----------------------------------------------------------------------
  797.  */
  798.  
  799. static int
  800. DeleteInterpObject(interp, masterPtr, objc, objv)
  801.     Tcl_Interp *interp;            /* Interpreter start search from. */
  802.     Master *masterPtr;            /* Interim storage for master record.*/
  803.     int objc;                /* Number of arguments in vector. */
  804.     Tcl_Obj *CONST objv[];        /* with alias. */
  805. {
  806.     int i;
  807.     int len;
  808.     
  809.     for (i = 2; i < objc; i++) {
  810.         if (DeleteOneInterpObject(interp, masterPtr,
  811.                 Tcl_GetStringFromObj(objv[i], &len))
  812.                 != TCL_OK) {
  813.             return TCL_ERROR;
  814.         }
  815.     }
  816.     return TCL_OK;
  817. }
  818.  
  819. /*
  820.  *----------------------------------------------------------------------
  821.  *
  822.  * AliasCreationHelper --
  823.  *
  824.  *    Helper function to do the work to actually create an alias or
  825.  *    delete an alias.
  826.  *
  827.  * Results:
  828.  *    A standard Tcl result.
  829.  *
  830.  * Side effects:
  831.  *    An alias command is created and entered into the alias table
  832.  *    for the slave interpreter.
  833.  *
  834.  *----------------------------------------------------------------------
  835.  */
  836.  
  837. static int
  838. AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
  839.      aliasName, targetName, objc, objv)
  840.     Tcl_Interp *curInterp;        /* Interp that invoked this proc. */
  841.     Tcl_Interp *slaveInterp;        /* Interp where alias cmd will live
  842.                                          * or from which alias will be
  843.                                          * deleted. */
  844.     Tcl_Interp *masterInterp;        /* Interp where target cmd will be. */
  845.     Master *masterPtr;            /* Master record for target interp. */
  846.     char *aliasName;            /* Name of alias cmd. */
  847.     char *targetName;            /* Name of target cmd. */
  848.     int objc;                /* Additional arguments to store */
  849.     Tcl_Obj *CONST objv[];        /* with alias. */
  850. {
  851.     Alias *aliasPtr;            /* Storage for alias data. */
  852.     Alias *tmpAliasPtr;            /* Temp storage for alias to delete. */
  853.     Tcl_HashEntry *hPtr;        /* Entry into interp hashtable. */
  854.     int i;                /* Loop index. */
  855.     int new;                /* Is it a new hash entry? */
  856.     Target *targetPtr;            /* Maps from target command in master
  857.                                          * to source command in slave. */
  858.     Slave *slavePtr;            /* Maps from source command in slave
  859.                                          * to target command in master. */
  860.  
  861.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
  862.  
  863.     /*
  864.      * Slave record should be always present because it is created when
  865.      * the interpreter is created.
  866.      */
  867.     
  868.     if (slavePtr == (Slave *) NULL) {
  869.         panic("AliasCreationHelper: could not find slave record");
  870.     }
  871.  
  872.     if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
  873.         if (objc != 0) {
  874.             Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
  875.                     "malformed command: should be",
  876.                     " \"alias ",  aliasName, " {}\"", (char *) NULL);
  877.             return TCL_ERROR;
  878.         }
  879.  
  880.         return DeleteAlias(curInterp, slaveInterp, aliasName);
  881.     }
  882.     
  883.     aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
  884.     aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
  885.     aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
  886.     strcpy(aliasPtr->aliasName, aliasName);
  887.     strcpy(aliasPtr->targetName, targetName);
  888.     aliasPtr->targetInterp = masterInterp;
  889.  
  890.     aliasPtr->objv = NULL;
  891.     aliasPtr->objc = objc;
  892.  
  893.     if (aliasPtr->objc > 0) {
  894.         aliasPtr->objv =
  895.             (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) *
  896.                     aliasPtr->objc);
  897.         for (i = 0; i < objc; i++) {
  898.             aliasPtr->objv[i] = objv[i];
  899.             Tcl_IncrRefCount(objv[i]);
  900.         }
  901.     }
  902.  
  903.     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, aliasName,
  904.             AliasCmd, (ClientData) aliasPtr, AliasCmdDeleteProc);
  905.  
  906.     if (TclPreventAliasLoop(curInterp, slaveInterp, 
  907.             aliasPtr->slaveCmd) != TCL_OK) {
  908.  
  909.     /*
  910.          *  Found an alias loop!  The last call to Tcl_CreateObjCommand
  911.          *  made the alias point to itself.  Delete the command and
  912.          *  its alias record.  Be careful to wipe out its client data
  913.          *  first, so the command doesn't try to delete itself.
  914.          */
  915.     
  916.         Command *cmdPtr = (Command*) aliasPtr->slaveCmd;
  917.         cmdPtr->clientData = NULL;
  918.         cmdPtr->deleteProc = NULL;
  919.         cmdPtr->deleteData = NULL;
  920.         Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
  921.  
  922.         for (i = 0; i < objc; i++) {
  923.             Tcl_DecrRefCount(aliasPtr->objv[i]);
  924.         }
  925.         if (aliasPtr->objv != (Tcl_Obj *CONST *) NULL) {
  926.             ckfree((char *) aliasPtr->objv);
  927.         }
  928.         ckfree(aliasPtr->aliasName);
  929.         ckfree(aliasPtr->targetName);
  930.         ckfree((char *) aliasPtr);
  931.  
  932.         /*
  933.          * The result was already set by TclPreventAliasLoop.
  934.          */
  935.  
  936.         return TCL_ERROR;
  937.     }
  938.     
  939.     /*
  940.      * Make an entry in the alias table. If it already exists delete
  941.      * the alias command. Then retry.
  942.      */
  943.  
  944.     do {
  945.         hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
  946.         if (!new) {
  947.             tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  948.             (void) Tcl_DeleteCommandFromToken(slaveInterp,
  949.                 tmpAliasPtr->slaveCmd);
  950.  
  951.             /*
  952.              * The hash entry should be deleted by the Tcl_DeleteCommand
  953.              * above, in its command deletion callback (most likely this
  954.              * will be AliasCmdDeleteProc, which does the deletion).
  955.              */
  956.         }
  957.     } while (new == 0);
  958.     aliasPtr->aliasEntry = hPtr;
  959.     Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
  960.     
  961.     /*
  962.      * Create the new command. We must do it after deleting any old command,
  963.      * because the alias may be pointing at a renamed alias, as in:
  964.      *
  965.      * interp alias {} foo {} bar        # Create an alias "foo"
  966.      * rename foo zop                # Now rename the alias
  967.      * interp alias {} foo {} zop        # Now recreate "foo"...
  968.      */
  969.  
  970.     targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
  971.     targetPtr->slaveCmd = aliasPtr->slaveCmd;
  972.     targetPtr->slaveInterp = slaveInterp;
  973.  
  974.     do {
  975.         hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
  976.                 (char *) aliasCounter, &new);
  977.     aliasCounter++;
  978.     } while (new == 0);
  979.  
  980.     Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
  981.  
  982.     aliasPtr->targetEntry = hPtr;
  983.  
  984.     /*
  985.      * Make sure we clear out the object result when setting the string
  986.      * result.
  987.      */
  988.  
  989.     Tcl_SetObjResult(curInterp, Tcl_NewStringObj(aliasPtr->aliasName, -1));
  990.     
  991.     return TCL_OK;
  992. }
  993.  
  994. /*
  995.  *----------------------------------------------------------------------
  996.  *
  997.  * InterpAliasesHelper --
  998.  *
  999.  *    Computes a list of aliases defined in an interpreter.
  1000.  *
  1001.  * Results:
  1002.  *    A standard Tcl result.
  1003.  *
  1004.  * Side effects:
  1005.  *    None.
  1006.  *
  1007.  *----------------------------------------------------------------------
  1008.  */
  1009.  
  1010. static int
  1011. InterpAliasesHelper(interp, masterPtr, objc, objv)
  1012.     Tcl_Interp *interp;            /* Invoking interpreter. */
  1013.     Master *masterPtr;            /* Master record for current interp. */
  1014.     int objc;                /* How many arguments? */
  1015.     Tcl_Obj *CONST objv[];        /* Actual arguments. */
  1016. {
  1017.     Tcl_Interp *slaveInterp;        /* A slave. */
  1018.     Slave *slavePtr;            /* Record for slave interp. */
  1019.     Tcl_HashEntry *hPtr;        /* Search variable. */
  1020.     Tcl_HashSearch hSearch;        /* Iteration variable. */
  1021.     int len;                /* Dummy length variable. */
  1022.     Tcl_Obj *listObjPtr, *elemObjPtr;    /* Local object pointers. */
  1023.     
  1024.     if ((objc != 2) && (objc != 3)) {
  1025.         Tcl_WrongNumArgs(interp, 2, objv, "?path?");
  1026.         return TCL_ERROR;
  1027.     }
  1028.     if (objc == 3) {
  1029.         slaveInterp = GetInterp(interp, masterPtr,
  1030.                 Tcl_GetStringFromObj(objv[2], &len), NULL);
  1031.         if (slaveInterp == (Tcl_Interp *) NULL) {
  1032.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1033.                     "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1034.                     "\" not found", (char *) NULL);
  1035.             return TCL_ERROR;
  1036.         }
  1037.     } else {
  1038.         slaveInterp = interp;
  1039.     }
  1040.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
  1041.             "tclSlaveRecord", NULL);
  1042.     if (slavePtr == (Slave *) NULL) {
  1043.         return TCL_OK;
  1044.     }
  1045.  
  1046.     /*
  1047.      * Build a list to return the aliases:
  1048.      */
  1049.             
  1050.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  1051.     for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
  1052.          hPtr != NULL;
  1053.          hPtr = Tcl_NextHashEntry(&hSearch)) {
  1054.  
  1055.         elemObjPtr = Tcl_NewStringObj(
  1056.             Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr), -1);
  1057.         Tcl_ListObjAppendElement(interp, listObjPtr, elemObjPtr);
  1058.     }
  1059.     Tcl_SetObjResult(interp, listObjPtr);
  1060.  
  1061.     return TCL_OK;
  1062. }
  1063.  
  1064. /*
  1065.  *----------------------------------------------------------------------
  1066.  *
  1067.  * InterpAliasHelper -
  1068.  *
  1069.  *    Handles the different forms of the "interp alias" command:
  1070.  *    - interp alias slavePath aliasName
  1071.  *        Describes an alias.
  1072.  *    - interp alias slavePath aliasName {}
  1073.  *        Deletes an alias.
  1074.  *    - interp alias slavePath srcCmd masterPath targetCmd args...
  1075.  *        Creates an alias.
  1076.  *
  1077.  * Results:
  1078.  *    A Tcl result.
  1079.  *
  1080.  * Side effects:
  1081.  *    See user documentation for details.
  1082.  *
  1083.  *----------------------------------------------------------------------
  1084.  */
  1085.  
  1086. static int
  1087. InterpAliasHelper(interp, masterPtr, objc, objv)
  1088.     Tcl_Interp *interp;            /* Current interpreter. */
  1089.     Master *masterPtr;            /* Master record for current interp. */
  1090.     int objc;                /* Number of arguments. */
  1091.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1092. {
  1093.     Tcl_Interp *slaveInterp,        /* Interpreters used when */
  1094.         *masterInterp;            /* creating an alias btn siblings. */
  1095.     Master *masterMasterPtr;        /* Master record for master interp. */
  1096.     int len;
  1097.  
  1098.     if (objc < 4) {
  1099.         Tcl_WrongNumArgs(interp, 2, objv,
  1100.                 "slavePath slaveCmd masterPath masterCmd ?args ..?");
  1101.         return TCL_ERROR;
  1102.     }
  1103.     slaveInterp = GetInterp(interp, masterPtr,
  1104.             Tcl_GetStringFromObj(objv[2], &len), NULL);
  1105.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1106.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1107.                 "could not find interpreter \"",
  1108.                 Tcl_GetStringFromObj(objv[2], &len), "\"",
  1109.                 (char *) NULL);
  1110.         return TCL_ERROR;
  1111.     }
  1112.     if (objc == 4) {
  1113.         return DescribeAlias(interp, slaveInterp,
  1114.                 Tcl_GetStringFromObj(objv[3], &len));
  1115.     }
  1116.     if (objc == 5 && strcmp(Tcl_GetStringFromObj(objv[4], &len), "") == 0) {
  1117.         return DeleteAlias(interp, slaveInterp,
  1118.                 Tcl_GetStringFromObj(objv[3], &len));
  1119.     }
  1120.     if (objc < 6) {
  1121.         Tcl_WrongNumArgs(interp, 2, objv,
  1122.                 "slavePath slaveCmd masterPath masterCmd ?args ..?");
  1123.         return TCL_ERROR;
  1124.     }
  1125.     masterInterp = GetInterp(interp, masterPtr,
  1126.             Tcl_GetStringFromObj(objv[4], &len), &masterMasterPtr);
  1127.     if (masterInterp == (Tcl_Interp *) NULL) {
  1128.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1129.                 "could not find interpreter \"",
  1130.                 Tcl_GetStringFromObj(objv[4], &len), "\"", (char *) NULL);
  1131.         return TCL_ERROR;
  1132.     }
  1133.     return AliasCreationHelper(interp, slaveInterp, masterInterp,
  1134.             masterMasterPtr, Tcl_GetStringFromObj(objv[3], &len),
  1135.             Tcl_GetStringFromObj(objv[5], &len),
  1136.             objc-6, objv+6);
  1137. }
  1138.  
  1139. /*
  1140.  *----------------------------------------------------------------------
  1141.  *
  1142.  * InterpExistsHelper --
  1143.  *
  1144.  *    Computes whether a named interpreter exists or not.
  1145.  *
  1146.  * Results:
  1147.  *    A standard Tcl result.
  1148.  *
  1149.  * Side effects:
  1150.  *    None.
  1151.  *
  1152.  *----------------------------------------------------------------------
  1153.  */
  1154.  
  1155. static int
  1156. InterpExistsHelper(interp, masterPtr, objc, objv)
  1157.     Tcl_Interp *interp;            /* Current interpreter. */
  1158.     Master *masterPtr;            /* Master record for current interp. */
  1159.     int objc;                /* Number of arguments. */
  1160.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1161. {
  1162.     Tcl_Obj *objPtr;
  1163.     int len;
  1164.  
  1165.     if (objc > 3) {
  1166.         Tcl_WrongNumArgs(interp, 2, objv, "?path?");
  1167.         return TCL_ERROR;
  1168.     }
  1169.     if (objc == 3) {
  1170.         if (GetInterp(interp, masterPtr,
  1171.                 Tcl_GetStringFromObj(objv[2], &len), NULL) ==
  1172.                 (Tcl_Interp *) NULL) {
  1173.             objPtr = Tcl_NewIntObj(0);
  1174.         } else {
  1175.             objPtr = Tcl_NewIntObj(1);
  1176.         }
  1177.     } else {
  1178.         objPtr = Tcl_NewIntObj(1);
  1179.     }
  1180.     Tcl_SetObjResult(interp, objPtr);
  1181.     
  1182.     return TCL_OK;
  1183. }
  1184.  
  1185. /*
  1186.  *----------------------------------------------------------------------
  1187.  *
  1188.  * InterpEvalHelper --
  1189.  *
  1190.  *    Helper function to handle all the details of evaluating a
  1191.  *    command in another interpreter.
  1192.  *
  1193.  * Results:
  1194.  *    A standard Tcl result.
  1195.  *
  1196.  * Side effects:
  1197.  *    Whatever the command itself does.
  1198.  *
  1199.  *----------------------------------------------------------------------
  1200.  */
  1201.  
  1202. static int
  1203. InterpEvalHelper(interp, masterPtr, objc, objv)
  1204.     Tcl_Interp *interp;            /* Current interpreter. */
  1205.     Master *masterPtr;            /* Master record for current interp. */
  1206.     int objc;                /* Number of arguments. */
  1207.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1208. {
  1209.     Tcl_Interp *slaveInterp;        /* A slave. */
  1210.     Interp *iPtr;            /* Internal data type for slave. */
  1211.     int len;                /* Dummy length variable. */
  1212.     int result;
  1213.     Tcl_Obj *namePtr, *objPtr;        /* Local object pointer. */
  1214.     char *string;
  1215.  
  1216.     if (objc < 4) {
  1217.         Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
  1218.         return TCL_ERROR;
  1219.     }
  1220.     slaveInterp = GetInterp(interp, masterPtr,
  1221.             Tcl_GetStringFromObj(objv[2], &len), NULL);
  1222.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1223.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1224.                 "interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
  1225.                 "\" not found", (char *) NULL);
  1226.         return TCL_ERROR;
  1227.     }
  1228.     objPtr = Tcl_ConcatObj(objc-3, objv+3);
  1229.     Tcl_IncrRefCount(objPtr);
  1230.     
  1231.     Tcl_Preserve((ClientData) slaveInterp);
  1232.     result = Tcl_EvalObj(slaveInterp, objPtr);
  1233.  
  1234.     Tcl_DecrRefCount(objPtr);
  1235.  
  1236.     /*
  1237.      * Now make the result and any error information accessible. We
  1238.      * have to be careful because the slave interpreter and the current
  1239.      * interpreter can be the same - do not destroy the result.. This
  1240.      * can happen if an interpreter contains an alias which is directed
  1241.      * at a target command in the same interpreter.
  1242.      */
  1243.  
  1244.     if (interp != slaveInterp) {
  1245.         if (result == TCL_ERROR) {
  1246.  
  1247.             /*
  1248.              * An error occurred, so transfer error information from
  1249.              * the target interpreter back to our interpreter.
  1250.              */
  1251.  
  1252.             iPtr = (Interp *) slaveInterp;
  1253.             if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  1254.                 Tcl_AddErrorInfo(slaveInterp, "");
  1255.             }
  1256.             iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  1257.             
  1258.             Tcl_ResetResult(interp);
  1259.             namePtr = Tcl_NewStringObj("errorInfo", -1);
  1260.             objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
  1261.                     (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
  1262.             string = Tcl_GetStringFromObj(objPtr, &len);
  1263.             Tcl_AddObjErrorInfo(interp, string, len);
  1264.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  1265.                     Tcl_GetVar2(slaveInterp, "errorCode", (char *)
  1266.                             NULL, TCL_GLOBAL_ONLY),
  1267.                     TCL_GLOBAL_ONLY);
  1268.             Tcl_DecrRefCount(namePtr);
  1269.         }
  1270.  
  1271.     /*
  1272.          * Move the result object from one interpreter to the
  1273.          * other.
  1274.          */
  1275.                 
  1276.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  1277.         Tcl_ResetResult(slaveInterp);
  1278.  
  1279.     }
  1280.     Tcl_Release((ClientData) slaveInterp);
  1281.     return result;        
  1282. }
  1283.  
  1284. /*
  1285.  *----------------------------------------------------------------------
  1286.  *
  1287.  * InterpExposeHelper --
  1288.  *
  1289.  *    Helper function to handle the details of exposing a command in
  1290.  *    another interpreter.
  1291.  *
  1292.  * Results:
  1293.  *    Standard Tcl result.
  1294.  *
  1295.  * Side effects:
  1296.  *    Exposes a command. From now on the command can be called by scripts
  1297.  *    in the interpreter in which it was exposed.
  1298.  *
  1299.  *----------------------------------------------------------------------
  1300.  */
  1301.  
  1302. static int
  1303. InterpExposeHelper(interp, masterPtr, objc, objv)
  1304.     Tcl_Interp *interp;            /* Current interpreter. */
  1305.     Master *masterPtr;            /* Master record for current interp. */
  1306.     int objc;                /* Number of arguments. */
  1307.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1308. {
  1309.     Tcl_Interp *slaveInterp;        /* A slave. */
  1310.     int len;                /* Dummy length variable. */
  1311.  
  1312.     if ((objc != 4) && (objc != 5)) {
  1313.         Tcl_WrongNumArgs(interp, 2, objv,
  1314.                 "path hiddenCmdName ?cmdName?");
  1315.         return TCL_ERROR;
  1316.     }
  1317.     if (Tcl_IsSafe(interp)) {
  1318.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1319.                 "permission denied: safe interpreter cannot expose commands",
  1320.                 (char *) NULL);
  1321.         return TCL_ERROR;
  1322.     }
  1323.     slaveInterp = GetInterp(interp, masterPtr,
  1324.             Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
  1325.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1326.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1327.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1328.                 "\" not found", (char *) NULL);
  1329.         return TCL_ERROR;
  1330.     }
  1331.     if (Tcl_ExposeCommand(slaveInterp,
  1332.             Tcl_GetStringFromObj(objv[3], &len),
  1333.                 (objc == 5 ?
  1334.                         Tcl_GetStringFromObj(objv[4], &len) :
  1335.                         Tcl_GetStringFromObj(objv[3], &len)))
  1336.             == TCL_ERROR) {
  1337.         if (interp != slaveInterp) {
  1338.             Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  1339.             Tcl_ResetResult(slaveInterp);
  1340.         }
  1341.         return TCL_ERROR;
  1342.     }
  1343.     return TCL_OK;
  1344. }
  1345.  
  1346. /*
  1347.  *----------------------------------------------------------------------
  1348.  *
  1349.  * InterpHideHelper --
  1350.  *
  1351.  *    Helper function that handles the details of hiding a command in
  1352.  *    another interpreter.
  1353.  *
  1354.  * Results:
  1355.  *    A standard Tcl result.
  1356.  *
  1357.  * Side effects:
  1358.  *    Hides a command. From now on the command cannot be called by
  1359.  *    scripts in that interpreter.
  1360.  *
  1361.  *----------------------------------------------------------------------
  1362.  */
  1363.  
  1364. static int
  1365. InterpHideHelper(interp, masterPtr, objc, objv)
  1366.     Tcl_Interp *interp;            /* Current interpreter. */
  1367.     Master *masterPtr;            /* Master record for interp. */
  1368.     int objc;                /* Number of arguments. */
  1369.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1370. {
  1371.     Tcl_Interp *slaveInterp;        /* A slave. */
  1372.     int len;                /* Dummy length variable. */
  1373.  
  1374.     if ((objc != 4) && (objc != 5)) {
  1375.         Tcl_WrongNumArgs(interp, 2, objv,
  1376.                 "path cmdName ?hiddenCmdName?");
  1377.         return TCL_ERROR;
  1378.     }
  1379.     if (Tcl_IsSafe(interp)) {
  1380.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1381.                 "permission denied: safe interpreter cannot hide commands",
  1382.                 (char *) NULL);
  1383.         return TCL_ERROR;
  1384.     }
  1385.     slaveInterp = GetInterp(interp, masterPtr,
  1386.             Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
  1387.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1388.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1389.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1390.                 "\" not found", (char *) NULL);
  1391.         return TCL_ERROR;
  1392.     }
  1393.     if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[3], &len),
  1394.             (objc == 5 ?
  1395.                     Tcl_GetStringFromObj(objv[4], &len) :
  1396.                     Tcl_GetStringFromObj(objv[3], &len)))
  1397.             == TCL_ERROR) {
  1398.         if (interp != slaveInterp) {
  1399.             Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  1400.             Tcl_ResetResult(slaveInterp);
  1401.         }
  1402.         return TCL_ERROR;
  1403.     }
  1404.     return TCL_OK;
  1405. }
  1406.  
  1407. /*
  1408.  *----------------------------------------------------------------------
  1409.  *
  1410.  * InterpHiddenHelper --
  1411.  *
  1412.  *    Computes the list of hidden commands in a named interpreter.
  1413.  *
  1414.  * Results:
  1415.  *    A standard Tcl result.
  1416.  *
  1417.  * Side effects:
  1418.  *    None.
  1419.  *
  1420.  *----------------------------------------------------------------------
  1421.  */
  1422.  
  1423. static int
  1424. InterpHiddenHelper(interp, masterPtr, objc, objv)
  1425.     Tcl_Interp *interp;            /* Current interpreter. */
  1426.     Master *masterPtr;            /* Master record for interp. */
  1427.     int objc;                /* Number of arguments. */
  1428.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1429. {
  1430.     Tcl_Interp *slaveInterp;        /* A slave. */
  1431.     int len;
  1432.     Tcl_HashTable *hTblPtr;        /* Hidden command table. */
  1433.     Tcl_HashEntry *hPtr;        /* Search variable. */
  1434.     Tcl_HashSearch hSearch;        /* Iteration variable. */
  1435.     Tcl_Obj *listObjPtr;        /* Local object pointer. */
  1436.  
  1437.     if (objc > 3) {
  1438.         Tcl_WrongNumArgs(interp, 2, objv, "?path?");
  1439.         return TCL_ERROR;
  1440.     }
  1441.     if (objc == 3) {
  1442.         slaveInterp = GetInterp(interp, masterPtr,
  1443.                 Tcl_GetStringFromObj(objv[2], &len),
  1444.                 &masterPtr);
  1445.         if (slaveInterp == (Tcl_Interp *) NULL) {
  1446.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1447.                     "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1448.                     "\" not found", (char *) NULL);
  1449.             return TCL_ERROR;
  1450.         }
  1451.     } else {
  1452.         slaveInterp = interp;
  1453.     }
  1454.             
  1455.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  1456.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
  1457.             "tclHiddenCmds", NULL);
  1458.     if (hTblPtr != (Tcl_HashTable *) NULL) {
  1459.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  1460.              hPtr != (Tcl_HashEntry *) NULL;
  1461.              hPtr = Tcl_NextHashEntry(&hSearch)) {
  1462.  
  1463.             Tcl_ListObjAppendElement(interp, listObjPtr,
  1464.                     Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
  1465.         }
  1466.     }
  1467.     Tcl_SetObjResult(interp, listObjPtr);
  1468.             
  1469.     return TCL_OK;
  1470. }
  1471.  
  1472. /*
  1473.  *----------------------------------------------------------------------
  1474.  *
  1475.  * InterpInvokeHiddenHelper --
  1476.  *
  1477.  *    Helper routine to handle the details of invoking a hidden
  1478.  *    command in another interpreter.
  1479.  *
  1480.  * Results:
  1481.  *    A standard Tcl result.
  1482.  *
  1483.  * Side effects:
  1484.  *    Whatever the hidden command does.
  1485.  *
  1486.  *----------------------------------------------------------------------
  1487.  */
  1488.  
  1489. static int
  1490. InterpInvokeHiddenHelper(interp, masterPtr, objc, objv)
  1491.     Tcl_Interp *interp;            /* Current interpreter. */
  1492.     Master *masterPtr;            /* Master record for interp. */
  1493.     int objc;                /* Number of arguments. */
  1494.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1495. {
  1496.     int doGlobal = 0;
  1497.     int len;
  1498.     int result;
  1499.     Tcl_Obj *namePtr, *objPtr;
  1500.     Tcl_Interp *slaveInterp;
  1501.     Interp *iPtr;
  1502.     char *string;
  1503.             
  1504.     if (objc < 4) {
  1505.         Tcl_WrongNumArgs(interp, 2, objv,
  1506.                 "path ?-global? cmd ?arg ..?");
  1507.         return TCL_ERROR;
  1508.     }
  1509.     if (Tcl_IsSafe(interp)) {
  1510.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1511.                 "not allowed to invoke hidden commands from safe interpreter",
  1512.                 (char *) NULL);
  1513.         return TCL_ERROR;
  1514.     }
  1515.     if (strcmp(Tcl_GetStringFromObj(objv[3], &len), "-global") == 0) {
  1516.         doGlobal = 1;
  1517.         if (objc < 5) {
  1518.             Tcl_WrongNumArgs(interp, 2, objv,
  1519.                     "path ?-global? cmd ?arg ..?");
  1520.             return TCL_ERROR;
  1521.         }
  1522.     }
  1523.     slaveInterp = GetInterp(interp, masterPtr,
  1524.             Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
  1525.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1526.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1527.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1528.                 "\" not found", (char *) NULL);
  1529.         return TCL_ERROR;
  1530.     }
  1531.     Tcl_Preserve((ClientData) slaveInterp);
  1532.     if (doGlobal) {
  1533.         result = TclObjInvokeGlobal(slaveInterp, objc-4, objv+4,
  1534.                 TCL_INVOKE_HIDDEN);
  1535.     } else {
  1536.         result = TclObjInvoke(slaveInterp, objc-3, objv+3, TCL_INVOKE_HIDDEN);
  1537.     }
  1538.  
  1539.     /*
  1540.      * Now make the result and any error information accessible. We
  1541.      * have to be careful because the slave interpreter and the current
  1542.      * interpreter can be the same - do not destroy the result.. This
  1543.      * can happen if an interpreter contains an alias which is directed
  1544.      * at a target command in the same interpreter.
  1545.      */
  1546.  
  1547.     if (interp != slaveInterp) {
  1548.         if (result == TCL_ERROR) {
  1549.  
  1550.             /*
  1551.              * An error occurred, so transfer error information from
  1552.              * the target interpreter back to our interpreter.
  1553.              */
  1554.  
  1555.             iPtr = (Interp *) slaveInterp;
  1556.             if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  1557.                 Tcl_AddErrorInfo(slaveInterp, "");
  1558.             }
  1559.             iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  1560.  
  1561.             Tcl_ResetResult(interp);
  1562.             namePtr = Tcl_NewStringObj("errorInfo", -1);
  1563.             objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
  1564.                     (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
  1565.             Tcl_DecrRefCount(namePtr);
  1566.             string = Tcl_GetStringFromObj(objPtr, &len);
  1567.             Tcl_AddObjErrorInfo(interp, string, len);
  1568.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  1569.                     Tcl_GetVar2(slaveInterp, "errorCode", (char *)
  1570.                             NULL, TCL_GLOBAL_ONLY),
  1571.                     TCL_GLOBAL_ONLY);
  1572.         }
  1573.  
  1574.     /*
  1575.          * Move the result object from the slave to the master.
  1576.          */
  1577.                 
  1578.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  1579.         Tcl_ResetResult(slaveInterp);
  1580.     }
  1581.     Tcl_Release((ClientData) slaveInterp);
  1582.     return result;        
  1583. }
  1584.  
  1585. /*
  1586.  *----------------------------------------------------------------------
  1587.  *
  1588.  * InterpMarkTrustedHelper --
  1589.  *
  1590.  *    Helper function to handle the details of marking another
  1591.  *    interpreter as trusted (unsafe).
  1592.  *
  1593.  * Results:
  1594.  *    A standard Tcl result.
  1595.  *
  1596.  * Side effects:
  1597.  *    Henceforth the hard-wired checks for safety will not prevent
  1598.  *    this interpreter from performing certain operations.
  1599.  *
  1600.  *----------------------------------------------------------------------
  1601.  */
  1602.  
  1603. static int
  1604. InterpMarkTrustedHelper(interp, masterPtr, objc, objv)
  1605.     Tcl_Interp *interp;            /* Current interpreter. */
  1606.     Master *masterPtr;            /* Master record for interp. */
  1607.     int objc;                /* Number of arguments. */
  1608.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1609. {
  1610.     Tcl_Interp *slaveInterp;        /* A slave. */
  1611.     int len;                /* Dummy length variable. */
  1612.  
  1613.     if (objc != 3) {
  1614.         Tcl_WrongNumArgs(interp, 2, objv, "path");
  1615.         return TCL_ERROR;
  1616.     }
  1617.     if (Tcl_IsSafe(interp)) {
  1618.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1619.                 "\"", Tcl_GetStringFromObj(objv[0], &len),
  1620.                 " marktrusted\" can only",
  1621.                 " be invoked from a trusted interpreter",
  1622.                 (char *) NULL);
  1623.         return TCL_ERROR;
  1624.     }
  1625.  
  1626.     slaveInterp = GetInterp(interp, masterPtr,
  1627.             Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
  1628.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1629.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1630.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1631.                 "\" not found", (char *) NULL);
  1632.         return TCL_ERROR;
  1633.     }
  1634.     return MarkTrusted(slaveInterp);
  1635. }
  1636.  
  1637. /*
  1638.  *----------------------------------------------------------------------
  1639.  *
  1640.  * InterpIsSafeHelper --
  1641.  *
  1642.  *    Computes whether a named interpreter is safe.
  1643.  *
  1644.  * Results:
  1645.  *    A standard Tcl result.
  1646.  *
  1647.  * Side effects:
  1648.  *    None.
  1649.  *
  1650.  *----------------------------------------------------------------------
  1651.  */
  1652.  
  1653. static int
  1654. InterpIsSafeHelper(interp, masterPtr, objc, objv)
  1655.     Tcl_Interp *interp;            /* Current interpreter. */
  1656.     Master *masterPtr;            /* Master record for interp. */
  1657.     int objc;                /* Number of arguments. */
  1658.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1659. {
  1660.     Tcl_Interp *slaveInterp;        /* A slave. */
  1661.     int len;                /* Dummy length variable. */
  1662.     Tcl_Obj *objPtr;            /* Local object pointer. */
  1663.  
  1664.     if (objc > 3) {
  1665.         Tcl_WrongNumArgs(interp, 2, objv, "?path?");
  1666.         return TCL_ERROR;
  1667.     }
  1668.     if (objc == 3) {
  1669.         slaveInterp = GetInterp(interp, masterPtr,
  1670.                 Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
  1671.         if (slaveInterp == (Tcl_Interp *) NULL) {
  1672.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1673.                     "interpreter \"",
  1674.                     Tcl_GetStringFromObj(objv[2], &len), "\" not found",
  1675.                     (char *) NULL);
  1676.             return TCL_ERROR;
  1677.         }
  1678.     objPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
  1679.     } else {
  1680.     objPtr = Tcl_NewIntObj(Tcl_IsSafe(interp));
  1681.     }
  1682.     Tcl_SetObjResult(interp, objPtr);
  1683.     return TCL_OK;
  1684. }
  1685.  
  1686. /*
  1687.  *----------------------------------------------------------------------
  1688.  *
  1689.  * InterpSlavesHelper --
  1690.  *
  1691.  *    Computes a list of slave interpreters of a named interpreter.
  1692.  *
  1693.  * Results:
  1694.  *    A standard Tcl result.
  1695.  *
  1696.  * Side effects:
  1697.  *    None.
  1698.  *
  1699.  *----------------------------------------------------------------------
  1700.  */
  1701.  
  1702. static int
  1703. InterpSlavesHelper(interp, masterPtr, objc, objv)
  1704.     Tcl_Interp *interp;            /* Current interpreter. */
  1705.     Master *masterPtr;            /* Master record for interp. */
  1706.     int objc;                /* Number of arguments. */
  1707.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1708. {
  1709.     int len;
  1710.     Tcl_HashEntry *hPtr;        /* Search variable. */
  1711.     Tcl_HashSearch hSearch;        /* Iteration variable. */
  1712.     Tcl_Obj *listObjPtr;        /* Local object pointers. */
  1713.  
  1714.     if ((objc != 2) && (objc != 3)) {
  1715.         Tcl_WrongNumArgs(interp, 2, objv, "?path?");
  1716.         return TCL_ERROR;
  1717.     }
  1718.     if (objc == 3) {
  1719.         if (GetInterp(interp, masterPtr,
  1720.                 Tcl_GetStringFromObj(objv[2], &len), &masterPtr) ==
  1721.                 (Tcl_Interp *) NULL) {
  1722.             Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1723.                     "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1724.                     "\" not found", (char *) NULL);
  1725.             return TCL_ERROR;
  1726.         }
  1727.     }
  1728.  
  1729.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  1730.     for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
  1731.          hPtr != NULL;
  1732.          hPtr = Tcl_NextHashEntry(&hSearch)) {
  1733.  
  1734.         Tcl_ListObjAppendElement(interp, listObjPtr,
  1735.                 Tcl_NewStringObj(
  1736.                     Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr), -1));
  1737.     }
  1738.     Tcl_SetObjResult(interp, listObjPtr);
  1739.     return TCL_OK;
  1740. }
  1741.  
  1742. /*
  1743.  *----------------------------------------------------------------------
  1744.  *
  1745.  * InterpShareHelper --
  1746.  *
  1747.  *    Helper function to handle the details of sharing a channel between
  1748.  *    interpreters.
  1749.  *
  1750.  * Results:
  1751.  *    A standard Tcl result.
  1752.  *
  1753.  * Side effects:
  1754.  *    After this call the named channel will be shared between the
  1755.  *    interpreters named in the arguments.
  1756.  *
  1757.  *----------------------------------------------------------------------
  1758.  */
  1759.  
  1760. static int
  1761. InterpShareHelper(interp, masterPtr, objc, objv)
  1762.     Tcl_Interp *interp;            /* Current interpreter. */
  1763.     Master *masterPtr;            /* Master record for interp. */
  1764.     int objc;                /* Number of arguments. */
  1765.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1766. {
  1767.     Tcl_Interp *slaveInterp;        /* A slave. */
  1768.     Tcl_Interp *masterInterp;        /* Its master. */
  1769.     int len;
  1770.     Tcl_Channel chan;
  1771.  
  1772.     if (objc != 5) {
  1773.         Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
  1774.         return TCL_ERROR;
  1775.     }
  1776.     masterInterp = GetInterp(interp, masterPtr,
  1777.             Tcl_GetStringFromObj(objv[2], &len), NULL);
  1778.     if (masterInterp == (Tcl_Interp *) NULL) {
  1779.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1780.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1781.                 "\" not found", (char *) NULL);
  1782.         return TCL_ERROR;
  1783.     }
  1784.     slaveInterp = GetInterp(interp, masterPtr,
  1785.             Tcl_GetStringFromObj(objv[4], &len), NULL);
  1786.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1787.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1788.                 "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
  1789.                 "\" not found", (char *) NULL);
  1790.         return TCL_ERROR;
  1791.     }
  1792.     chan = Tcl_GetChannel(masterInterp, Tcl_GetStringFromObj(objv[3], &len),
  1793.             NULL);
  1794.     if (chan == (Tcl_Channel) NULL) {
  1795.         if (interp != masterInterp) {
  1796.             Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
  1797.             Tcl_ResetResult(masterInterp);
  1798.         }
  1799.         return TCL_ERROR;
  1800.     }
  1801.     Tcl_RegisterChannel(slaveInterp, chan);
  1802.     return TCL_OK;
  1803. }
  1804.  
  1805. /*
  1806.  *----------------------------------------------------------------------
  1807.  *
  1808.  * InterpTargetHelper --
  1809.  *
  1810.  *    Helper function to compute the target of an alias.
  1811.  *
  1812.  * Results:
  1813.  *    A standard Tcl result.
  1814.  *
  1815.  * Side effects:
  1816.  *    None.
  1817.  *
  1818.  *----------------------------------------------------------------------
  1819.  */
  1820.  
  1821. static int
  1822. InterpTargetHelper(interp, masterPtr, objc, objv)
  1823.     Tcl_Interp *interp;            /* Current interpreter. */
  1824.     Master *masterPtr;            /* Master record for interp. */
  1825.     int objc;                /* Number of arguments. */
  1826.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1827. {
  1828.     int len;
  1829.     
  1830.     if (objc != 4) {
  1831.         Tcl_WrongNumArgs(interp, 2, objv, "path alias");
  1832.         return TCL_ERROR;
  1833.     }
  1834.     return GetTarget(interp,
  1835.             Tcl_GetStringFromObj(objv[2], &len),
  1836.             Tcl_GetStringFromObj(objv[3], &len));
  1837. }
  1838.  
  1839. /*
  1840.  *----------------------------------------------------------------------
  1841.  *
  1842.  * InterpTransferHelper --
  1843.  *
  1844.  *    Helper function to handle the details of transferring ownership
  1845.  *    of a channel between interpreters.
  1846.  *
  1847.  * Results:
  1848.  *    A standard Tcl result.
  1849.  *
  1850.  * Side effects:
  1851.  *    After the call, the named channel will be registered in the target
  1852.  *    interpreter and no longer available for use in the source interpreter.
  1853.  *
  1854.  *----------------------------------------------------------------------
  1855.  */
  1856.  
  1857. static int
  1858. InterpTransferHelper(interp, masterPtr, objc, objv)
  1859.     Tcl_Interp *interp;            /* Current interpreter. */
  1860.     Master *masterPtr;            /* Master record for interp. */
  1861.     int objc;                /* Number of arguments. */
  1862.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  1863. {
  1864.     Tcl_Interp *slaveInterp;        /* A slave. */
  1865.     Tcl_Interp *masterInterp;        /* Its master. */
  1866.     int len;
  1867.     Tcl_Channel chan;
  1868.             
  1869.     if (objc != 5) {
  1870.         Tcl_WrongNumArgs(interp, 2, objv,
  1871.                 "srcPath channelId destPath");
  1872.         return TCL_ERROR;
  1873.     }
  1874.     masterInterp = GetInterp(interp, masterPtr,
  1875.             Tcl_GetStringFromObj(objv[2], &len), NULL);
  1876.     if (masterInterp == (Tcl_Interp *) NULL) {
  1877.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1878.                 "interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
  1879.                 "\" not found", (char *) NULL);
  1880.         return TCL_ERROR;
  1881.     }
  1882.     slaveInterp = GetInterp(interp, masterPtr,
  1883.             Tcl_GetStringFromObj(objv[4], &len), NULL);
  1884.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1885.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1886.                 "interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
  1887.                 "\" not found", (char *) NULL);
  1888.         return TCL_ERROR;
  1889.     }
  1890.     chan = Tcl_GetChannel(masterInterp,
  1891.             Tcl_GetStringFromObj(objv[3], &len), NULL);
  1892.     if (chan == (Tcl_Channel) NULL) {
  1893.         if (interp != masterInterp) {
  1894.  
  1895.             /*
  1896.              * After fixing objresult, this code will change to:
  1897.              * Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
  1898.              */
  1899.             
  1900.             Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
  1901.             Tcl_ResetResult(masterInterp);
  1902.         }
  1903.         return TCL_ERROR;
  1904.     }
  1905.     Tcl_RegisterChannel(slaveInterp, chan);
  1906.     if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
  1907.         if (interp != masterInterp) {
  1908.             Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
  1909.             Tcl_ResetResult(masterInterp);
  1910.         }
  1911.         return TCL_ERROR;
  1912.     }
  1913.     return TCL_OK;
  1914. }
  1915.  
  1916. /*
  1917.  *----------------------------------------------------------------------
  1918.  *
  1919.  * DescribeAlias --
  1920.  *
  1921.  *    Sets the interpreter's result object to a Tcl list describing
  1922.  *    the given alias in the given interpreter: its target command
  1923.  *    and the additional arguments to prepend to any invocation
  1924.  *    of the alias.
  1925.  *
  1926.  * Results:
  1927.  *    A standard Tcl result.
  1928.  *
  1929.  * Side effects:
  1930.  *    None.
  1931.  *
  1932.  *----------------------------------------------------------------------
  1933.  */
  1934.  
  1935. static int
  1936. DescribeAlias(interp, slaveInterp, aliasName)
  1937.     Tcl_Interp *interp;            /* Interpreter for result & errors. */
  1938.     Tcl_Interp *slaveInterp;        /* Interpreter defining alias. */
  1939.     char *aliasName;            /* Name of alias to describe. */
  1940. {
  1941.     Slave *slavePtr;            /* Slave interp slave record. */
  1942.     Tcl_HashEntry *hPtr;        /* Search variable. */
  1943.     Alias *aliasPtr;            /* Structure describing alias. */
  1944.     int i;                /* Loop variable. */
  1945.     Tcl_Obj *listObjPtr;        /* Local object pointer. */
  1946.  
  1947.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  1948.             NULL);
  1949.  
  1950.     /*
  1951.      * The slave record should always be present because it is created
  1952.      * by Tcl_CreateInterp.
  1953.      */
  1954.     
  1955.     if (slavePtr == (Slave *) NULL) {
  1956.         panic("DescribeAlias: could not find slave record");
  1957.     }
  1958.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  1959.     if (hPtr == (Tcl_HashEntry *) NULL) {
  1960.         return TCL_OK;
  1961.     }
  1962.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  1963.  
  1964.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  1965.     Tcl_ListObjAppendElement(interp, listObjPtr,
  1966.             Tcl_NewStringObj(aliasPtr->targetName, -1));
  1967.     for (i = 0; i < aliasPtr->objc; i++) {
  1968.         Tcl_ListObjAppendElement(interp, listObjPtr, aliasPtr->objv[i]);
  1969.     }
  1970.     Tcl_SetObjResult(interp, listObjPtr);
  1971.     return TCL_OK;
  1972. }
  1973.  
  1974. /*
  1975.  *----------------------------------------------------------------------
  1976.  *
  1977.  * DeleteAlias --
  1978.  *
  1979.  *    Deletes the given alias from the slave interpreter given.
  1980.  *
  1981.  * Results:
  1982.  *    A standard Tcl result.
  1983.  *
  1984.  * Side effects:
  1985.  *    Deletes the alias from the slave interpreter.
  1986.  *
  1987.  *----------------------------------------------------------------------
  1988.  */
  1989.  
  1990. static int
  1991. DeleteAlias(interp, slaveInterp, aliasName)
  1992.     Tcl_Interp *interp;        /* Interpreter for result and errors. */
  1993.     Tcl_Interp *slaveInterp;    /* Interpreter defining alias. */
  1994.     char *aliasName;        /* Name of alias to delete. */
  1995. {
  1996.     Slave *slavePtr;        /* Slave record for slave interpreter. */
  1997.     Alias *aliasPtr;        /* Points at alias structure to delete. */
  1998.     Tcl_HashEntry *hPtr;    /* Search variable. */
  1999.     char *tmpPtr, *namePtr;    /* Local pointers to name of command to
  2000.                                  * be deleted. */
  2001.  
  2002.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  2003.             NULL);
  2004.     if (slavePtr == (Slave *) NULL) {
  2005.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2006.                 "alias \"", aliasName, "\" not found", (char *) NULL);
  2007.         return TCL_ERROR;
  2008.     }
  2009.     
  2010.     /*
  2011.      * Get the alias from the alias table, then delete the command. The
  2012.      * deleteProc on the alias command will take care of removing the entry
  2013.      * from the alias table.
  2014.      */
  2015.  
  2016.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  2017.     if (hPtr == (Tcl_HashEntry *) NULL) {
  2018.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2019.                 "alias \"", aliasName, "\" not found", (char *) NULL);
  2020.         return TCL_ERROR;
  2021.     }
  2022.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  2023.  
  2024.     /*
  2025.      * Get a copy of the real name of the command -- it might have
  2026.      * been renamed, and we want to delete the renamed command, not
  2027.      * the current command (if any) by the name of the original alias.
  2028.      * We need the local copy because the name may get smashed when the
  2029.      * command to delete is exposed, if it was hidden.
  2030.      */
  2031.  
  2032.     tmpPtr = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
  2033.     namePtr = (char *) ckalloc((unsigned) strlen(tmpPtr) + 1);
  2034.     strcpy(namePtr, tmpPtr);
  2035.  
  2036.     /*
  2037.      * NOTE: The deleteProc for this command will delete the
  2038.      * alias from the hash table. The deleteProc will also
  2039.      * delete the target information from the master interpreter
  2040.      * target table.
  2041.      */
  2042.  
  2043.     if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
  2044.         if (Tcl_ExposeCommand(slaveInterp, namePtr, namePtr) != TCL_OK) {
  2045.             panic("DeleteAlias: did not find alias to be deleted");
  2046.         }
  2047.         if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
  2048.             panic("DeleteAlias: did not find alias to be deleted");
  2049.         }
  2050.     }
  2051.     ckfree(namePtr);
  2052.  
  2053.     return TCL_OK;
  2054. }
  2055.  
  2056. /*
  2057.  *----------------------------------------------------------------------
  2058.  *
  2059.  * Tcl_GetInterpPath --
  2060.  *
  2061.  *    Sets the result of the asking interpreter to a proper Tcl list
  2062.  *    containing the names of interpreters between the asking and
  2063.  *    target interpreters. The target interpreter must be either the
  2064.  *    same as the asking interpreter or one of its slaves (including
  2065.  *    recursively).
  2066.  *
  2067.  * Results:
  2068.  *    TCL_OK if the target interpreter is the same as, or a descendant
  2069.  *    of, the asking interpreter; TCL_ERROR else. This way one can
  2070.  *    distinguish between the case where the asking and target interps
  2071.  *    are the same (an empty list is the result, and TCL_OK is returned)
  2072.  *    and when the target is not a descendant of the asking interpreter
  2073.  *    (in which case the Tcl result is an error message and the function
  2074.  *    returns TCL_ERROR).
  2075.  *
  2076.  * Side effects:
  2077.  *    None.
  2078.  *
  2079.  *----------------------------------------------------------------------
  2080.  */
  2081.  
  2082. int
  2083. Tcl_GetInterpPath(askingInterp, targetInterp)
  2084.     Tcl_Interp *askingInterp;    /* Interpreter to start search from. */
  2085.     Tcl_Interp *targetInterp;    /* Interpreter to find. */
  2086. {
  2087.     Master *masterPtr;        /* Interim storage for Master record. */
  2088.     Slave *slavePtr;        /* Interim storage for Slave record. */
  2089.     
  2090.     if (targetInterp == askingInterp) {
  2091.         return TCL_OK;
  2092.     }
  2093.     if (targetInterp == (Tcl_Interp *) NULL) {
  2094.         return TCL_ERROR;
  2095.     }
  2096.     slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
  2097.             NULL);
  2098.     if (slavePtr == (Slave *) NULL) {
  2099.         return TCL_ERROR;
  2100.     }
  2101.     if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
  2102.  
  2103.         /*
  2104.          * The result of askingInterp was set by recursive call.
  2105.          */
  2106.  
  2107.         return TCL_ERROR;
  2108.     }
  2109.     masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
  2110.             "tclMasterRecord", NULL);
  2111.     if (masterPtr == (Master *) NULL) {
  2112.         panic("Tcl_GetInterpPath: could not find master record");
  2113.     }
  2114.     Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
  2115.             slavePtr->slaveEntry));
  2116.     return TCL_OK;
  2117. }
  2118.  
  2119. /*
  2120.  *----------------------------------------------------------------------
  2121.  *
  2122.  * GetTarget --
  2123.  *
  2124.  *    Sets the result of the invoking interpreter to a path name for
  2125.  *    the target interpreter of an alias in one of the slaves.
  2126.  *
  2127.  * Results:
  2128.  *    TCL_OK if the target interpreter of the alias is a slave of the
  2129.  *    invoking interpreter, TCL_ERROR else.
  2130.  *
  2131.  * Side effects:
  2132.  *    Sets the result of the invoking interpreter.
  2133.  *
  2134.  *----------------------------------------------------------------------
  2135.  */
  2136.  
  2137. static int
  2138. GetTarget(askingInterp, path, aliasName)
  2139.     Tcl_Interp *askingInterp;    /* Interpreter to start search from. */
  2140.     char *path;            /* The path of the interp to find. */
  2141.     char *aliasName;        /* The target of this allias. */
  2142. {
  2143.     Tcl_Interp *slaveInterp;    /* Interim storage for slave. */
  2144.     Slave *slaveSlavePtr;    /* Its Slave record. */
  2145.     Master *masterPtr;        /* Interim storage for Master record. */
  2146.     Tcl_HashEntry *hPtr;    /* Search element. */
  2147.     Alias *aliasPtr;        /* Data describing the alias. */
  2148.  
  2149.     Tcl_ResetResult(askingInterp);
  2150.     masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
  2151.             NULL);
  2152.     if (masterPtr == (Master *) NULL) {
  2153.         panic("GetTarget: could not find master record");
  2154.     }
  2155.     slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
  2156.     if (slaveInterp == (Tcl_Interp *) NULL) {
  2157.         Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
  2158.                 "could not find interpreter \"", path, "\"", (char *) NULL);
  2159.         return TCL_ERROR;
  2160.     }
  2161.     slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  2162.             NULL);
  2163.     if (slaveSlavePtr == (Slave *) NULL) {
  2164.         panic("GetTarget: could not find slave record");
  2165.     }
  2166.     hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
  2167.     if (hPtr == (Tcl_HashEntry *) NULL) {
  2168.         Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
  2169.                 "alias \"", aliasName, "\" in path \"", path, "\" not found",
  2170.                 (char *) NULL);
  2171.         return TCL_ERROR;
  2172.     }
  2173.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  2174.     if (aliasPtr == (Alias *) NULL) {
  2175.         panic("GetTarget: could not find alias record");
  2176.     }
  2177.     
  2178.     if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
  2179.         Tcl_ResetResult(askingInterp);
  2180.         Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
  2181.                 "target interpreter for alias \"",
  2182.                 aliasName, "\" in path \"", path, "\" is not my descendant",
  2183.                 (char *) NULL);
  2184.         return TCL_ERROR;
  2185.     }
  2186.     
  2187.     return TCL_OK;
  2188. }
  2189.  
  2190. /*
  2191.  *----------------------------------------------------------------------
  2192.  *
  2193.  * Tcl_InterpCmd --
  2194.  *
  2195.  *    This procedure is invoked to process the "interp" Tcl command.
  2196.  *    See the user documentation for details on what it does.
  2197.  *
  2198.  * Results:
  2199.  *    A standard Tcl result.
  2200.  *
  2201.  * Side effects:
  2202.  *    See the user documentation.
  2203.  *
  2204.  *----------------------------------------------------------------------
  2205.  */
  2206.     /* ARGSUSED */
  2207. int
  2208. Tcl_InterpObjCmd(clientData, interp, objc, objv)
  2209.     ClientData clientData;        /* Unused. */
  2210.     Tcl_Interp *interp;            /* Current interpreter. */
  2211.     int objc;                /* Number of arguments. */
  2212.     Tcl_Obj *CONST objv[];        /* Argument objects. */
  2213. {
  2214.     Master *masterPtr;            /* Master record for current interp. */
  2215.     int result;                /* Local result variable. */
  2216.  
  2217.     /*
  2218.      * These are all the different subcommands for this command:
  2219.      */
  2220.     
  2221.     static char *subCmds[] = {
  2222.         "alias", "aliases", "create", "delete", "eval", "exists",
  2223.     "expose", "hide", "hidden", "issafe", "invokehidden",
  2224.         "marktrusted", "slaves", "share", "target", "transfer",
  2225.         (char *) NULL};
  2226.     enum ISubCmdIdx {
  2227.         IAliasIdx, IAliasesIdx, ICreateIdx, IDeleteIdx, IEvalIdx,
  2228.     IExistsIdx, IExposeIdx, IHideIdx, IHiddenIdx, IIsSafeIdx,
  2229.     IInvokeHiddenIdx, IMarkTrustedIdx, ISlavesIdx, IShareIdx,
  2230.         ITargetIdx, ITransferIdx
  2231.     } index;
  2232.  
  2233.     if (objc < 2) {
  2234.         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
  2235.         return TCL_ERROR;
  2236.     }
  2237.  
  2238.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  2239.     if (masterPtr == (Master *) NULL) {
  2240.         panic("Tcl_InterpCmd: could not find master record");
  2241.     }
  2242.  
  2243.     result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
  2244.             0, (int *) &index);
  2245.     if (result != TCL_OK) {
  2246.         return result;
  2247.     }
  2248.     
  2249.     switch (index) {
  2250.         case IAliasIdx:
  2251.             return InterpAliasHelper(interp, masterPtr, objc, objv);
  2252.         case IAliasesIdx:
  2253.             return InterpAliasesHelper(interp, masterPtr, objc, objv);
  2254.         case ICreateIdx:
  2255.             return CreateInterpObject(interp, masterPtr, objc, objv);
  2256.         case IDeleteIdx:
  2257.             return DeleteInterpObject(interp, masterPtr, objc, objv);
  2258.         case IEvalIdx:
  2259.             return InterpEvalHelper(interp, masterPtr, objc, objv);
  2260.         case IExistsIdx:
  2261.             return InterpExistsHelper(interp, masterPtr, objc, objv);
  2262.         case IExposeIdx:
  2263.             return InterpExposeHelper(interp, masterPtr, objc, objv);
  2264.         case IHideIdx:
  2265.             return InterpHideHelper(interp, masterPtr, objc, objv);
  2266.         case IHiddenIdx:
  2267.             return InterpHiddenHelper(interp, masterPtr, objc, objv);
  2268.         case IIsSafeIdx:
  2269.             return InterpIsSafeHelper(interp, masterPtr, objc, objv);
  2270.         case IInvokeHiddenIdx:
  2271.             return InterpInvokeHiddenHelper(interp, masterPtr, objc, objv);
  2272.         case IMarkTrustedIdx:
  2273.             return InterpMarkTrustedHelper(interp, masterPtr, objc, objv);
  2274.         case ISlavesIdx:
  2275.             return InterpSlavesHelper(interp, masterPtr, objc, objv);
  2276.         case IShareIdx:
  2277.             return InterpShareHelper(interp, masterPtr, objc, objv);
  2278.         case ITargetIdx:
  2279.             return InterpTargetHelper(interp, masterPtr, objc, objv);
  2280.         case ITransferIdx:
  2281.             return InterpTransferHelper(interp, masterPtr, objc, objv);
  2282.     }
  2283.  
  2284.     return TCL_ERROR;    
  2285. }
  2286.  
  2287. /*
  2288.  *----------------------------------------------------------------------
  2289.  *
  2290.  * SlaveAliasHelper --
  2291.  *
  2292.  *    Helper function to construct or query an alias for a slave
  2293.  *    interpreter.
  2294.  *
  2295.  * Results:
  2296.  *    A standard Tcl result.
  2297.  *
  2298.  * Side effects:
  2299.  *    Potentially creates a new alias.
  2300.  *
  2301.  *----------------------------------------------------------------------
  2302.  */
  2303.  
  2304. static int
  2305. SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv)
  2306.     Tcl_Interp    *interp;        /* Current interpreter. */
  2307.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2308.     Slave *slavePtr;            /* Its slave record. */
  2309.     int objc;                /* Count of arguments. */
  2310.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2311. {
  2312.     Master *masterPtr;
  2313.     int len;
  2314.  
  2315.     switch (objc-2) {
  2316.         case 0:
  2317.             Tcl_WrongNumArgs(interp, 2, objv,
  2318.                     "aliasName ?targetName? ?args..?");
  2319.             return TCL_ERROR;
  2320.  
  2321.         case 1:
  2322.  
  2323.             /*
  2324.              * Return the name of the command in the current
  2325.              * interpreter for which the argument is an alias in the
  2326.              * slave interpreter, and the list of saved arguments
  2327.              */
  2328.  
  2329.             return DescribeAlias(interp, slaveInterp,
  2330.                     Tcl_GetStringFromObj(objv[2], &len));
  2331.  
  2332.         default:
  2333.             masterPtr = (Master *) Tcl_GetAssocData(interp,
  2334.                     "tclMasterRecord", NULL);
  2335.             if (masterPtr == (Master *) NULL) {
  2336.                 panic("SlaveObjectCmd: could not find master record");
  2337.             }
  2338.             return AliasCreationHelper(interp, slaveInterp, interp,
  2339.                     masterPtr,
  2340.                     Tcl_GetStringFromObj(objv[2], &len),
  2341.                     Tcl_GetStringFromObj(objv[3], &len),
  2342.                     objc-4, objv+4);
  2343.     }
  2344. }
  2345.  
  2346. /*
  2347.  *----------------------------------------------------------------------
  2348.  *
  2349.  * SlaveAliasesHelper --
  2350.  *
  2351.  *    Computes a list of aliases defined in a slave interpreter.
  2352.  *
  2353.  * Results:
  2354.  *    A standard Tcl result.
  2355.  *
  2356.  * Side effects:
  2357.  *    None.
  2358.  *
  2359.  *----------------------------------------------------------------------
  2360.  */
  2361.  
  2362. static int
  2363. SlaveAliasesHelper(interp, slaveInterp, slavePtr, objc, objv)
  2364.     Tcl_Interp    *interp;        /* Current interpreter. */
  2365.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2366.     Slave *slavePtr;            /* Its slave record. */
  2367.     int objc;                /* Count of arguments. */
  2368.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2369. {
  2370.     Tcl_HashEntry *hPtr;        /* For local searches. */
  2371.     Tcl_HashSearch hSearch;        /* For local searches. */
  2372.     Tcl_Obj *listObjPtr;        /* Local object pointer. */
  2373.     Alias *aliasPtr;            /* Alias information. */
  2374.  
  2375.     /*
  2376.      * Return the names of all the aliases created in the
  2377.      * slave interpreter.
  2378.      */
  2379.  
  2380.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  2381.     for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
  2382.             &hSearch);
  2383.          hPtr != (Tcl_HashEntry *) NULL;
  2384.          hPtr = Tcl_NextHashEntry(&hSearch)) {
  2385.         aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  2386.         Tcl_ListObjAppendElement(interp, listObjPtr,
  2387.                 Tcl_NewStringObj(aliasPtr->aliasName, -1));
  2388.     }
  2389.     Tcl_SetObjResult(interp, listObjPtr);
  2390.     return TCL_OK;
  2391. }
  2392.  
  2393. /*
  2394.  *----------------------------------------------------------------------
  2395.  *
  2396.  * SlaveEvalHelper --
  2397.  *
  2398.  *    Helper function to evaluate a command in a slave interpreter.
  2399.  *
  2400.  * Results:
  2401.  *    A standard Tcl result.
  2402.  *
  2403.  * Side effects:
  2404.  *    Whatever the command does.
  2405.  *
  2406.  *----------------------------------------------------------------------
  2407.  */
  2408.  
  2409. static int
  2410. SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv)
  2411.     Tcl_Interp    *interp;        /* Current interpreter. */
  2412.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2413.     Slave *slavePtr;            /* Its slave record. */
  2414.     int objc;                /* Count of arguments. */
  2415.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2416. {
  2417.     Interp *iPtr;            /* Internal data type for slave. */
  2418.     Tcl_Obj *objPtr;            /* Local object pointer. */
  2419.     Tcl_Obj *namePtr;            /* Local object pointer. */
  2420.     int len;
  2421.     char *string;
  2422.     int result;
  2423.     
  2424.     if (objc < 3) {
  2425.         Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
  2426.         return TCL_ERROR;
  2427.     }
  2428.  
  2429.     objPtr = Tcl_ConcatObj(objc-2, objv+2);
  2430.     Tcl_IncrRefCount(objPtr);
  2431.     
  2432.     Tcl_Preserve((ClientData) slaveInterp);
  2433.     result = Tcl_EvalObj(slaveInterp, objPtr);
  2434.  
  2435.     Tcl_DecrRefCount(objPtr);
  2436.  
  2437.     /*
  2438.      * Make the result and any error information accessible. We have
  2439.      * to be careful because the slave interpreter and the current
  2440.      * interpreter can be the same - do not destroy the result.. This
  2441.      * can happen if an interpreter contains an alias which is directed
  2442.      * at a target command in the same interpreter.
  2443.      */
  2444.  
  2445.     if (interp != slaveInterp) {
  2446.         if (result == TCL_ERROR) {
  2447.  
  2448.             /*
  2449.              * An error occurred, so transfer error information from the
  2450.              * destination interpreter back to our interpreter. 
  2451.              */
  2452.  
  2453.             iPtr = (Interp *) slaveInterp;
  2454.             if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  2455.                 Tcl_AddErrorInfo(slaveInterp, "");
  2456.             }
  2457.             iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  2458.  
  2459.             Tcl_ResetResult(interp);
  2460.             namePtr = Tcl_NewStringObj("errorInfo", -1);
  2461.             objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
  2462.                     (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
  2463.             string = Tcl_GetStringFromObj(objPtr, &len);
  2464.             Tcl_AddObjErrorInfo(interp, string, len);
  2465.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  2466.                     Tcl_GetVar2(slaveInterp, "errorCode", (char *)
  2467.                             NULL, TCL_GLOBAL_ONLY),
  2468.                     TCL_GLOBAL_ONLY);
  2469.             Tcl_DecrRefCount(namePtr);
  2470.         }
  2471.  
  2472.     /*
  2473.          * Move the result object from one interpreter to the
  2474.          * other.
  2475.          */
  2476.                 
  2477.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  2478.         Tcl_ResetResult(slaveInterp);
  2479.     }
  2480.     Tcl_Release((ClientData) slaveInterp);
  2481.     return result;        
  2482. }
  2483.  
  2484. /*
  2485.  *----------------------------------------------------------------------
  2486.  *
  2487.  * SlaveExposeHelper --
  2488.  *
  2489.  *    Helper function to expose a command in a slave interpreter.
  2490.  *
  2491.  * Results:
  2492.  *    A standard Tcl result.
  2493.  *
  2494.  * Side effects:
  2495.  *    After this call scripts in the slave will be able to invoke
  2496.  *    the newly exposed command.
  2497.  *
  2498.  *----------------------------------------------------------------------
  2499.  */
  2500.  
  2501. static int
  2502. SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
  2503.     Tcl_Interp    *interp;        /* Current interpreter. */
  2504.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2505.     Slave *slavePtr;            /* Its slave record. */
  2506.     int objc;                /* Count of arguments. */
  2507.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2508. {
  2509.     int len;
  2510.     
  2511.     if ((objc != 3) && (objc != 4)) {
  2512.         Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
  2513.         return TCL_ERROR;
  2514.     }
  2515.     if (Tcl_IsSafe(interp)) {
  2516.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2517.                 "permission denied: safe interpreter cannot expose commands",
  2518.                 (char *) NULL);
  2519.         return TCL_ERROR;
  2520.     }
  2521.     if (Tcl_ExposeCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
  2522.             (objc == 4 ?
  2523.                     Tcl_GetStringFromObj(objv[3], &len) :
  2524.                     Tcl_GetStringFromObj(objv[2], &len)))
  2525.             == TCL_ERROR) {
  2526.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  2527.         Tcl_ResetResult(slaveInterp);
  2528.         return TCL_ERROR;
  2529.     }
  2530.     return TCL_OK;
  2531. }
  2532.  
  2533. /*
  2534.  *----------------------------------------------------------------------
  2535.  *
  2536.  * SlaveHideHelper --
  2537.  *
  2538.  *    Helper function to hide a command in a slave interpreter.
  2539.  *
  2540.  * Results:
  2541.  *    A standard Tcl result.
  2542.  *
  2543.  * Side effects:
  2544.  *    After this call scripts in the slave will no longer be able
  2545.  *    to invoke the named command.
  2546.  *
  2547.  *----------------------------------------------------------------------
  2548.  */
  2549.  
  2550. static int
  2551. SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
  2552.     Tcl_Interp    *interp;        /* Current interpreter. */
  2553.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2554.     Slave *slavePtr;            /* Its slave record. */
  2555.     int objc;                /* Count of arguments. */
  2556.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2557. {
  2558.     int len;
  2559.  
  2560.     if ((objc != 3) && (objc != 4)) {
  2561.         Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
  2562.         return TCL_ERROR;
  2563.     }
  2564.     if (Tcl_IsSafe(interp)) {
  2565.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2566.                 "permission denied: safe interpreter cannot hide commands",
  2567.                 (char *) NULL);
  2568.         return TCL_ERROR;
  2569.     }
  2570.     if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
  2571.             (objc == 4 ?
  2572.                     Tcl_GetStringFromObj(objv[3], &len) :
  2573.                     Tcl_GetStringFromObj(objv[2], &len)))
  2574.             == TCL_ERROR) {
  2575.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  2576.         Tcl_ResetResult(slaveInterp);
  2577.         return TCL_ERROR;
  2578.     }
  2579.     return TCL_OK;
  2580. }
  2581.  
  2582. /*
  2583.  *----------------------------------------------------------------------
  2584.  *
  2585.  * SlaveHiddenHelper --
  2586.  *
  2587.  *    Helper function to compute list of hidden commands in a slave
  2588.  *    interpreter.
  2589.  *
  2590.  * Results:
  2591.  *    A standard Tcl result.
  2592.  *
  2593.  * Side effects:
  2594.  *    None.
  2595.  *
  2596.  *----------------------------------------------------------------------
  2597.  */
  2598.  
  2599. static int
  2600. SlaveHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
  2601.     Tcl_Interp    *interp;        /* Current interpreter. */
  2602.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2603.     Slave *slavePtr;            /* Its slave record. */
  2604.     int objc;                /* Count of arguments. */
  2605.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2606. {
  2607.     Tcl_Obj *listObjPtr;        /* Local object pointer. */
  2608.     Tcl_HashTable *hTblPtr;        /* For local searches. */
  2609.     Tcl_HashEntry *hPtr;        /* For local searches. */
  2610.     Tcl_HashSearch hSearch;        /* For local searches. */
  2611.     
  2612.     if (objc != 2) {
  2613.         Tcl_WrongNumArgs(interp, 2, objv, NULL);
  2614.         return TCL_ERROR;
  2615.     }
  2616.  
  2617.     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
  2618.     hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
  2619.             "tclHiddenCmds", NULL);
  2620.     if (hTblPtr != (Tcl_HashTable *) NULL) {
  2621.         for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  2622.              hPtr != (Tcl_HashEntry *) NULL;
  2623.              hPtr = Tcl_NextHashEntry(&hSearch)) {
  2624.             Tcl_ListObjAppendElement(interp, listObjPtr,
  2625.                     Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
  2626.         }
  2627.     }
  2628.     Tcl_SetObjResult(interp, listObjPtr);
  2629.     return TCL_OK;
  2630. }
  2631.  
  2632. /*
  2633.  *----------------------------------------------------------------------
  2634.  *
  2635.  * SlaveIsSafeHelper --
  2636.  *
  2637.  *    Helper function to compute whether a slave interpreter is safe.
  2638.  *
  2639.  * Results:
  2640.  *    A standard Tcl result.
  2641.  *
  2642.  * Side effects:
  2643.  *    None.
  2644.  *
  2645.  *----------------------------------------------------------------------
  2646.  */
  2647.  
  2648. static int
  2649. SlaveIsSafeHelper(interp, slaveInterp, slavePtr, objc, objv)
  2650.     Tcl_Interp    *interp;        /* Current interpreter. */
  2651.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2652.     Slave *slavePtr;            /* Its slave record. */
  2653.     int objc;                /* Count of arguments. */
  2654.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2655. {
  2656.     Tcl_Obj *resultPtr;            /* Local object pointer. */
  2657.  
  2658.     if (objc > 2) {
  2659.         Tcl_WrongNumArgs(interp, 2, objv, NULL);
  2660.         return TCL_ERROR;
  2661.     }
  2662.     resultPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
  2663.  
  2664.     Tcl_SetObjResult(interp, resultPtr);
  2665.     return TCL_OK;
  2666. }
  2667.  
  2668. /*
  2669.  *----------------------------------------------------------------------
  2670.  *
  2671.  * SlaveInvokeHiddenHelper --
  2672.  *
  2673.  *    Helper function to invoke a hidden command in a slave interpreter.
  2674.  *
  2675.  * Results:
  2676.  *    A standard Tcl result.
  2677.  *
  2678.  * Side effects:
  2679.  *    Whatever the hidden command does.
  2680.  *
  2681.  *----------------------------------------------------------------------
  2682.  */
  2683.  
  2684. static int
  2685. SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
  2686.     Tcl_Interp    *interp;        /* Current interpreter. */
  2687.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2688.     Slave *slavePtr;            /* Its slave record. */
  2689.     int objc;                /* Count of arguments. */
  2690.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2691. {
  2692.     Interp *iPtr;
  2693.     Master *masterPtr;
  2694.     int doGlobal = 0;
  2695.     int result;
  2696.     int len;
  2697.     char *string;
  2698.     Tcl_Obj *namePtr, *objPtr;
  2699.             
  2700.     if (objc < 3) {
  2701.         Tcl_WrongNumArgs(interp, 2, objv,
  2702.                 "?-global? cmd ?arg ..?");
  2703.         return TCL_ERROR;
  2704.     }
  2705.     if (Tcl_IsSafe(interp)) {
  2706.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2707.                 "not allowed to invoke hidden commands from safe interpreter",
  2708.                 (char *) NULL);
  2709.         return TCL_ERROR;
  2710.     }
  2711.     if (strcmp(Tcl_GetStringFromObj(objv[2], &len), "-global") == 0) {
  2712.         doGlobal = 1;
  2713.         if (objc < 4) {
  2714.             Tcl_WrongNumArgs(interp, 2, objv,
  2715.                     "path ?-global? cmd ?arg ..?");
  2716.             return TCL_ERROR;
  2717.         }
  2718.     }
  2719.     masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
  2720.             "tclMasterRecord", NULL);
  2721.     if (masterPtr == (Master *) NULL) {
  2722.         panic("SlaveObjectCmd: could not find master record");
  2723.     }
  2724.     Tcl_Preserve((ClientData) slaveInterp);
  2725.     if (doGlobal) {
  2726.         result = TclObjInvokeGlobal(slaveInterp, objc-3, objv+3,
  2727.                 TCL_INVOKE_HIDDEN);
  2728.     } else {
  2729.         result = TclObjInvoke(slaveInterp, objc-2, objv+2,
  2730.                 TCL_INVOKE_HIDDEN);
  2731.     }
  2732.  
  2733.     /*
  2734.      * Now make the result and any error information accessible. We
  2735.      * have to be careful because the slave interpreter and the current
  2736.      * interpreter can be the same - do not destroy the result.. This
  2737.      * can happen if an interpreter contains an alias which is directed
  2738.      * at a target command in the same interpreter.
  2739.      */
  2740.  
  2741.     if (interp != slaveInterp) {
  2742.         if (result == TCL_ERROR) {
  2743.  
  2744.             /*
  2745.              * An error occurred, so transfer error information from
  2746.              * the target interpreter back to our interpreter.
  2747.              */
  2748.  
  2749.             iPtr = (Interp *) slaveInterp;
  2750.             if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  2751.                 Tcl_AddErrorInfo(slaveInterp, "");
  2752.             }
  2753.             iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  2754.  
  2755.             Tcl_ResetResult(interp);
  2756.             namePtr = Tcl_NewStringObj("errorInfo", -1);
  2757.             objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
  2758.                     (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
  2759.             string = Tcl_GetStringFromObj(objPtr, &len);
  2760.             Tcl_AddObjErrorInfo(interp, string, len);
  2761.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  2762.                     Tcl_GetVar2(slaveInterp, "errorCode", (char *)
  2763.                             NULL, TCL_GLOBAL_ONLY),
  2764.                     TCL_GLOBAL_ONLY);
  2765.             Tcl_DecrRefCount(namePtr);
  2766.         }
  2767.  
  2768.     /*
  2769.          * Move the result object from the slave to the master.
  2770.          */
  2771.                 
  2772.         Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
  2773.         Tcl_ResetResult(slaveInterp);
  2774.     }
  2775.     Tcl_Release((ClientData) slaveInterp);
  2776.     return result;        
  2777. }
  2778.  
  2779. /*
  2780.  *----------------------------------------------------------------------
  2781.  *
  2782.  * SlaveMarkTrustedHelper --
  2783.  *
  2784.  *    Helper function to mark a slave interpreter as trusted (unsafe).
  2785.  *
  2786.  * Results:
  2787.  *    A standard Tcl result.
  2788.  *
  2789.  * Side effects:
  2790.  *    After this call the hard-wired security checks in the core no
  2791.  *    longer prevent the slave from performing certain operations.
  2792.  *
  2793.  *----------------------------------------------------------------------
  2794.  */
  2795.  
  2796. static int
  2797. SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr, objc, objv)
  2798.     Tcl_Interp    *interp;        /* Current interpreter. */
  2799.     Tcl_Interp    *slaveInterp;        /* The slave interpreter. */
  2800.     Slave *slavePtr;            /* Its slave record. */
  2801.     int objc;                /* Count of arguments. */
  2802.     Tcl_Obj *CONST objv[];        /* Vector of arguments. */
  2803. {
  2804.     int len;
  2805.     
  2806.     if (objc != 2) {
  2807.         Tcl_WrongNumArgs(interp, 2, objv, NULL);
  2808.         return TCL_ERROR;
  2809.     }
  2810.     if (Tcl_IsSafe(interp)) {
  2811.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2812.                 "\"", Tcl_GetStringFromObj(objv[0], &len), " marktrusted\"",
  2813.                 " can only be invoked from a trusted interpreter",
  2814.                 (char *) NULL);
  2815.         return TCL_ERROR;
  2816.     }
  2817.     return MarkTrusted(slaveInterp);
  2818. }
  2819.  
  2820. /*
  2821.  *----------------------------------------------------------------------
  2822.  *
  2823.  * SlaveObjectCmd --
  2824.  *
  2825.  *    Command to manipulate an interpreter, e.g. to send commands to it
  2826.  *    to be evaluated. One such command exists for each slave interpreter.
  2827.  *
  2828.  * Results:
  2829.  *    A standard Tcl result.
  2830.  *
  2831.  * Side effects:
  2832.  *    See user documentation for details.
  2833.  *
  2834.  *----------------------------------------------------------------------
  2835.  */
  2836.  
  2837. static int
  2838. SlaveObjectCmd(clientData, interp, objc, objv)
  2839.     ClientData clientData;        /* Slave interpreter. */
  2840.     Tcl_Interp *interp;            /* Current interpreter. */
  2841.     int objc;                /* Number of arguments. */
  2842.     Tcl_Obj *CONST objv[];        /* The argument vector. */
  2843. {
  2844.     Slave *slavePtr;            /* Slave record. */
  2845.     Tcl_Interp *slaveInterp;        /* Slave interpreter. */
  2846.     int result;                /* Loop counter, status return. */
  2847.     int len;                /* Length of command name. */
  2848.  
  2849.     /*
  2850.      * These are all the different subcommands for this command:
  2851.      */
  2852.     
  2853.     static char *subCmds[] = {
  2854.         "alias", "aliases",
  2855.         "eval", "expose",
  2856.         "hide", "hidden",
  2857.         "issafe", "invokehidden",
  2858.         "marktrusted",
  2859.         (char *) NULL};
  2860.     enum ISubCmdIdx {
  2861.         IAliasIdx, IAliasesIdx,
  2862.         IEvalIdx, IExposeIdx,
  2863.         IHideIdx, IHiddenIdx,
  2864.         IIsSafeIdx, IInvokeHiddenIdx,
  2865.         IMarkTrustedIdx
  2866.     } index;
  2867.     
  2868.     if (objc < 2) {
  2869.         Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
  2870.         return TCL_ERROR;
  2871.     }
  2872.  
  2873.     slaveInterp = (Tcl_Interp *) clientData;
  2874.     if (slaveInterp == (Tcl_Interp *) NULL) {
  2875.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  2876.                 "interpreter ", Tcl_GetStringFromObj(objv[0], &len),
  2877.                 " has been deleted", (char *) NULL);
  2878.     return TCL_ERROR;
  2879.     }
  2880.  
  2881.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
  2882.             "tclSlaveRecord", NULL);
  2883.     if (slavePtr == (Slave *) NULL) {
  2884.         panic("SlaveObjectCmd: could not find slave record");
  2885.     }
  2886.  
  2887.     result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
  2888.             0, (int *) &index);
  2889.     if (result != TCL_OK) {
  2890.         return result;
  2891.     }
  2892.  
  2893.     switch (index) {
  2894.         case IAliasIdx:
  2895.             return SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv);
  2896.         case IAliasesIdx:
  2897.             return SlaveAliasesHelper(interp, slaveInterp, slavePtr,
  2898.                     objc, objv);
  2899.         case IEvalIdx:
  2900.             return SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv);
  2901.         case IExposeIdx:
  2902.             return SlaveExposeHelper(interp, slaveInterp, slavePtr,
  2903.                     objc, objv);
  2904.         case IHideIdx:
  2905.             return SlaveHideHelper(interp, slaveInterp, slavePtr,
  2906.                     objc, objv);
  2907.         case IHiddenIdx:
  2908.             return SlaveHiddenHelper(interp, slaveInterp, slavePtr,
  2909.                     objc, objv);
  2910.         case IIsSafeIdx:
  2911.             return SlaveIsSafeHelper(interp, slaveInterp, slavePtr,
  2912.                     objc, objv);
  2913.         case IInvokeHiddenIdx:
  2914.             return SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr,
  2915.                     objc, objv);
  2916.         case IMarkTrustedIdx:
  2917.             return SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr,
  2918.                     objc, objv);
  2919.     }
  2920.  
  2921.     return TCL_ERROR;
  2922. }
  2923.  
  2924. /*
  2925.  *----------------------------------------------------------------------
  2926.  *
  2927.  * SlaveObjectDeleteProc --
  2928.  *
  2929.  *    Invoked when an object command for a slave interpreter is deleted;
  2930.  *    cleans up all state associated with the slave interpreter and destroys
  2931.  *    the slave interpreter.
  2932.  *
  2933.  * Results:
  2934.  *    None.
  2935.  *
  2936.  * Side effects:
  2937.  *    Cleans up all state associated with the slave interpreter and
  2938.  *    destroys the slave interpreter.
  2939.  *
  2940.  *----------------------------------------------------------------------
  2941.  */
  2942.  
  2943. static void
  2944. SlaveObjectDeleteProc(clientData)
  2945.     ClientData clientData;        /* The SlaveRecord for the command. */
  2946. {
  2947.     Slave *slavePtr;            /* Interim storage for Slave record. */
  2948.     Tcl_Interp *slaveInterp;        /* And for a slave interp. */
  2949.  
  2950.     slaveInterp = (Tcl_Interp *) clientData;
  2951.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL); 
  2952.     if (slavePtr == (Slave *) NULL) {
  2953.         panic("SlaveObjectDeleteProc: could not find slave record");
  2954.     }
  2955.  
  2956.     /*
  2957.      * Delete the entry in the slave table in the master interpreter now.
  2958.      * This is to avoid an infinite loop in the Master hash table cleanup in
  2959.      * the master interpreter. This can happen if this slave is being deleted
  2960.      * because the master is being deleted and the slave deletion is deferred
  2961.      * because it is still active.
  2962.      */
  2963.  
  2964.     Tcl_DeleteHashEntry(slavePtr->slaveEntry);
  2965.  
  2966.     /*
  2967.      * Set to NULL so that when the slave record is cleaned up in the slave
  2968.      * it does not try to delete the command causing all sorts of grief.
  2969.      * See SlaveRecordDeleteProc().
  2970.      */
  2971.  
  2972.     slavePtr->interpCmd = NULL;
  2973.  
  2974.     /*
  2975.      * Destroy the interpreter - this will cause all the deleteProcs for
  2976.      * all commands (including aliases) to run.
  2977.      *
  2978.      * NOTE: WE ASSUME THAT THE INTERPRETER HAS NOT BEEN DELETED YET!!
  2979.      */
  2980.  
  2981.     Tcl_DeleteInterp(slavePtr->slaveInterp);
  2982. }
  2983.  
  2984. /*
  2985.  *----------------------------------------------------------------------
  2986.  *
  2987.  * AliasCmd --
  2988.  *
  2989.  *    This is the procedure that services invocations of aliases in a
  2990.  *    slave interpreter. One such command exists for each alias. When
  2991.  *    invoked, this procedure redirects the invocation to the target
  2992.  *    command in the master interpreter as designated by the Alias
  2993.  *    record associated with this command.
  2994.  *
  2995.  * Results:
  2996.  *    A standard Tcl result.
  2997.  *
  2998.  * Side effects:
  2999.  *    Causes forwarding of the invocation; all possible side effects
  3000.  *    may occur as a result of invoking the command to which the
  3001.  *    invocation is forwarded.
  3002.  *
  3003.  *----------------------------------------------------------------------
  3004.  */
  3005.  
  3006. static int
  3007. AliasCmd(clientData, interp, objc, objv)
  3008.     ClientData clientData;        /* Alias record. */
  3009.     Tcl_Interp *interp;            /* Current interpreter. */
  3010.     int objc;                /* Number of arguments. */
  3011.     Tcl_Obj *CONST objv[];        /* Argument vector. */    
  3012. {
  3013.     Tcl_Interp *targetInterp;        /* Target for alias exec. */
  3014.     Interp *iPtr;            /* Internal type of target. */
  3015.     Alias *aliasPtr;            /* Describes the alias. */
  3016.     Tcl_Command cmd;            /* The target command. */
  3017.     Command *cmdPtr;            /* Points to target command. */
  3018.     Tcl_Namespace *targetNsPtr;            /* Target command's namespace. */
  3019.     int result;                /* Result of execution. */
  3020.     int i, j, addObjc;            /* Loop counters. */
  3021.     int localObjc;            /* Local argument count. */
  3022.     Tcl_Obj **localObjv;        /* Local argument vector. */
  3023.     Tcl_Obj *namePtr, *objPtr;        /* Local object pointers. */
  3024.     char *string;            /* Local object string rep. */
  3025.     int len;                /* Dummy length arg. */
  3026.     
  3027.     aliasPtr = (Alias *) clientData;
  3028.     targetInterp = aliasPtr->targetInterp;
  3029.  
  3030.     /*
  3031.      * Look for the target command in the global namespace of the target
  3032.      * interpreter.
  3033.      */
  3034.  
  3035.     cmdPtr = NULL;
  3036.     targetNsPtr = Tcl_GetGlobalNamespace(aliasPtr->targetInterp);
  3037.     cmd = Tcl_FindCommand(targetInterp, aliasPtr->targetName,
  3038.             targetNsPtr, /*flags*/ 0);
  3039.     if (cmd != (Tcl_Command) NULL) {
  3040.         cmdPtr = (Command *) cmd;
  3041.     }
  3042.  
  3043.     iPtr = (Interp *) targetInterp;
  3044.  
  3045.     /*
  3046.      * If the command does not exist, invoke "unknown" in the master.
  3047.      */
  3048.     
  3049.     if (cmdPtr == NULL) {
  3050.         addObjc = aliasPtr->objc;
  3051.         localObjc = addObjc + objc + 1;
  3052.         localObjv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *)
  3053.                 * localObjc);
  3054.         
  3055.         localObjv[0] = Tcl_NewStringObj("unknown", -1);
  3056.         localObjv[1] = Tcl_NewStringObj(aliasPtr->targetName, -1);
  3057.         Tcl_IncrRefCount(localObjv[0]);
  3058.         Tcl_IncrRefCount(localObjv[1]);
  3059.         
  3060.         for (i = 0, j = 2; i < addObjc; i++, j++) {
  3061.             localObjv[j] = aliasPtr->objv[i];
  3062.         }
  3063.         for (i = 1; i < objc; i++, j++) {
  3064.             localObjv[j] = objv[i];
  3065.         }
  3066.         Tcl_Preserve((ClientData) targetInterp);
  3067.         result = TclObjInvoke(targetInterp, localObjc, localObjv, 0);
  3068.  
  3069.         Tcl_DecrRefCount(localObjv[0]);
  3070.         Tcl_DecrRefCount(localObjv[1]);
  3071.         
  3072.         ckfree((char *) localObjv);
  3073.         
  3074.         if (targetInterp != interp) {
  3075.             if (result == TCL_ERROR) {
  3076.                 
  3077.                 /*
  3078.                  * An error occurred, so transfer error information from
  3079.                  * the target interpreter back to our interpreter.
  3080.                  */
  3081.  
  3082.                 if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  3083.                     Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
  3084.                 }
  3085.                 iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  3086.  
  3087.                 Tcl_ResetResult(interp);
  3088.                 namePtr = Tcl_NewStringObj("errorInfo", -1);
  3089.                 objPtr = Tcl_ObjGetVar2(targetInterp, namePtr,
  3090.                         (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
  3091.                 string = Tcl_GetStringFromObj(objPtr, &len);
  3092.                 Tcl_AddObjErrorInfo(interp, string, len);
  3093.                 Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  3094.                         Tcl_GetVar2(targetInterp, "errorCode", (char *)
  3095.                                 NULL, TCL_GLOBAL_ONLY),
  3096.                         TCL_GLOBAL_ONLY);
  3097.                 Tcl_DecrRefCount(namePtr);
  3098.             }
  3099.  
  3100.             /*
  3101.              * Transfer the result from the target interpreter to the
  3102.              * calling interpreter.
  3103.              */
  3104.             
  3105.             Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
  3106.             Tcl_ResetResult(targetInterp);
  3107.         }
  3108.  
  3109.     Tcl_Release((ClientData) targetInterp);
  3110.         return result;
  3111.     }
  3112.  
  3113.     /*
  3114.      * Otherwise invoke the regular target command.
  3115.      */
  3116.     
  3117.     if (aliasPtr->objc <= 0) {
  3118.         localObjv = (Tcl_Obj **) objv;
  3119.         localObjc = objc;
  3120.     } else {
  3121.         addObjc = aliasPtr->objc;
  3122.         localObjc = objc + addObjc;
  3123.         localObjv =
  3124.             (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * localObjc);
  3125.         localObjv[0] = objv[0];
  3126.         for (i = 0, j = 1; i < addObjc; i++, j++) {
  3127.             localObjv[j] = aliasPtr->objv[i];
  3128.         }
  3129.         for (i = 1; i < objc; i++, j++) {
  3130.             localObjv[j] = objv[i];
  3131.         }
  3132.     }
  3133.  
  3134.     iPtr->numLevels++;
  3135.     Tcl_Preserve((ClientData) targetInterp);
  3136.  
  3137.     /*
  3138.      * Reset the interpreter to its clean state; we do not know what state
  3139.      * it is in now..
  3140.      */
  3141.     
  3142.     Tcl_ResetResult(targetInterp);
  3143.     result = (cmdPtr->objProc)(cmdPtr->objClientData, targetInterp,
  3144.             localObjc, localObjv);
  3145.  
  3146.     iPtr->numLevels--;
  3147.     
  3148.     /*
  3149.      * Check if we are at the bottom of the stack for the target interpreter.
  3150.      * If so, check for special return codes.
  3151.      */
  3152.     
  3153.     if (iPtr->numLevels == 0) {
  3154.     if (result == TCL_RETURN) {
  3155.         result = TclUpdateReturnInfo(iPtr);
  3156.     }
  3157.     if ((result != TCL_OK) && (result != TCL_ERROR)) {
  3158.         Tcl_ResetResult(targetInterp);
  3159.         if (result == TCL_BREAK) {
  3160.                 Tcl_SetObjResult(targetInterp,
  3161.                         Tcl_NewStringObj("invoked \"break\" outside of a loop",
  3162.                                 -1));
  3163.         } else if (result == TCL_CONTINUE) {
  3164.                 Tcl_SetObjResult(targetInterp,
  3165.                         Tcl_NewStringObj(
  3166.                             "invoked \"continue\" outside of a loop",
  3167.                             -1));
  3168.         } else {
  3169.                 char buf[128];
  3170.  
  3171.                 sprintf(buf, "command returned bad code: %d", result);
  3172.                 Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
  3173.         }
  3174.         result = TCL_ERROR;
  3175.     }
  3176.     }
  3177.  
  3178.     /*
  3179.      * Clean up any locally allocated argument vector structure.
  3180.      */
  3181.     
  3182.     if (localObjv != objv) {
  3183.         ckfree((char *) localObjv);
  3184.     }
  3185.     
  3186.     /*
  3187.      * Move the result from the target interpreter to the invoking
  3188.      * interpreter if they are different.
  3189.      *
  3190.      * Note: We cannot use aliasPtr any more because the alias may have
  3191.      * been deleted.
  3192.      */
  3193.  
  3194.     if (interp != targetInterp) {
  3195.         if (result == TCL_ERROR) {
  3196.  
  3197.             /*
  3198.              * An error occurred, so transfer the error information from
  3199.              * the target interpreter back to our interpreter.
  3200.              */
  3201.  
  3202.             if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  3203.                 Tcl_AddErrorInfo(targetInterp, "");
  3204.             }
  3205.             iPtr->flags &= (~(ERR_ALREADY_LOGGED));
  3206.             
  3207.             Tcl_ResetResult(interp);
  3208.             namePtr = Tcl_NewStringObj("errorInfo", -1);
  3209.             objPtr = Tcl_ObjGetVar2(targetInterp, namePtr, (Tcl_Obj *) NULL,
  3210.                     TCL_GLOBAL_ONLY);
  3211.             string = Tcl_GetStringFromObj(objPtr, &len);
  3212.             Tcl_AddObjErrorInfo(interp, string, len);
  3213.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  3214.                     Tcl_GetVar2(targetInterp, "errorCode", (char *) NULL,
  3215.                             TCL_GLOBAL_ONLY),
  3216.                     TCL_GLOBAL_ONLY);
  3217.             Tcl_DecrRefCount(namePtr);
  3218.         }
  3219.  
  3220.     /*
  3221.          * Move the result object from one interpreter to the
  3222.          * other.
  3223.          */
  3224.                 
  3225.         Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
  3226.         Tcl_ResetResult(targetInterp);
  3227.     }
  3228.     Tcl_Release((ClientData) targetInterp);
  3229.     return result;        
  3230. }
  3231.  
  3232. /*
  3233.  *----------------------------------------------------------------------
  3234.  *
  3235.  * AliasCmdDeleteProc --
  3236.  *
  3237.  *    Is invoked when an alias command is deleted in a slave. Cleans up
  3238.  *    all storage associated with this alias.
  3239.  *
  3240.  * Results:
  3241.  *    None.
  3242.  *
  3243.  * Side effects:
  3244.  *    Deletes the alias record and its entry in the alias table for
  3245.  *    the interpreter.
  3246.  *
  3247.  *----------------------------------------------------------------------
  3248.  */
  3249.  
  3250. static void
  3251. AliasCmdDeleteProc(clientData)
  3252.     ClientData clientData;        /* The alias record for this alias. */
  3253. {
  3254.     Alias *aliasPtr;            /* Alias record for alias to delete. */
  3255.     Target *targetPtr;            /* Record for target of this alias. */
  3256.     int i;                /* Loop counter. */
  3257.  
  3258.     aliasPtr = (Alias *) clientData;
  3259.     
  3260.     targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
  3261.     ckfree((char *) targetPtr);
  3262.     Tcl_DeleteHashEntry(aliasPtr->targetEntry);
  3263.  
  3264.     ckfree((char *) aliasPtr->targetName);
  3265.     ckfree((char *) aliasPtr->aliasName);
  3266.     for (i = 0; i < aliasPtr->objc; i++) {
  3267.         Tcl_DecrRefCount(aliasPtr->objv[i]);
  3268.     }
  3269.     if (aliasPtr->objv != (Tcl_Obj **) NULL) {
  3270.         ckfree((char *) aliasPtr->objv);
  3271.     }
  3272.  
  3273.     Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
  3274.  
  3275.     ckfree((char *) aliasPtr);
  3276. }
  3277.  
  3278. /*
  3279.  *----------------------------------------------------------------------
  3280.  *
  3281.  * MasterRecordDeleteProc -
  3282.  *
  3283.  *    Is invoked when an interpreter (which is using the "interp" facility)
  3284.  *    is deleted, and it cleans up the storage associated with the
  3285.  *    "tclMasterRecord" assoc-data entry.
  3286.  *
  3287.  * Results:
  3288.  *    None.
  3289.  *
  3290.  * Side effects:
  3291.  *    Cleans up storage.
  3292.  *
  3293.  *----------------------------------------------------------------------
  3294.  */
  3295.  
  3296. static void
  3297. MasterRecordDeleteProc(clientData, interp)
  3298.     ClientData    clientData;        /* Master record for deleted interp. */
  3299.     Tcl_Interp *interp;            /* Interpreter being deleted. */
  3300. {
  3301.     Target *targetPtr;            /* Loop variable. */
  3302.     Tcl_HashEntry *hPtr;        /* Search element. */
  3303.     Tcl_HashSearch hSearch;        /* Search record (internal). */
  3304.     Slave *slavePtr;            /* Loop variable. */
  3305.     Master *masterPtr;            /* Interim storage. */
  3306.  
  3307.     masterPtr = (Master *) clientData;
  3308.     for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
  3309.          hPtr != NULL;
  3310.          hPtr = Tcl_NextHashEntry(&hSearch)) {
  3311.         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  3312.         (void) Tcl_DeleteCommandFromToken(interp, slavePtr->interpCmd);
  3313.     }
  3314.     Tcl_DeleteHashTable(&(masterPtr->slaveTable));
  3315.  
  3316.     for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
  3317.          hPtr != NULL;
  3318.          hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
  3319.         targetPtr = (Target *) Tcl_GetHashValue(hPtr);
  3320.         (void) Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
  3321.             targetPtr->slaveCmd);
  3322.     }
  3323.     Tcl_DeleteHashTable(&(masterPtr->targetTable));
  3324.  
  3325.     ckfree((char *) masterPtr);
  3326. }
  3327.  
  3328. /*
  3329.  *----------------------------------------------------------------------
  3330.  *
  3331.  * SlaveRecordDeleteProc --
  3332.  *
  3333.  *    Is invoked when an interpreter (which is using the interp facility)
  3334.  *    is deleted, and it cleans up the storage associated with the
  3335.  *    tclSlaveRecord assoc-data entry.
  3336.  *
  3337.  * Results:
  3338.  *    None
  3339.  *
  3340.  * Side effects:
  3341.  *    Cleans up storage.
  3342.  *
  3343.  *----------------------------------------------------------------------
  3344.  */
  3345.  
  3346. static void
  3347. SlaveRecordDeleteProc(clientData, interp)
  3348.     ClientData    clientData;        /* Slave record for deleted interp. */
  3349.     Tcl_Interp *interp;            /* Interpreter being deleted. */
  3350. {
  3351.     Slave *slavePtr;            /* Interim storage. */
  3352.     Alias *aliasPtr;
  3353.     Tcl_HashTable *hTblPtr;
  3354.     Tcl_HashEntry *hPtr;
  3355.     Tcl_HashSearch hSearch;
  3356.     
  3357.     slavePtr = (Slave *) clientData;
  3358.  
  3359.     /*
  3360.      * In every case that we call SetAssocData on "tclSlaveRecord",
  3361.      * slavePtr is not NULL. Otherwise we panic.
  3362.      */
  3363.  
  3364.     if (slavePtr == NULL) {
  3365.     panic("SlaveRecordDeleteProc: NULL slavePtr");
  3366.     }
  3367.  
  3368.     if (slavePtr->interpCmd != (Tcl_Command) NULL) {
  3369.     Command *cmdPtr = (Command *) slavePtr->interpCmd;
  3370.  
  3371.     /*
  3372.      * The interpCmd has not been deleted in the master yet,  since
  3373.      * it's callback sets interpCmd to NULL.
  3374.      *
  3375.      * Probably Tcl_DeleteInterp() was called on this interpreter directly,
  3376.      * rather than via "interp delete", or equivalent (deletion of the
  3377.      * command in the master).
  3378.      *
  3379.      * Perform the cleanup done by SlaveObjectDeleteProc() directly,
  3380.      * and turn off the callback now (since we are about to free slavePtr
  3381.      * and this interpreter is going away, while the deletion of commands
  3382.      * in the master may be deferred).
  3383.      */
  3384.  
  3385.     Tcl_DeleteHashEntry(slavePtr->slaveEntry);
  3386.     cmdPtr->clientData = NULL;
  3387.     cmdPtr->deleteProc = NULL;
  3388.     cmdPtr->deleteData = NULL;
  3389.  
  3390.         Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
  3391.             slavePtr->interpCmd);
  3392.     }
  3393.  
  3394.     /*
  3395.      * If there are any aliases, delete those now. This removes any
  3396.      * dependency on the order of deletion between commands and the
  3397.      * slave record.
  3398.      */
  3399.  
  3400.     hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
  3401.     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  3402.              hPtr != (Tcl_HashEntry *) NULL;
  3403.              hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
  3404.         aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  3405.  
  3406.         /*
  3407.          * The call to Tcl_DeleteCommand will release the storage
  3408.          * occupied by the hash entry and the alias record.
  3409.          */
  3410.  
  3411.         Tcl_DeleteCommandFromToken(interp, aliasPtr->slaveCmd);
  3412.     }
  3413.         
  3414.     /*
  3415.      * Finally dispose of the hash table and the slave record.
  3416.      */
  3417.  
  3418.     Tcl_DeleteHashTable(hTblPtr);
  3419.     ckfree((char *) slavePtr);    
  3420. }
  3421.  
  3422. /*
  3423.  *----------------------------------------------------------------------
  3424.  *
  3425.  * TclInterpInit --
  3426.  *
  3427.  *    Initializes the invoking interpreter for using the "interp"
  3428.  *    facility. This is called from inside Tcl_Init.
  3429.  *
  3430.  * Results:
  3431.  *    None.
  3432.  *
  3433.  * Side effects:
  3434.  *    Adds the "interp" command to an interpreter and initializes several
  3435.  *    records in the associated data of the invoking interpreter.
  3436.  *
  3437.  *----------------------------------------------------------------------
  3438.  */
  3439.  
  3440. int
  3441. TclInterpInit(interp)
  3442.     Tcl_Interp *interp;            /* Interpreter to initialize. */
  3443. {
  3444.     Master *masterPtr;            /* Its Master record. */
  3445.     Slave *slavePtr;            /* And its slave record. */
  3446.  
  3447.     masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
  3448.  
  3449.     Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
  3450.     Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);
  3451.  
  3452.     (void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
  3453.             (ClientData) masterPtr);
  3454.  
  3455.     slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
  3456.  
  3457.     slavePtr->masterInterp = (Tcl_Interp *) NULL;
  3458.     slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
  3459.     slavePtr->slaveInterp = interp;
  3460.     slavePtr->interpCmd = (Tcl_Command) NULL;
  3461.     Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
  3462.  
  3463.     (void) Tcl_SetAssocData(interp, "tclSlaveRecord", SlaveRecordDeleteProc,
  3464.             (ClientData) slavePtr);
  3465.     
  3466.     return TCL_OK;
  3467. }
  3468.  
  3469. /*
  3470.  *----------------------------------------------------------------------
  3471.  *
  3472.  * Tcl_IsSafe --
  3473.  *
  3474.  *    Determines whether an interpreter is safe
  3475.  *
  3476.  * Results:
  3477.  *    1 if it is safe, 0 if it is not.
  3478.  *
  3479.  * Side effects:
  3480.  *    None.
  3481.  *
  3482.  *----------------------------------------------------------------------
  3483.  */
  3484.  
  3485. int
  3486. Tcl_IsSafe(interp)
  3487.     Tcl_Interp *interp;        /* Is this interpreter "safe" ? */
  3488. {
  3489.     Interp *iPtr;
  3490.  
  3491.     if (interp == (Tcl_Interp *) NULL) {
  3492.         return 0;
  3493.     }
  3494.     iPtr = (Interp *) interp;
  3495.  
  3496.     return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
  3497. }
  3498.  
  3499. /*
  3500.  *----------------------------------------------------------------------
  3501.  *
  3502.  * Tcl_CreateSlave --
  3503.  *
  3504.  *    Creates a slave interpreter. The slavePath argument denotes the
  3505.  *    name of the new slave relative to the current interpreter; the
  3506.  *    slave is a direct descendant of the one-before-last component of
  3507.  *    the path, e.g. it is a descendant of the current interpreter if
  3508.  *    the slavePath argument contains only one component. Optionally makes
  3509.  *    the slave interpreter safe.
  3510.  *
  3511.  * Results:
  3512.  *    Returns the interpreter structure created, or NULL if an error
  3513.  *    occurred.
  3514.  *
  3515.  * Side effects:
  3516.  *    Creates a new interpreter and a new interpreter object command in
  3517.  *    the interpreter indicated by the slavePath argument.
  3518.  *
  3519.  *----------------------------------------------------------------------
  3520.  */
  3521.  
  3522. Tcl_Interp *
  3523. Tcl_CreateSlave(interp, slavePath, isSafe)
  3524.     Tcl_Interp *interp;        /* Interpreter to start search at. */
  3525.     char *slavePath;        /* Name of slave to create. */
  3526.     int isSafe;            /* Should new slave be "safe" ? */
  3527. {
  3528.     Master *masterPtr;            /* Master record for same. */
  3529.  
  3530.     if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
  3531.         return NULL;
  3532.     }
  3533.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
  3534.             NULL); 
  3535.     if (masterPtr == (Master *) NULL) {
  3536.         panic("CreatSlave: could not find master record");
  3537.     }
  3538.     return CreateSlave(interp, masterPtr, slavePath, isSafe);
  3539. }
  3540.  
  3541. /*
  3542.  *----------------------------------------------------------------------
  3543.  *
  3544.  * Tcl_GetSlave --
  3545.  *
  3546.  *    Finds a slave interpreter by its path name.
  3547.  *
  3548.  * Results:
  3549.  *    Returns a Tcl_Interp * for the named interpreter or NULL if not
  3550.  *    found.
  3551.  *
  3552.  * Side effects:
  3553.  *    None.
  3554.  *
  3555.  *----------------------------------------------------------------------
  3556.  */
  3557.  
  3558. Tcl_Interp *
  3559. Tcl_GetSlave(interp, slavePath)
  3560.     Tcl_Interp *interp;        /* Interpreter to start search from. */
  3561.     char *slavePath;        /* Path of slave to find. */
  3562. {
  3563.     Master *masterPtr;        /* Interim storage for Master record. */
  3564.  
  3565.     if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
  3566.         return NULL;
  3567.     }
  3568.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  3569.     if (masterPtr == (Master *) NULL) {
  3570.         panic("Tcl_GetSlave: could not find master record");
  3571.     }
  3572.     return GetInterp(interp, masterPtr, slavePath, NULL);
  3573. }
  3574.  
  3575. /*
  3576.  *----------------------------------------------------------------------
  3577.  *
  3578.  * Tcl_GetMaster --
  3579.  *
  3580.  *    Finds the master interpreter of a slave interpreter.
  3581.  *
  3582.  * Results:
  3583.  *    Returns a Tcl_Interp * for the master interpreter or NULL if none.
  3584.  *
  3585.  * Side effects:
  3586.  *    None.
  3587.  *
  3588.  *----------------------------------------------------------------------
  3589.  */
  3590.  
  3591. Tcl_Interp *
  3592. Tcl_GetMaster(interp)
  3593.     Tcl_Interp *interp;        /* Get the master of this interpreter. */
  3594. {
  3595.     Slave *slavePtr;        /* Slave record of this interpreter. */
  3596.  
  3597.     if (interp == (Tcl_Interp *) NULL) {
  3598.         return NULL;
  3599.     }
  3600.     slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
  3601.     if (slavePtr == (Slave *) NULL) {
  3602.         return NULL;
  3603.     }
  3604.     return slavePtr->masterInterp;
  3605. }
  3606.  
  3607. /*
  3608.  *----------------------------------------------------------------------
  3609.  *
  3610.  * Tcl_CreateAlias --
  3611.  *
  3612.  *    Creates an alias between two interpreters.
  3613.  *
  3614.  * Results:
  3615.  *    A standard Tcl result.
  3616.  *
  3617.  * Side effects:
  3618.  *    Creates a new alias, manipulates the result field of slaveInterp.
  3619.  *
  3620.  *----------------------------------------------------------------------
  3621.  */
  3622.  
  3623. int
  3624. Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
  3625.     Tcl_Interp *slaveInterp;        /* Interpreter for source command. */
  3626.     char *slaveCmd;            /* Command to install in slave. */
  3627.     Tcl_Interp *targetInterp;        /* Interpreter for target command. */
  3628.     char *targetCmd;            /* Name of target command. */
  3629.     int argc;                /* How many additional arguments? */
  3630.     char **argv;            /* These are the additional args. */
  3631. {
  3632.     Master *masterPtr;            /* Master record for target interp. */
  3633.     Tcl_Obj **objv;
  3634.     int i;
  3635.     int result;
  3636.     
  3637.     if ((slaveInterp == (Tcl_Interp *) NULL) ||
  3638.             (targetInterp == (Tcl_Interp *) NULL) ||
  3639.             (slaveCmd == (char *) NULL) ||
  3640.             (targetCmd == (char *) NULL)) {
  3641.         return TCL_ERROR;
  3642.     }
  3643.     masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
  3644.             NULL);
  3645.     if (masterPtr == (Master *) NULL) {
  3646.         panic("Tcl_CreateAlias: could not find master record");
  3647.     }
  3648.     objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
  3649.     for (i = 0; i < argc; i++) {
  3650.         objv[i] = Tcl_NewStringObj(argv[i], -1);
  3651.         Tcl_IncrRefCount(objv[i]);
  3652.     }
  3653.     
  3654.     result = AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
  3655.             masterPtr, slaveCmd, targetCmd, argc, objv);
  3656.  
  3657.     ckfree((char *) objv);
  3658.  
  3659.     return result;
  3660. }
  3661.  
  3662. /*
  3663.  *----------------------------------------------------------------------
  3664.  *
  3665.  * Tcl_CreateAliasObj --
  3666.  *
  3667.  *    Object version: Creates an alias between two interpreters.
  3668.  *
  3669.  * Results:
  3670.  *    A standard Tcl result.
  3671.  *
  3672.  * Side effects:
  3673.  *    Creates a new alias.
  3674.  *
  3675.  *----------------------------------------------------------------------
  3676.  */
  3677.  
  3678. int
  3679. Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
  3680.     Tcl_Interp *slaveInterp;        /* Interpreter for source command. */
  3681.     char *slaveCmd;            /* Command to install in slave. */
  3682.     Tcl_Interp *targetInterp;        /* Interpreter for target command. */
  3683.     char *targetCmd;            /* Name of target command. */
  3684.     int objc;                /* How many additional arguments? */
  3685.     Tcl_Obj *CONST objv[];        /* Argument vector. */
  3686. {
  3687.     Master *masterPtr;            /* Master record for target interp. */
  3688.  
  3689.     if ((slaveInterp == (Tcl_Interp *) NULL) ||
  3690.             (targetInterp == (Tcl_Interp *) NULL) ||
  3691.             (slaveCmd == (char *) NULL) ||
  3692.             (targetCmd == (char *) NULL)) {
  3693.         return TCL_ERROR;
  3694.     }
  3695.     masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
  3696.             NULL);
  3697.     if (masterPtr == (Master *) NULL) {
  3698.         panic("Tcl_CreateAlias: could not find master record");
  3699.     }
  3700.     return AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
  3701.             masterPtr, slaveCmd, targetCmd, objc, objv);
  3702. }
  3703.  
  3704. /*
  3705.  *----------------------------------------------------------------------
  3706.  *
  3707.  * Tcl_GetAlias --
  3708.  *
  3709.  *    Gets information about an alias.
  3710.  *
  3711.  * Results:
  3712.  *    A standard Tcl result. 
  3713.  *
  3714.  * Side effects:
  3715.  *    None.
  3716.  *
  3717.  *----------------------------------------------------------------------
  3718.  */
  3719.  
  3720. int
  3721. Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
  3722.         argvPtr)
  3723.     Tcl_Interp *interp;            /* Interp to start search from. */
  3724.     char *aliasName;            /* Name of alias to find. */
  3725.     Tcl_Interp **targetInterpPtr;    /* (Return) target interpreter. */
  3726.     char **targetNamePtr;        /* (Return) name of target command. */
  3727.     int *argcPtr;            /* (Return) count of addnl args. */
  3728.     char ***argvPtr;            /* (Return) additional arguments. */
  3729. {
  3730.     Slave *slavePtr;            /* Slave record for slave interp. */
  3731.     Tcl_HashEntry *hPtr;        /* Search element. */
  3732.     Alias *aliasPtr;            /* Storage for alias found. */
  3733.     int len;
  3734.     int i;
  3735.  
  3736.     if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
  3737.         return TCL_ERROR;
  3738.     }
  3739.     slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
  3740.     if (slavePtr == (Slave *) NULL) {
  3741.         panic("Tcl_GetAlias: could not find slave record");
  3742.     }
  3743.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  3744.     if (hPtr == (Tcl_HashEntry *) NULL) {
  3745.         Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
  3746.                 (char *) NULL);
  3747.         return TCL_ERROR;
  3748.     }
  3749.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  3750.     if (targetInterpPtr != (Tcl_Interp **) NULL) {
  3751.         *targetInterpPtr = aliasPtr->targetInterp;
  3752.     }
  3753.     if (targetNamePtr != (char **) NULL) {
  3754.         *targetNamePtr = aliasPtr->targetName;
  3755.     }
  3756.     if (argcPtr != (int *) NULL) {
  3757.         *argcPtr = aliasPtr->objc;
  3758.     }
  3759.     if (argvPtr != (char ***) NULL) {
  3760.         *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) *
  3761.                 aliasPtr->objc);
  3762.         for (i = 0; i < aliasPtr->objc; i++) {
  3763.             *argvPtr[i] = Tcl_GetStringFromObj(aliasPtr->objv[i], &len);
  3764.         }
  3765.     }
  3766.     return TCL_OK;
  3767. }
  3768.  
  3769. /*
  3770.  *----------------------------------------------------------------------
  3771.  *
  3772.  * Tcl_ObjGetAlias --
  3773.  *
  3774.  *    Object version: Gets information about an alias.
  3775.  *
  3776.  * Results:
  3777.  *    A standard Tcl result.
  3778.  *
  3779.  * Side effects:
  3780.  *    None.
  3781.  *
  3782.  *----------------------------------------------------------------------
  3783.  */
  3784.  
  3785. int
  3786. Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
  3787.         objvPtr)
  3788.     Tcl_Interp *interp;            /* Interp to start search from. */
  3789.     char *aliasName;            /* Name of alias to find. */
  3790.     Tcl_Interp **targetInterpPtr;    /* (Return) target interpreter. */
  3791.     char **targetNamePtr;        /* (Return) name of target command. */
  3792.     int *objcPtr;            /* (Return) count of addnl args. */
  3793.     Tcl_Obj ***objvPtr;            /* (Return) additional args. */
  3794. {
  3795.     Slave *slavePtr;            /* Slave record for slave interp. */
  3796.     Tcl_HashEntry *hPtr;        /* Search element. */
  3797.     Alias *aliasPtr;            /* Storage for alias found. */
  3798.  
  3799.     if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
  3800.         return TCL_ERROR;
  3801.     }
  3802.     slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
  3803.     if (slavePtr == (Slave *) NULL) {
  3804.         panic("Tcl_GetAlias: could not find slave record");
  3805.     }
  3806.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  3807.     if (hPtr == (Tcl_HashEntry *) NULL) {
  3808.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  3809.                 "alias \"", aliasName, "\" not found", (char *) NULL);
  3810.         return TCL_ERROR;
  3811.     }
  3812.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  3813.     if (targetInterpPtr != (Tcl_Interp **) NULL) {
  3814.         *targetInterpPtr = aliasPtr->targetInterp;
  3815.     }
  3816.     if (targetNamePtr != (char **) NULL) {
  3817.         *targetNamePtr = aliasPtr->targetName;
  3818.     }
  3819.     if (objcPtr != (int *) NULL) {
  3820.         *objcPtr = aliasPtr->objc;
  3821.     }
  3822.     if (objvPtr != (Tcl_Obj ***) NULL) {
  3823.         *objvPtr = aliasPtr->objv;
  3824.     }
  3825.     return TCL_OK;
  3826. }
  3827.