home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclInterp.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  83KB  |  2,386 lines
  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 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.66 96/04/15 17:26:10
  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        argc;        /* Count of additional args to pass. */
  61.     char    **argv;        /* 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 three 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). The third field in
  103.  * the record, isSafe, denotes whether the interpreter is safe or not. Safe
  104.  * interpreters have restricted functionality, can only create safe slave
  105.  * interpreters and can only load safe extensions.
  106.  */
  107.  
  108. typedef struct {
  109.     Tcl_HashTable slaveTable;    /* Hash table for slave interpreters.
  110.                                  * Maps from command names to Slave records. */
  111.     int isSafe;            /* Am I a "safe" interpreter? */
  112.     Tcl_HashTable targetTable;    /* Hash table for Target Records. Contains
  113.                                  * all Target records which denote aliases
  114.                                  * from slaves or sibling interpreters that
  115.                                  * direct to commands in this interpreter. This
  116.                                  * table is used to remove dangling pointers
  117.                                  * from the slave (or sibling) interpreters
  118.                                  * when this interpreter is deleted. */
  119. } Master;
  120.  
  121. /*
  122.  * Prototypes for local static procedures:
  123.  */
  124.  
  125. static int        AliasCmd _ANSI_ARGS_((ClientData dummy,
  126.                 Tcl_Interp *currentInterp, int argc, char **argv));
  127. static void        AliasCmdDeleteProc _ANSI_ARGS_((
  128.                 ClientData clientData));
  129. static int        AliasHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
  130.                 Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
  131.                 Master *masterPtr, char *aliasName,
  132.                 char *targetName, int argc, char **argv));
  133. static int        CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  134.                int argc, char **argv));
  135. static Tcl_Interp    *CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
  136.                 char *slavePath, int safe));
  137. static int        DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
  138.                 Tcl_Interp *slaveInterp, char *aliasName));
  139. static int        DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
  140.                 Tcl_Interp *slaveInterp, char *aliasName));
  141. static int        DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  142.                 int argc, char **argv));
  143. static int        DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
  144.                     char *path));
  145. static Tcl_Interp    *GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
  146.                 Master *masterPtr, char *path,
  147.                 Master **masterPtrPtr));
  148. static int        GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
  149.                 char *aliasName));
  150. static void        MasterRecordDeleteProc _ANSI_ARGS_((
  151.                 ClientData clientData, Tcl_Interp *interp));
  152. static int        MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
  153. static int        SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
  154.                 int argc, char **argv));
  155. static int        SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
  156.                 Tcl_Interp *interp, int argc, char **argv));
  157. static void        SlaveObjectDeleteProc _ANSI_ARGS_((
  158.                 ClientData clientData));
  159. static void        SlaveRecordDeleteProc _ANSI_ARGS_((
  160.                 ClientData clientData, Tcl_Interp *interp));
  161.  
  162. /*
  163.  * These are all the Tcl core commands which are available in a safe
  164.  * interpeter:
  165.  */
  166.  
  167. static char *TclCommandsToKeep[] = {
  168.     "after", "append", "array",
  169.     "break",
  170.     "case", "catch", "clock", "close", "concat", "continue",
  171.     "eof", "error", "eval", "expr",
  172.     "fblocked", "fconfigure", "flush", "for", "foreach", "format",
  173.     "gets", "global",
  174.     "history",
  175.     "if", "incr", "info", "interp",
  176.     "join",
  177.     "lappend", "lindex", "linsert", "list", "llength", "lower", "lrange",
  178.     "lreplace", "lsearch", "lsort",
  179.     "package", "pid", "proc", "puts",
  180.     "read", "regexp", "regsub", "rename", "return",
  181.     "scan", "seek", "set", "split", "string", "switch",
  182.     "tell", "trace",
  183.     "unset", "update", "uplevel", "upvar",
  184.     "vwait",
  185.     "while",
  186.     NULL};
  187. static int TclCommandsToKeepCt =
  188.     (sizeof (TclCommandsToKeep) / sizeof (char *)) -1 ;
  189.  
  190. /*
  191.  *----------------------------------------------------------------------
  192.  *
  193.  * TclPreventAliasLoop --
  194.  *
  195.  *    When defining an alias or renaming a command, prevent an alias
  196.  *    loop from being formed.
  197.  *
  198.  * Results:
  199.  *    A standard Tcl result.
  200.  *
  201.  * Side effects:
  202.  *    If TCL_ERROR is returned, the function also sets interp->result
  203.  *    to an error message.
  204.  *
  205.  * NOTE:
  206.  *    This function is public internal (instead of being static to
  207.  *    this file) because it is also used from Tcl_RenameCmd.
  208.  *
  209.  *----------------------------------------------------------------------
  210.  */
  211.  
  212. int
  213. TclPreventAliasLoop(interp, cmdInterp, cmdName, proc, clientData)
  214.     Tcl_Interp *interp;            /* Interp in which to report errors. */
  215.     Tcl_Interp *cmdInterp;        /* Interp in which the command is
  216.                                          * being defined. */
  217.     char *cmdName;            /* Name of Tcl command we are
  218.                                          * attempting to define. */
  219.     Tcl_CmdProc *proc;            /* The command procedure for the
  220.                                          * command being created. */
  221.     ClientData clientData;        /* The client data associated with the
  222.                                          * command to be created. */
  223. {
  224.     Alias *aliasPtr, *nextAliasPtr;
  225.     Tcl_CmdInfo cmdInfo;
  226.     
  227.     /*
  228.      * If we are not creating or renaming an alias, then it is
  229.      * always OK to create or rename the command.
  230.      */
  231.     
  232.     if (proc != AliasCmd) {
  233.         return TCL_OK;
  234.     }
  235.  
  236.     /*
  237.      * OK, we are dealing with an alias, so traverse the chain of aliases.
  238.      * If we encounter the alias we are defining (or renaming to) any in
  239.      * the chain then we have a loop.
  240.      */
  241.  
  242.     aliasPtr = (Alias *) clientData;
  243.     nextAliasPtr = aliasPtr;
  244.     while (1) {
  245.  
  246.         /*
  247.          * If the target of the next alias in the chain is the same as the
  248.          * source alias, we have a loop.
  249.          */
  250.         
  251.         if ((strcmp(nextAliasPtr->targetName, cmdName) == 0) &&
  252.                 (nextAliasPtr->targetInterp == cmdInterp)) {
  253.             Tcl_AppendResult(interp, "cannot define or rename alias \"",
  254.                     aliasPtr->aliasName, "\": would create a loop",
  255.                     (char *) NULL);
  256.             return TCL_ERROR;
  257.         }
  258.  
  259.         /*
  260.          * Otherwise, follow the chain one step further. If the target
  261.          * command is undefined then there is no loop.
  262.          */
  263.         
  264.         if (Tcl_GetCommandInfo(nextAliasPtr->targetInterp,
  265.                 nextAliasPtr->targetName, &cmdInfo) == 0) {
  266.             return TCL_OK;
  267.         }
  268.  
  269.         /*
  270.          * See if the target command is an alias - if so, follow the
  271.          * loop to its target command. Otherwise we do not have a loop.
  272.          */
  273.  
  274.         if (cmdInfo.proc != AliasCmd) {
  275.             return TCL_OK;
  276.         }
  277.         nextAliasPtr = (Alias *) cmdInfo.clientData;
  278.     }
  279.  
  280.     /* NOTREACHED */
  281. }
  282.  
  283. /*
  284.  *----------------------------------------------------------------------
  285.  *
  286.  * MakeSafe --
  287.  *
  288.  *    Makes its argument interpreter contain only functionality that is
  289.  *    defined to be part of Safe Tcl.
  290.  *
  291.  * Results:
  292.  *    None.
  293.  *
  294.  * Side effects:
  295.  *    Removes commands from its argument interpreter.
  296.  *
  297.  *----------------------------------------------------------------------
  298.  */
  299.  
  300. static int
  301. MakeSafe(interp)
  302.     Tcl_Interp *interp;        /* Interpreter to be made safe. */
  303. {
  304.     char **argv;                /* Args for Tcl_Eval. */
  305.     int argc, keep, i, j;            /* Loop indices. */
  306.     char *cmdGetGlobalCmds = "info commands";    /* What command to run. */
  307.     char *cmdNoEnv = "unset env";        /* How to get rid of env. */
  308.     Master *masterPtr;                /* Master record of interp
  309.                                                  * to be made safe. */
  310.     Tcl_Channel chan;                /* Channel to remove from
  311.                                                  * safe interpreter. */
  312.  
  313.     /*
  314.      * Below, Tcl_Eval sets interp->result, so we do not.
  315.      */
  316.  
  317.     Tcl_ResetResult(interp);
  318.     if ((Tcl_Eval(interp, cmdGetGlobalCmds) == TCL_ERROR) ||
  319.             (Tcl_SplitList(interp, interp->result, &argc, &argv) != TCL_OK)) {
  320.         return TCL_ERROR;
  321.     }
  322.     for (i = 0; i < argc; i++) {
  323.         for (keep = 0, j = 0; j < TclCommandsToKeepCt; j++) {
  324.             if (strcmp(TclCommandsToKeep[j], argv[i]) == 0) {
  325.                 keep = 1;
  326.                 break;
  327.             }
  328.         }
  329.         if (keep == 0) {
  330.             (void) Tcl_DeleteCommand(interp, argv[i]);
  331.         }
  332.     }
  333.     ckfree((char *) argv);
  334.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
  335.             NULL);
  336.     if (masterPtr == (Master *) NULL) {
  337.         panic("MakeSafe: could not find master record");
  338.     }
  339.     masterPtr->isSafe = 1;
  340.     if (Tcl_Eval(interp, cmdNoEnv) == TCL_ERROR) {
  341.         return TCL_ERROR;
  342.     }
  343.  
  344.     /*
  345.      * Remove the standard channels from the interpreter; safe interpreters
  346.      * do not ordinarily have access to stdin, stdout and stderr.
  347.      */
  348.  
  349.     chan = Tcl_GetStdChannel(TCL_STDIN);
  350.     if (chan != (Tcl_Channel) NULL) {
  351.         Tcl_UnregisterChannel(interp, chan);
  352.     }
  353.     chan = Tcl_GetStdChannel(TCL_STDOUT);
  354.     if (chan != (Tcl_Channel) NULL) {
  355.         Tcl_UnregisterChannel(interp, chan);
  356.     }
  357.     chan = Tcl_GetStdChannel(TCL_STDERR);
  358.     if (chan != (Tcl_Channel) NULL) {
  359.         Tcl_UnregisterChannel(interp, chan);
  360.     }
  361.  
  362.     return TCL_OK;
  363. }
  364.  
  365. /*
  366.  *----------------------------------------------------------------------
  367.  *
  368.  * GetInterp --
  369.  *
  370.  *    Helper function to find a slave interpreter given a pathname.
  371.  *
  372.  * Results:
  373.  *    Returns the slave interpreter known by that name in the calling
  374.  *    interpreter, or NULL if no interpreter known by that name exists. 
  375.  *
  376.  * Side effects:
  377.  *    Assigns to the pointer variable passed in, if not NULL.
  378.  *
  379.  *----------------------------------------------------------------------
  380.  */
  381.  
  382. static Tcl_Interp *
  383. GetInterp(interp, masterPtr, path, masterPtrPtr)
  384.     Tcl_Interp *interp;        /* Interp. to start search from. */
  385.     Master *masterPtr;        /* Its master record. */
  386.     char *path;            /* The path (name) of interp. to be found. */
  387.     Master **masterPtrPtr;    /* (Return) its master record. */
  388. {
  389.     Tcl_HashEntry *hPtr;    /* Search element. */
  390.     Slave *slavePtr;        /* Interim slave record. */
  391.     char **argv;        /* Split-up path (name) for interp to find. */
  392.     int argc, i;        /* Loop indices. */
  393.     Tcl_Interp *searchInterp;    /* Interim storage for interp. to find. */
  394.  
  395.     if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
  396.     
  397.     if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
  398.         return (Tcl_Interp *) NULL;
  399.     }
  400.  
  401.     for (searchInterp = interp, i = 0; i < argc; i++) {
  402.         
  403.         hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
  404.         if (hPtr == (Tcl_HashEntry *) NULL) {
  405.             ckfree((char *) argv);
  406.             return (Tcl_Interp *) NULL;
  407.         }
  408.         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  409.         searchInterp = slavePtr->slaveInterp;
  410.         if (searchInterp == (Tcl_Interp *) NULL) {
  411.             ckfree((char *) argv);
  412.             return (Tcl_Interp *) NULL;
  413.         }
  414.         masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
  415.                 "tclMasterRecord", NULL);
  416.         if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
  417.         if (masterPtr == (Master *) NULL) {
  418.             ckfree((char *) argv);
  419.             return (Tcl_Interp *) NULL;
  420.         }
  421.     }
  422.     ckfree((char *) argv);
  423.     return searchInterp;
  424. }
  425.  
  426. /*
  427.  *----------------------------------------------------------------------
  428.  *
  429.  * CreateSlave --
  430.  *
  431.  *    Helper function to do the actual work of creating a slave interp
  432.  *    and new object command. Also optionally makes the new slave
  433.  *    interpreter "safe".
  434.  *
  435.  * Results:
  436.  *    Returns the new Tcl_Interp * if successful or NULL if not. If failed,
  437.  *    the result of the invoking interpreter contains an error message.
  438.  *
  439.  * Side effects:
  440.  *    Creates a new slave interpreter and a new object command.
  441.  *
  442.  *----------------------------------------------------------------------
  443.  */
  444.  
  445. static Tcl_Interp *
  446. CreateSlave(interp, slavePath, safe)
  447.     Tcl_Interp *interp;            /* Interp. to start search from. */
  448.     char *slavePath;            /* Path (name) of slave to create. */
  449.     int safe;                /* Should we make it "safe"? */
  450. {
  451.     Master *masterPtr;            /* Master record. */
  452.     Tcl_Interp *slaveInterp;        /* Ptr to slave interpreter. */
  453.     Tcl_Interp *masterInterp;        /* Ptr to master interp for slave. */
  454.     Slave *slavePtr;            /* Slave record. */
  455.     Tcl_HashEntry *hPtr;        /* Entry into interp hashtable. */
  456.     int new;                /* Indicates whether new entry. */
  457.     int argc;                /* Count of elements in slavePath. */
  458.     char **argv;            /* Elements in slavePath. */
  459.     char *masterPath;            /* Path to its master. */
  460.  
  461.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
  462.             NULL); 
  463.     if (masterPtr == (Master *) NULL) {
  464.         panic("CreatSlave: could not find master record");
  465.     }
  466.  
  467.     if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
  468.         return (Tcl_Interp *) NULL;
  469.     }
  470.  
  471.     if (argc < 2) {
  472.         masterInterp = interp;
  473.         if (argc == 1) {
  474.             slavePath = argv[0];
  475.         }
  476.     } else {
  477.         masterPath = Tcl_Merge(argc-1, argv);
  478.         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
  479.         if (masterInterp == (Tcl_Interp *) NULL) {
  480.             Tcl_AppendResult(interp, "interpreter named \"", masterPath,
  481.                     "\" not found", (char *) NULL);
  482.             ckfree((char *) argv);
  483.             ckfree((char *) masterPath);
  484.             return (Tcl_Interp *) NULL;
  485.         }
  486.         ckfree((char *) masterPath);
  487.         slavePath = argv[argc-1];
  488.         if (!safe) {
  489.             safe = masterPtr->isSafe;
  490.         }
  491.     }
  492.     hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
  493.     if (new == 0) {
  494.         Tcl_AppendResult(interp, "interpreter named \"", slavePath,
  495.                 "\" already exists, cannot create", (char *) NULL);
  496.         ckfree((char *) argv);
  497.         return (Tcl_Interp *) NULL;
  498.     }
  499.     slaveInterp = Tcl_CreateInterp();
  500.     if (slaveInterp == (Tcl_Interp *) NULL) {
  501.         panic("CreateSlave: out of memory while creating a new interpreter");
  502.     }
  503.     slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
  504.     slavePtr->masterInterp = masterInterp;
  505.     slavePtr->slaveEntry = hPtr;
  506.     slavePtr->slaveInterp = slaveInterp;
  507.     slavePtr->interpCmd = Tcl_CreateCommand(masterInterp, slavePath,
  508.             SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
  509.     Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
  510.     (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
  511.             SlaveRecordDeleteProc, (ClientData) slavePtr);
  512.     Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
  513.     Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
  514.     
  515.     if (((safe) && (MakeSafe(slaveInterp) == TCL_ERROR)) ||
  516.             ((!safe) && (Tcl_Init(slaveInterp) == TCL_ERROR))) {
  517.         Tcl_ResetResult(interp);
  518.         Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
  519.                 NULL, TCL_GLOBAL_ONLY));
  520.         Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  521.                 Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
  522.                         TCL_GLOBAL_ONLY),
  523.                 TCL_GLOBAL_ONLY);
  524.         if (slaveInterp->freeProc != NULL) {
  525.             interp->result = slaveInterp->result;
  526.             interp->freeProc = slaveInterp->freeProc;
  527.             slaveInterp->freeProc = 0;
  528.         } else {
  529.             Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
  530.         }
  531.         Tcl_ResetResult(slaveInterp);
  532.         (void) Tcl_DeleteCommand(masterInterp, slavePath);
  533.         slaveInterp = (Tcl_Interp *) NULL;
  534.     }
  535.     ckfree((char *) argv);
  536.     return slaveInterp;
  537. }
  538.  
  539. /*
  540.  *----------------------------------------------------------------------
  541.  *
  542.  * CreateInterpObject -
  543.  *
  544.  *    Helper function to do the actual work of creating a new interpreter
  545.  *    and an object command. 
  546.  *
  547.  * Results:
  548.  *    A Tcl result.
  549.  *
  550.  * Side effects:
  551.  *    See user documentation for details.
  552.  *
  553.  *----------------------------------------------------------------------
  554.  */
  555.  
  556. static int
  557. CreateInterpObject(interp, argc, argv)
  558.     Tcl_Interp *interp;            /* Invoking interpreter. */
  559.     int argc;                /* Number of arguments. */
  560.     char **argv;            /* Argument strings. */
  561. {
  562.     int safe;                /* Create a safe interpreter? */
  563.     Master *masterPtr;            /* Master record. */
  564.     int moreFlags;            /* Expecting more flag args? */
  565.     char *slavePath;            /* Name of slave. */
  566.     char localSlaveName[200];        /* Local area for creating names. */
  567.     int i;                /* Loop counter. */
  568.     size_t len;                /* Length of option argument. */
  569.     static int interpCounter = 0;    /* Unique id for created names. */
  570.  
  571.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL); 
  572.     if (masterPtr == (Master *) NULL) {
  573.         panic("CreateInterpObject: could not find master record");
  574.     }
  575.     moreFlags = 1;
  576.     slavePath = NULL;
  577.     safe = masterPtr->isSafe;
  578.     
  579.     if (argc < 2 || argc > 5) {
  580.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  581.                 " create ?-safe? ?--? ?path?\"", (char *) NULL);
  582.         return TCL_ERROR;
  583.     }
  584.     for (i = 2; i < argc; i++) {
  585.         len = strlen(argv[i]);
  586.         if ((argv[i][0] == '-') && (moreFlags != 0)) {
  587.             if ((argv[i][1] == 's') && (strncmp(argv[i], "-safe", len) == 0)
  588.                 && (len > 1)){
  589.                 safe = 1;
  590.             } else if ((strncmp(argv[i], "--", len) == 0) && (len > 1)) {
  591.                 moreFlags = 0;
  592.             } else {
  593.                 Tcl_AppendResult(interp, "bad option \"", argv[i],
  594.                         "\": should be -safe", (char *) NULL);
  595.                 return TCL_ERROR;
  596.             }
  597.         } else {
  598.             slavePath = argv[i];
  599.         }
  600.     }
  601.     if (slavePath == (char *) NULL) {
  602.         sprintf(localSlaveName, "interp%d", interpCounter);
  603.         interpCounter++;
  604.         slavePath = localSlaveName;
  605.     }
  606.     if (CreateSlave(interp, slavePath, safe) != NULL) {
  607.         Tcl_AppendResult(interp, slavePath, (char *) NULL);
  608.         return TCL_OK;
  609.     } else {
  610.         /*
  611.          * CreateSlave already set interp->result if there was an error,
  612.          * so we do not do it here.
  613.          */
  614.         return TCL_ERROR;
  615.     }
  616. }
  617.  
  618. /*
  619.  *----------------------------------------------------------------------
  620.  *
  621.  * DeleteOneInterpObject --
  622.  *
  623.  *    Helper function for DeleteInterpObject. It deals with deleting one
  624.  *    interpreter at a time.
  625.  *
  626.  * Results:
  627.  *    A standard Tcl result.
  628.  *
  629.  * Side effects:
  630.  *    Deletes an interpreter and its interpreter object command.
  631.  *
  632.  *----------------------------------------------------------------------
  633.  */
  634.  
  635. static int
  636. DeleteOneInterpObject(interp, path)
  637.     Tcl_Interp *interp;            /* Interpreter for reporting errors. */
  638.     char *path;                /* Path of interpreter to delete. */
  639. {
  640.     Master *masterPtr;            /* Interim storage for master record.*/
  641.     Slave *slavePtr;            /* Interim storage for slave record. */
  642.     Tcl_Interp *masterInterp;        /* Master of interp. to delete. */
  643.     Tcl_HashEntry *hPtr;        /* Search element. */
  644.     int localArgc;            /* Local copy of count of elements in
  645.                                          * path (name) of interp. to delete. */
  646.     char **localArgv;            /* Local copy of path. */
  647.     char *slaveName;            /* Last component in path. */
  648.     char *masterPath;            /* One-before-last component in path.*/
  649.  
  650.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  651.     if (masterPtr == (Master *) NULL) {
  652.         panic("DeleteInterpObject: could not find master record");
  653.     }
  654.     if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
  655.         Tcl_AppendResult(interp, "bad interpreter path \"", path,
  656.                 "\"", (char *) NULL);
  657.         return TCL_ERROR;
  658.     }
  659.     if (localArgc < 2) {
  660.         masterInterp = interp;
  661.         if (localArgc == 0) {
  662.             slaveName = "";
  663.         } else {
  664.             slaveName = localArgv[0];
  665.         }
  666.     } else {
  667.         masterPath = Tcl_Merge(localArgc-1, localArgv);
  668.         masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
  669.         if (masterInterp == (Tcl_Interp *) NULL) {
  670.             Tcl_AppendResult(interp, "interpreter named \"", masterPath,
  671.                     "\" not found", (char *) NULL);
  672.             ckfree((char *) localArgv);
  673.             ckfree((char *) masterPath);
  674.             return TCL_ERROR;
  675.         }
  676.         ckfree((char *) masterPath);
  677.         slaveName = localArgv[localArgc-1];
  678.     }
  679.     hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
  680.     if (hPtr == (Tcl_HashEntry *) NULL) {
  681.         ckfree((char *) localArgv);
  682.         Tcl_AppendResult(interp, "interpreter named \"", path,
  683.                 "\" not found", (char *) NULL);
  684.         return TCL_ERROR;
  685.     }
  686.     slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  687.     slaveName = Tcl_GetCommandName(masterInterp, slavePtr->interpCmd);
  688.     if (Tcl_DeleteCommand(masterInterp, slaveName) != 0) {
  689.         ckfree((char *) localArgv);
  690.         Tcl_AppendResult(interp, "interpreter named \"", path,
  691.                 "\" not found", (char *) NULL);
  692.         return TCL_ERROR;
  693.     }
  694.     ckfree((char *) localArgv);
  695.     return TCL_OK;
  696. }
  697.  
  698. /*
  699.  *----------------------------------------------------------------------
  700.  *
  701.  * DeleteInterpObject --
  702.  *
  703.  *    Helper function to do the work of deleting zero or more
  704.  *    interpreters and their interpreter object commands.
  705.  *
  706.  * Results:
  707.  *    A standard Tcl result.
  708.  *
  709.  * Side effects:
  710.  *    Deletes interpreters and their interpreter object command.
  711.  *
  712.  *----------------------------------------------------------------------
  713.  */
  714.  
  715. static int
  716. DeleteInterpObject(interp, argc, argv)
  717.     Tcl_Interp *interp;            /* Interpreter start search from. */
  718.     int argc;                /* Number of arguments in vector. */
  719.     char **argv;            /* Contains path to interps to
  720.                                          * delete. */
  721. {
  722.     int i;
  723.     
  724.     for (i = 2; i < argc; i++) {
  725.         if (DeleteOneInterpObject(interp, argv[i]) != TCL_OK) {
  726.             return TCL_ERROR;
  727.         }
  728.     }
  729.     return TCL_OK;
  730. }
  731.  
  732. /*
  733.  *----------------------------------------------------------------------
  734.  *
  735.  * AliasHelper --
  736.  *
  737.  *    Helper function to do the work to actually create an alias or
  738.  *    delete an alias.
  739.  *
  740.  * Results:
  741.  *    A standard Tcl result.
  742.  *
  743.  * Side effects:
  744.  *    An alias command is created and entered into the alias table
  745.  *    for the slave interpreter.
  746.  *
  747.  *----------------------------------------------------------------------
  748.  */
  749.  
  750. static int
  751. AliasHelper(curInterp, slaveInterp, masterInterp, masterPtr,
  752.      aliasName, targetName, argc, argv)
  753.     Tcl_Interp *curInterp;        /* Interp that invoked this proc. */
  754.     Tcl_Interp *slaveInterp;        /* Interp where alias cmd will live
  755.                                          * or from which alias will be
  756.                                          * deleted. */
  757.     Tcl_Interp *masterInterp;        /* Interp where target cmd will be. */
  758.     Master *masterPtr;            /* Master record for target interp. */
  759.     char *aliasName;            /* Name of alias cmd. */
  760.     char *targetName;            /* Name of target cmd. */
  761.     int argc;                /* Additional arguments to store */
  762.     char **argv;            /* with alias. */
  763. {
  764.     Alias *aliasPtr;            /* Storage for alias data. */
  765.     Alias *tmpAliasPtr;            /* Temp storage for alias to delete. */
  766.     Tcl_HashEntry *hPtr;        /* Entry into interp hashtable. */
  767.     int i;                /* Loop index. */
  768.     int new;                /* Is it a new hash entry? */
  769.     Target *targetPtr;            /* Maps from target command in master
  770.                                          * to source command in slave. */
  771.     Slave *slavePtr;            /* Maps from source command in slave
  772.                                          * to target command in master. */
  773.  
  774.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
  775.  
  776.     /*
  777.      * Fix it up if there is no slave record. This can happen if someone
  778.      * uses "" as the source for an alias.
  779.      */
  780.     
  781.     if (slavePtr == (Slave *) NULL) {
  782.         slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
  783.         slavePtr->masterInterp = (Tcl_Interp *) NULL;
  784.         slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
  785.         slavePtr->slaveInterp = slaveInterp;
  786.         slavePtr->interpCmd = (Tcl_Command) NULL;
  787.         Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
  788.         (void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
  789.                 SlaveRecordDeleteProc, (ClientData) slavePtr);
  790.     }
  791.  
  792.     if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
  793.         if (argc != 0) {
  794.             Tcl_AppendResult(curInterp, "malformed command: should be",
  795.                 " \"alias ",  aliasName, " {}\"", (char *) NULL);
  796.             return TCL_ERROR;
  797.         }
  798.  
  799.         return DeleteAlias(curInterp, slaveInterp, aliasName);
  800.     }
  801.     
  802.     aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
  803.     aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
  804.     aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
  805.     strcpy(aliasPtr->aliasName, aliasName);
  806.     strcpy(aliasPtr->targetName, targetName);
  807.     aliasPtr->targetInterp = masterInterp;
  808.  
  809.     aliasPtr->argv = (char **) NULL;
  810.     aliasPtr->argc = argc;
  811.     if (aliasPtr->argc > 0) {
  812.         aliasPtr->argv = (char **) ckalloc((unsigned) sizeof(char *) *
  813.                 aliasPtr->argc);
  814.         for (i = 0; i < argc; i++) {
  815.             aliasPtr->argv[i] = (char *) ckalloc((unsigned) strlen(argv[i])+1);
  816.             strcpy(aliasPtr->argv[i], argv[i]);
  817.         }
  818.     }
  819.  
  820.     if (TclPreventAliasLoop(curInterp, slaveInterp, aliasName, AliasCmd,
  821.             (ClientData) aliasPtr) != TCL_OK) {
  822.         for (i = 0; i < argc; i++) {
  823.             ckfree(aliasPtr->argv[i]);
  824.         }
  825.         if (aliasPtr->argv != (char **) NULL) {
  826.             ckfree((char *) aliasPtr->argv);
  827.         }
  828.         ckfree(aliasPtr->aliasName);
  829.         ckfree(aliasPtr->targetName);
  830.         ckfree((char *) aliasPtr);
  831.         
  832.         return TCL_ERROR;
  833.     }
  834.     
  835.     aliasPtr->slaveCmd = Tcl_CreateCommand(slaveInterp, aliasName, AliasCmd,
  836.             (ClientData) aliasPtr, AliasCmdDeleteProc);
  837.  
  838.     /*
  839.      * Make an entry in the alias table. If it already exists delete
  840.      * the alias command. Then retry.
  841.      */
  842.  
  843.     do {
  844.         hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
  845.         if (new == 0) {
  846.             tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  847.             (void) Tcl_DeleteCommand(slaveInterp, tmpAliasPtr->aliasName);
  848.             Tcl_DeleteHashEntry(hPtr);
  849.         }
  850.     } while (new == 0);
  851.     aliasPtr->aliasEntry = hPtr;
  852.     Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
  853.  
  854.     targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
  855.     targetPtr->slaveCmd = aliasPtr->slaveCmd;
  856.     targetPtr->slaveInterp = slaveInterp;
  857.  
  858.     do {
  859.         hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
  860.                 (char *) aliasCounter, &new);
  861.     aliasCounter++;
  862.     } while (new == 0);
  863.  
  864.     Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
  865.  
  866.     aliasPtr->targetEntry = hPtr;
  867.  
  868.     curInterp->result = aliasPtr->aliasName;
  869.             
  870.     return TCL_OK;
  871. }
  872.  
  873. /*
  874.  *----------------------------------------------------------------------
  875.  *
  876.  * SlaveAliasHelper -
  877.  *
  878.  *    Handles the different forms of the "interp alias" command:
  879.  *    - interp alias slavePath aliasName
  880.  *        Describes an alias.
  881.  *    - interp alias slavePath aliasName {}
  882.  *        Deletes an alias.
  883.  *    - interp alias slavePath srcCmd masterPath targetCmd args...
  884.  *        Creates an alias.
  885.  *
  886.  * Results:
  887.  *    A Tcl result.
  888.  *
  889.  * Side effects:
  890.  *    See user documentation for details.
  891.  *
  892.  *----------------------------------------------------------------------
  893.  */
  894.  
  895. static int
  896. SlaveAliasHelper(interp, argc, argv)
  897.     Tcl_Interp *interp;            /* Current interpreter. */
  898.     int argc;                /* Number of arguments. */
  899.     char **argv;            /* Argument strings. */
  900. {
  901.     Master *masterPtr;            /* Master record for current interp. */
  902.     Tcl_Interp *slaveInterp,        /* Interpreters used when */
  903.         *masterInterp;            /* creating an alias btn siblings. */
  904.     Master *masterMasterPtr;        /* Master record for master interp. */
  905.  
  906.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  907.     if (masterPtr == (Master *) NULL) {
  908.         panic("SlaveAliasHelper: could not find master record");
  909.     }
  910.     if (argc < 4) {
  911.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  912.                 " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
  913.                 (char *) NULL);
  914.         return TCL_ERROR;
  915.     }
  916.     slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
  917.     if (slaveInterp == (Tcl_Interp *) NULL) {
  918.         Tcl_AppendResult(interp, "could not find interpreter \"",
  919.             argv[2], "\"", (char *) NULL);
  920.         return TCL_ERROR;
  921.     }
  922.     if (argc == 4) {
  923.         return DescribeAlias(interp, slaveInterp, argv[3]);
  924.     }
  925.     if (argc == 5 && strcmp(argv[4], "") == 0) {
  926.         return DeleteAlias(interp, slaveInterp, argv[3]);
  927.     }
  928.     if (argc < 6) {
  929.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  930.                 " alias slavePath slaveCmd masterPath masterCmd ?args ..?\"",
  931.                 (char *) NULL);
  932.         return TCL_ERROR;
  933.     }
  934.     masterInterp = GetInterp(interp, masterPtr, argv[4], &masterMasterPtr);
  935.     if (masterInterp == (Tcl_Interp *) NULL) {
  936.         Tcl_AppendResult(interp, "could not find interpreter \"",
  937.             argv[4], "\"", (char *) NULL);
  938.         return TCL_ERROR;
  939.     }
  940.     return AliasHelper(interp, slaveInterp, masterInterp, masterMasterPtr,
  941.             argv[3], argv[5], argc-6, argv+6);
  942. }
  943.  
  944. /*
  945.  *----------------------------------------------------------------------
  946.  *
  947.  * DescribeAlias --
  948.  *
  949.  *    Sets interp->result to a Tcl list describing the given alias in the
  950.  *    given interpreter: its target command and the additional arguments
  951.  *    to prepend to any invocation of the alias.
  952.  *
  953.  * Results:
  954.  *    A standard Tcl result.
  955.  *
  956.  * Side effects:
  957.  *    None.
  958.  *
  959.  *----------------------------------------------------------------------
  960.  */
  961.  
  962. static int
  963. DescribeAlias(interp, slaveInterp, aliasName)
  964.     Tcl_Interp *interp;        /* Interpreter for result and errors. */
  965.     Tcl_Interp *slaveInterp;    /* Interpreter defining alias. */
  966.     char *aliasName;        /* Name of alias to describe. */
  967. {
  968.     Slave *slavePtr;        /* Slave record for slave interpreter. */
  969.     Tcl_HashEntry *hPtr;    /* Search variable. */
  970.     Alias *aliasPtr;        /* Structure describing alias. */
  971.     int i;            /* Loop variable. */
  972.  
  973.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  974.             NULL);
  975.     if (slavePtr == (Slave *) NULL) {
  976.         panic("DescribeAlias: could not find slave record");
  977.     }
  978.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  979.     if (hPtr == (Tcl_HashEntry *) NULL) {
  980.         return TCL_OK;
  981.     }
  982.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  983.     Tcl_AppendResult(interp, aliasPtr->targetName, (char *) NULL);
  984.     for (i = 0; i < aliasPtr->argc; i++) {
  985.         Tcl_AppendElement(interp, aliasPtr->argv[i]);
  986.     }
  987.     
  988.     return TCL_OK;
  989. }
  990.  
  991. /*
  992.  *----------------------------------------------------------------------
  993.  *
  994.  * DeleteAlias --
  995.  *
  996.  *    Deletes the given alias from the slave interpreter given.
  997.  *
  998.  * Results:
  999.  *    A standard Tcl result.
  1000.  *
  1001.  * Side effects:
  1002.  *    Deletes the alias from the slave interpreter.
  1003.  *
  1004.  *----------------------------------------------------------------------
  1005.  */
  1006.  
  1007. static int
  1008. DeleteAlias(interp, slaveInterp, aliasName)
  1009.     Tcl_Interp *interp;        /* Interpreter for result and errors. */
  1010.     Tcl_Interp *slaveInterp;    /* Interpreter defining alias. */
  1011.     char *aliasName;        /* Name of alias to delete. */
  1012. {
  1013.     Slave *slavePtr;        /* Slave record for slave interpreter. */
  1014.     Tcl_HashEntry *hPtr;    /* Search variable. */
  1015.     Alias *aliasPtr;        /* Structure describing alias to delete. */
  1016.  
  1017.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  1018.             NULL);
  1019.     if (slavePtr == (Slave *) NULL) {
  1020.         panic("DeleteAlias: could not find slave record");
  1021.     }
  1022.     
  1023.     /*
  1024.      * Get the alias from the alias table, determine the current
  1025.      * true name of the alias (it may have been renamed!) and then
  1026.      * delete the true command name. The deleteProc on the alias
  1027.      * command will take care of removing the entry from the alias
  1028.      * table.
  1029.      */
  1030.  
  1031.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  1032.     if (hPtr == (Tcl_HashEntry *) NULL) {
  1033.         Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
  1034.                 (char *) NULL);
  1035.         return TCL_ERROR;
  1036.     }
  1037.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  1038.     aliasName = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
  1039.  
  1040.     /*
  1041.      * NOTE: The deleteProc for this command will delete the
  1042.      * alias from the hash table. The deleteProc will also
  1043.      * delete the target information from the master interpreter
  1044.      * target table.
  1045.      */
  1046.  
  1047.     if (Tcl_DeleteCommand(slaveInterp, aliasName) != 0) {
  1048.         panic("DeleteAlias: did not find alias to be deleted");
  1049.     }
  1050.  
  1051.     return TCL_OK;
  1052. }
  1053.  
  1054. /*
  1055.  *----------------------------------------------------------------------
  1056.  *
  1057.  * Tcl_GetInterpPath --
  1058.  *
  1059.  *    Sets the result of the asking interpreter to a proper Tcl list
  1060.  *    containing the names of interpreters between the asking and
  1061.  *    target interpreters. The target interpreter must be either the
  1062.  *    same as the asking interpreter or one of its slaves (including
  1063.  *    recursively).
  1064.  *
  1065.  * Results:
  1066.  *    TCL_OK if the target interpreter is the same as, or a descendant
  1067.  *    of, the asking interpreter; TCL_ERROR else. This way one can
  1068.  *    distinguish between the case where the asking and target interps
  1069.  *    are the same (an empty list is the result, and TCL_OK is returned)
  1070.  *    and when the target is not a descendant of the asking interpreter
  1071.  *    (in which case the Tcl result is an error message and the function
  1072.  *    returns TCL_ERROR).
  1073.  *
  1074.  * Side effects:
  1075.  *    None.
  1076.  *
  1077.  *----------------------------------------------------------------------
  1078.  */
  1079.  
  1080. int
  1081. Tcl_GetInterpPath(askingInterp, targetInterp)
  1082.     Tcl_Interp *askingInterp;    /* Interpreter to start search from. */
  1083.     Tcl_Interp *targetInterp;    /* Interpreter to find. */
  1084. {
  1085.     Master *masterPtr;        /* Interim storage for Master record. */
  1086.     Slave *slavePtr;        /* Interim storage for Slave record. */
  1087.     
  1088.     if (targetInterp == askingInterp) {
  1089.         return TCL_OK;
  1090.     }
  1091.     if (targetInterp == (Tcl_Interp *) NULL) {
  1092.         return TCL_ERROR;
  1093.     }
  1094.     slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
  1095.             NULL);
  1096.     if (slavePtr == (Slave *) NULL) {
  1097.         return TCL_ERROR;
  1098.     }
  1099.     if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
  1100.         /*
  1101.          * AskingInterp->result was set by recursive call.
  1102.          */
  1103.         return TCL_ERROR;
  1104.     }
  1105.     masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
  1106.             "tclMasterRecord", NULL);
  1107.     if (masterPtr == (Master *) NULL) {
  1108.         panic("Tcl_GetInterpPath: could not find master record");
  1109.     }
  1110.     Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
  1111.             slavePtr->slaveEntry));
  1112.     return TCL_OK;
  1113. }
  1114.  
  1115. /*
  1116.  *----------------------------------------------------------------------
  1117.  *
  1118.  * GetTarget --
  1119.  *
  1120.  *    Sets the result of the invoking interpreter to a path name for
  1121.  *    the target interpreter of an alias in one of the slaves.
  1122.  *
  1123.  * Results:
  1124.  *    TCL_OK if the target interpreter of the alias is a slave of the
  1125.  *    invoking interpreter, TCL_ERROR else.
  1126.  *
  1127.  * Side effects:
  1128.  *    Sets the result of the invoking interpreter.
  1129.  *
  1130.  *----------------------------------------------------------------------
  1131.  */
  1132.  
  1133. static int
  1134. GetTarget(askingInterp, path, aliasName)
  1135.     Tcl_Interp *askingInterp;    /* Interpreter to start search from. */
  1136.     char *path;            /* The path of the interp to find. */
  1137.     char *aliasName;        /* The target of this allias. */
  1138. {
  1139.     Tcl_Interp *slaveInterp;    /* Interim storage for slave. */
  1140.     Slave *slaveSlavePtr;    /* Its Slave record. */
  1141.     Master *masterPtr;        /* Interim storage for Master record. */
  1142.     Tcl_HashEntry *hPtr;    /* Search element. */
  1143.     Alias *aliasPtr;        /* Data describing the alias. */
  1144.  
  1145.     Tcl_ResetResult(askingInterp);
  1146.  
  1147.     masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
  1148.             NULL);
  1149.     if (masterPtr == (Master *) NULL) {
  1150.         panic("GetTarget: could not find master record");
  1151.     }
  1152.     slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
  1153.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1154.         Tcl_AppendResult(askingInterp, "could not find interpreter \"",
  1155.             path, "\"", (char *) NULL);
  1156.         return TCL_ERROR;
  1157.     }
  1158.     slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
  1159.             NULL);
  1160.     if (slaveSlavePtr == (Slave *) NULL) {
  1161.         panic("GetTarget: could not find slave record");
  1162.     }
  1163.     hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
  1164.     if (hPtr == (Tcl_HashEntry *) NULL) {
  1165.         Tcl_AppendResult(askingInterp, "alias \"", aliasName, "\" in path \"",
  1166.                 path, "\" not found", (char *) NULL);
  1167.         return TCL_ERROR;
  1168.     }
  1169.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  1170.     if (aliasPtr == (Alias *) NULL) {
  1171.         panic("GetTarget: could not find alias record");
  1172.     }
  1173.     if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
  1174.         Tcl_ResetResult(askingInterp);
  1175.         Tcl_AppendResult(askingInterp, "target interpreter for alias \"",
  1176.                 aliasName, "\" in path \"", path, "\" is not my descendant",
  1177.                 (char *) NULL);
  1178.         return TCL_ERROR;
  1179.     }
  1180.     return TCL_OK;
  1181. }
  1182.  
  1183. /*
  1184.  *----------------------------------------------------------------------
  1185.  *
  1186.  * Tcl_InterpCmd --
  1187.  *
  1188.  *    This procedure is invoked to process the "interp" Tcl command.
  1189.  *    See the user documentation for details on what it does.
  1190.  *
  1191.  * Results:
  1192.  *    A standard Tcl result.
  1193.  *
  1194.  * Side effects:
  1195.  *    See the user documentation.
  1196.  *
  1197.  *----------------------------------------------------------------------
  1198.  */
  1199.     /* ARGSUSED */
  1200. int
  1201. Tcl_InterpCmd(clientData, interp, argc, argv)
  1202.     ClientData clientData;        /* Unused. */
  1203.     Tcl_Interp *interp;            /* Current interpreter. */
  1204.     int argc;                /* Number of arguments. */
  1205.     char **argv;            /* Argument strings. */
  1206. {
  1207.     Tcl_Interp *slaveInterp;        /* A slave. */
  1208.     Tcl_Interp *masterInterp;        /* A master. */
  1209.     Master *masterPtr;            /* Master record for current interp. */
  1210.     Slave *slavePtr;            /* Record for slave interp. */
  1211.     Tcl_HashEntry *hPtr;
  1212.     Tcl_HashSearch hSearch;
  1213.     size_t len;                /* Length of command name. */
  1214.     int result;                /* Result of eval. */
  1215.     char *cmdName;            /* Name of sub command to do. */
  1216.     char *cmd;                /* Command to eval. */
  1217.     Tcl_Channel chan;            /* Channel to share or transfer. */
  1218.  
  1219.     if (argc < 2) {
  1220.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1221.                 " cmd ?arg ...?\"", (char *) NULL);
  1222.         return TCL_ERROR;
  1223.     }
  1224.     cmdName = argv[1];
  1225.  
  1226.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  1227.     if (masterPtr == (Master *) NULL) {
  1228.         panic("Tcl_InterpCmd: could not find master record");
  1229.     }
  1230.  
  1231.     len = strlen(cmdName);
  1232.     
  1233.     if (cmdName[0] == 'a') {
  1234.         if ((strncmp(cmdName, "alias", len) == 0) && (len <= 5)) {
  1235.             return SlaveAliasHelper(interp, argc, argv);
  1236.         }
  1237.  
  1238.         if (strcmp(cmdName, "aliases") == 0) {
  1239.             if (argc != 2 && argc != 3) {
  1240.                 Tcl_AppendResult(interp, "wrong # args: should be \"",
  1241.                         argv[0], " aliases ?path?\"", (char *) NULL);
  1242.                 return TCL_ERROR;
  1243.             }
  1244.             if (argc == 3) {
  1245.                 slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
  1246.                 if (slaveInterp == (Tcl_Interp *) NULL) {
  1247.                     Tcl_AppendResult(interp, "interpreter \"",
  1248.                             argv[2], "\" not found", (char *) NULL);
  1249.                     return TCL_ERROR;
  1250.                 }
  1251.             } else {
  1252.                 slaveInterp = interp;
  1253.             }
  1254.             slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
  1255.                     "tclSlaveRecord", NULL);
  1256.             if (slavePtr == (Slave *) NULL) {
  1257.                 return TCL_OK;
  1258.             }
  1259.             for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
  1260.                  hPtr != NULL;
  1261.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  1262.                 Tcl_AppendElement(interp,
  1263.                         Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr));
  1264.             }
  1265.             return TCL_OK;
  1266.         }
  1267.     }
  1268.  
  1269.     if ((cmdName[0] == 'c') && (strncmp(cmdName, "create", len) == 0)) {
  1270.         return CreateInterpObject(interp, argc, argv);
  1271.     }
  1272.  
  1273.     if ((cmdName[0] == 'd') && (strncmp(cmdName, "delete", len) == 0)) {
  1274.         return DeleteInterpObject(interp, argc, argv);
  1275.     }
  1276.  
  1277.     if (cmdName[0] == 'e') {
  1278.         if ((strncmp(cmdName, "exists", len) == 0) && (len > 1)) {
  1279.             if (argc > 3) {
  1280.                 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1281.                         " exists ?path?\"", (char *) NULL);
  1282.                 return TCL_ERROR;
  1283.             }
  1284.             if (argc == 3) {
  1285.                 if (GetInterp(interp, masterPtr, argv[2], NULL) ==
  1286.                         (Tcl_Interp *) NULL) {
  1287.                     Tcl_AppendResult(interp, "0", (char *) NULL);
  1288.                 } else {
  1289.                     Tcl_AppendResult(interp, "1", (char *) NULL);
  1290.                 }
  1291.             } else {
  1292.                 Tcl_AppendResult(interp, "1", (char *) NULL);
  1293.             }
  1294.             return TCL_OK;
  1295.         }
  1296.         if ((strncmp(cmdName, "eval", len) == 0) && (len > 1)) {
  1297.             if (argc < 4) {
  1298.                 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1299.                         " eval path arg ?arg ...?\"", (char *) NULL);
  1300.                 return TCL_ERROR;
  1301.             }
  1302.             slaveInterp = GetInterp(interp, masterPtr, argv[2], NULL);
  1303.             if (slaveInterp == (Tcl_Interp *) NULL) {
  1304.                 Tcl_AppendResult(interp, "interpreter named \"", argv[2],
  1305.                         "\" not found", (char *) NULL);
  1306.                 return TCL_ERROR;
  1307.             }
  1308.             cmd = Tcl_Concat(argc-3, argv+3);
  1309.             Tcl_Preserve((ClientData) slaveInterp);
  1310.             result = Tcl_Eval(slaveInterp, cmd);
  1311.             ckfree((char *) cmd);
  1312.  
  1313.             /*
  1314.              * Now make the result and any error information accessible. We
  1315.              * have to be careful because the slave interpreter and the current
  1316.              * interpreter can be the same - do not destroy the result.. This
  1317.              * can happen if an interpreter contains an alias which is directed
  1318.              * at a target command in the same interpreter.
  1319.              */
  1320.  
  1321.             if (interp != slaveInterp) {
  1322.                 if (result == TCL_ERROR) {
  1323.  
  1324.                     /*
  1325.                      * An error occurred, so transfer error information from
  1326.                      * the target interpreter back to our interpreter.  Must
  1327.                      * clear interp's result before calling Tcl_AddErrorInfo,
  1328.                      * since Tcl_AddErrorInfo will store the interp's result in
  1329.                      * errorInfo before appending slaveInterp's $errorInfo;
  1330.                      * we've already got everything we need in the slave
  1331.                      * interpreter's $errorInfo.
  1332.                      */
  1333.  
  1334.                     Tcl_ResetResult(interp);
  1335.                     Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
  1336.                             "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
  1337.                     Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  1338.                             Tcl_GetVar2(slaveInterp, "errorCode", (char *)
  1339.                                     NULL, TCL_GLOBAL_ONLY),
  1340.                             TCL_GLOBAL_ONLY);
  1341.                 }
  1342.                 if (slaveInterp->freeProc != NULL) {
  1343.                     interp->result = slaveInterp->result;
  1344.                     interp->freeProc = slaveInterp->freeProc;
  1345.                     slaveInterp->freeProc = 0;
  1346.                 } else {
  1347.                     Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
  1348.                 }
  1349.                 Tcl_ResetResult(slaveInterp);
  1350.             }
  1351.             Tcl_Release((ClientData) slaveInterp);
  1352.             return result;        
  1353.         }
  1354.     }
  1355.  
  1356.     if ((cmdName[0] == 'i') && (strncmp(cmdName, "issafe", len) == 0)) {
  1357.         if (argc > 3) {
  1358.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1359.                     " issafe ?path?\"", (char *) NULL);
  1360.             return TCL_ERROR;
  1361.         }
  1362.         if (argc == 3) {
  1363.             slaveInterp = GetInterp(interp, masterPtr, argv[2], &masterPtr);
  1364.             if (slaveInterp == (Tcl_Interp *) NULL) {
  1365.                 Tcl_AppendResult(interp, "interpreter \"", argv[2],
  1366.                         "\" not found", (char *) NULL);
  1367.                 return TCL_ERROR;
  1368.             }
  1369.         }
  1370.         if (masterPtr->isSafe == 0) {
  1371.             Tcl_AppendResult(interp, "0", (char *) NULL);
  1372.         } else {
  1373.             Tcl_AppendResult(interp, "1", (char *) NULL);
  1374.         }
  1375.         return TCL_OK;
  1376.     }
  1377.     
  1378.     if (cmdName[0] == 's') {
  1379.         if ((strncmp(cmdName, "slaves", len) == 0) && (len > 1)) {
  1380.             if (argc != 2 && argc != 3) {
  1381.                 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1382.                         " slaves ?path?\"", (char *) NULL);
  1383.                 return TCL_ERROR;
  1384.             }
  1385.             if (argc == 3) {
  1386.                 if (GetInterp(interp, masterPtr, argv[2], &masterPtr) ==
  1387.                         (Tcl_Interp *) NULL) {
  1388.                     Tcl_AppendResult(interp, "interpreter \"", argv[2],
  1389.                             "\" not found", (char *) NULL);
  1390.                     return TCL_ERROR;
  1391.                 }
  1392.             }
  1393.             for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
  1394.                  hPtr != NULL;
  1395.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  1396.                 Tcl_AppendElement(interp,
  1397.                         Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr));
  1398.             }
  1399.             return TCL_OK;
  1400.         }
  1401.         if ((strncmp(cmdName, "share", len) == 0) && (len > 1)) {
  1402.             if (argc != 5) {
  1403.                 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1404.                         " share srcPath channelId destPath\"", (char *) NULL);
  1405.                 return TCL_ERROR;
  1406.             }
  1407.             masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
  1408.             if (masterInterp == (Tcl_Interp *) NULL) {
  1409.                 Tcl_AppendResult(interp, "interpreter \"", argv[2],
  1410.                         "\" not found", (char *) NULL);
  1411.                 return TCL_ERROR;
  1412.             }
  1413.             slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
  1414.             if (slaveInterp == (Tcl_Interp *) NULL) {
  1415.                 Tcl_AppendResult(interp, "interpreter \"", argv[4],
  1416.                         "\" not found", (char *) NULL);
  1417.                 return TCL_ERROR;
  1418.             }
  1419.             chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
  1420.             if (chan == (Tcl_Channel) NULL) {
  1421.                 if (interp != masterInterp) {
  1422.                     Tcl_AppendResult(interp, masterInterp->result,
  1423.                             (char *) NULL);
  1424.                     Tcl_ResetResult(masterInterp);
  1425.                 }
  1426.                 return TCL_ERROR;
  1427.             }
  1428.             Tcl_RegisterChannel(slaveInterp, chan);
  1429.             return TCL_OK;
  1430.         }
  1431.     }
  1432.  
  1433.     if ((cmdName[0] == 't') && (strncmp(cmdName, "target", len) == 0)) {
  1434.         if (argc != 4) {
  1435.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1436.                     " target path alias\"", (char *) NULL);
  1437.             return TCL_ERROR;
  1438.         }
  1439.         return GetTarget(interp, argv[2], argv[3]);
  1440.     }
  1441.  
  1442.     if ((cmdName[0] == 't') && (strncmp(cmdName, "transfer", len) == 0)) {
  1443.         if (argc != 5) {
  1444.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1445.                     " transfer srcPath channelId destPath\"", (char *) NULL);
  1446.             return TCL_ERROR;
  1447.         }
  1448.         masterInterp = GetInterp(interp, masterPtr, argv[2], NULL);
  1449.         if (masterInterp == (Tcl_Interp *) NULL) {
  1450.             Tcl_AppendResult(interp, "interpreter \"", argv[2],
  1451.                     "\" not found", (char *) NULL);
  1452.             return TCL_ERROR;
  1453.         }
  1454.         slaveInterp = GetInterp(interp, masterPtr, argv[4], NULL);
  1455.         if (slaveInterp == (Tcl_Interp *) NULL) {
  1456.             Tcl_AppendResult(interp, "interpreter \"", argv[4],
  1457.                     "\" not found", (char *) NULL);
  1458.             return TCL_ERROR;
  1459.         }
  1460.         chan = Tcl_GetChannel(masterInterp, argv[3], NULL);
  1461.         if (chan == (Tcl_Channel) NULL) {
  1462.             if (interp != masterInterp) {
  1463.                 Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
  1464.                 Tcl_ResetResult(masterInterp);
  1465.             }
  1466.             return TCL_ERROR;
  1467.         }
  1468.         Tcl_RegisterChannel(slaveInterp, chan);
  1469.         if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
  1470.             if (interp != masterInterp) {
  1471.                 Tcl_AppendResult(interp, masterInterp->result, (char *) NULL);
  1472.                 Tcl_ResetResult(masterInterp);
  1473.             }
  1474.             return TCL_ERROR;
  1475.         }
  1476.  
  1477.         return TCL_OK;
  1478.     }
  1479.         
  1480.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1481.             "\": should be alias, aliases, create, delete, exists, eval, ",
  1482.             "issafe, share, slaves, target or transfer", (char *) NULL);
  1483.     return TCL_ERROR;    
  1484. }
  1485.  
  1486. /*
  1487.  *----------------------------------------------------------------------
  1488.  *
  1489.  * SlaveObjectCmd --
  1490.  *
  1491.  *    Command to manipulate an interpreter, e.g. to send commands to it
  1492.  *    to be evaluated. One such command exists for each slave interpreter.
  1493.  *
  1494.  * Results:
  1495.  *    A standard Tcl result.
  1496.  *
  1497.  * Side effects:
  1498.  *    See user documentation for details.
  1499.  *
  1500.  *----------------------------------------------------------------------
  1501.  */
  1502.  
  1503. static int
  1504. SlaveObjectCmd(clientData, interp, argc, argv)
  1505.     ClientData clientData;        /* Slave interpreter. */
  1506.     Tcl_Interp *interp;            /* Current interpreter. */
  1507.     int argc;                /* Number of arguments. */
  1508.     char **argv;            /* Argument strings. */
  1509. {
  1510.     Master *masterPtr;            /* Master record for slave interp. */
  1511.     Slave *slavePtr;            /* Slave record. */
  1512.     Tcl_Interp *slaveInterp;        /* Slave interpreter. */
  1513.     char *cmdName;            /* Name of command to do. */
  1514.     char *cmd;                /* Command to evaluate in slave
  1515.                                          * interpreter. */
  1516.     Alias *aliasPtr;            /* Alias information. */
  1517.     Tcl_HashEntry *hPtr;        /* For local searches. */
  1518.     Tcl_HashSearch hSearch;        /* For local searches. */
  1519.     int result;                /* Loop counter, status return. */
  1520.     size_t len;                /* Length of command name. */
  1521.     
  1522.     if (argc < 2) {
  1523.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1524.             " cmd ?arg ...?\"", (char *) NULL);
  1525.         return TCL_ERROR;
  1526.     }
  1527.  
  1528.     slaveInterp = (Tcl_Interp *) clientData;
  1529.     if (slaveInterp == (Tcl_Interp *) NULL) {
  1530.     Tcl_AppendResult(interp, "interpreter ", argv[0], " has been deleted",
  1531.         (char *) NULL);
  1532.     return TCL_ERROR;
  1533.     }
  1534.  
  1535.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
  1536.             "tclSlaveRecord", NULL);
  1537.     if (slavePtr == (Slave *) NULL) {
  1538.         panic("SlaveObjectCmd: could not find slave record");
  1539.     }
  1540.  
  1541.     cmdName = argv[1];
  1542.     len = strlen(cmdName);
  1543.  
  1544.     if (cmdName[0] == 'a') {
  1545.         if (strncmp(cmdName, "alias", len) == 0) {
  1546.             switch (argc-2) {
  1547.                 case 0:
  1548.                     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1549.                             argv[0], " alias aliasName ?targetName? ?args..?",
  1550.                             (char *) NULL);
  1551.                     return TCL_ERROR;
  1552.  
  1553.                 case 1:
  1554.  
  1555.                     /*
  1556.                      * Return the name of the command in the current
  1557.                      * interpreter for which the argument is an alias in the
  1558.                      * slave interpreter, and the list of saved arguments
  1559.                      */
  1560.  
  1561.                     return DescribeAlias(interp, slaveInterp, argv[2]);
  1562.  
  1563.                 default:
  1564.                     masterPtr = (Master *) Tcl_GetAssocData(interp,
  1565.                             "tclMasterRecord", NULL);
  1566.                     if (masterPtr == (Master *) NULL) {
  1567.                         panic("SlaveObjectCmd: could not find master record");
  1568.                     }
  1569.                     return AliasHelper(interp, slaveInterp, interp, masterPtr,
  1570.                             argv[2], argv[3], argc-4, argv+4);
  1571.             }
  1572.         }
  1573.  
  1574.         if (strncmp(cmdName, "aliases", len) == 0) {
  1575.  
  1576.             /*
  1577.              * Return the names of all the aliases created in the
  1578.              * slave interpreter.
  1579.              */
  1580.  
  1581.             for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
  1582.                     &hSearch);
  1583.                  hPtr != (Tcl_HashEntry *) NULL;
  1584.                  hPtr = Tcl_NextHashEntry(&hSearch)) {
  1585.                 aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  1586.                 Tcl_AppendElement(interp, aliasPtr->aliasName);
  1587.             }
  1588.             return TCL_OK;
  1589.         }
  1590.     }
  1591.     
  1592.  
  1593.     if ((cmdName[0] == 'e') && (strncmp(cmdName, "eval", len) == 0)) {
  1594.         if (argc < 3) {
  1595.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1596.                     " eval arg ?arg ...?\"", (char *) NULL);
  1597.             return TCL_ERROR;
  1598.         }
  1599.  
  1600.         cmd = Tcl_Concat(argc-2, argv+2);
  1601.         Tcl_Preserve((ClientData) slaveInterp);
  1602.         result = Tcl_Eval(slaveInterp, cmd);
  1603.         ckfree((char *) cmd);
  1604.  
  1605.         /*
  1606.          * Now make the result and any error information accessible. We have
  1607.          * to be careful because the slave interpreter and the current
  1608.          * interpreter can be the same - do not destroy the result.. This
  1609.          * can happen if an interpreter contains an alias which is directed
  1610.          * at a target command in the same interpreter.
  1611.          */
  1612.  
  1613.         if (interp != slaveInterp) {
  1614.             if (result == TCL_ERROR) {
  1615.  
  1616.                /*
  1617.                 * An error occurred, so transfer error information from the
  1618.                 * destination interpreter back to our interpreter.  Must clear
  1619.                 * interp's result before calling Tcl_AddErrorInfo, since
  1620.                 * Tcl_AddErrorInfo will store the interp's result in errorInfo
  1621.                 * before appending slaveInterp's $errorInfo;
  1622.                 * we've already got everything we need in the slave
  1623.                 * interpreter's $errorInfo.
  1624.                 */
  1625.  
  1626.                 Tcl_ResetResult(interp);
  1627.                 Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp,
  1628.                         "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
  1629.                 Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  1630.                         Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
  1631.                                 TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
  1632.             }
  1633.             if (slaveInterp->freeProc != NULL) {
  1634.                 interp->result = slaveInterp->result;
  1635.                 interp->freeProc = slaveInterp->freeProc;
  1636.                 slaveInterp->freeProc = 0;
  1637.             } else {
  1638.                 Tcl_SetResult(interp, slaveInterp->result, TCL_VOLATILE);
  1639.             }
  1640.             Tcl_ResetResult(slaveInterp);
  1641.         }
  1642.         Tcl_Release((ClientData) slaveInterp);
  1643.         return result;
  1644.     }
  1645.  
  1646.     if ((cmdName[0] == 'i') && (strncmp(cmdName, "issafe", len) == 0)) {
  1647.         if (argc > 2) {
  1648.             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1649.                     " issafe\"", (char *) NULL);
  1650.             return TCL_ERROR;
  1651.         }
  1652.         masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
  1653.                 "tclMasterRecord", NULL);
  1654.         if (masterPtr == (Master *) NULL) {
  1655.             panic("SlaveObjectCmd: could not find master record");
  1656.         }
  1657.         if (masterPtr->isSafe == 1) {
  1658.             Tcl_AppendResult(interp, "1", (char *) NULL);
  1659.         } else {
  1660.             Tcl_AppendResult(interp, "0", (char *) NULL);
  1661.         }
  1662.         return TCL_OK;
  1663.     }
  1664.  
  1665.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1666.             "\": should be alias, aliases, eval or issafe", (char *) NULL);
  1667.     return TCL_ERROR;
  1668. }
  1669.  
  1670. /*
  1671.  *----------------------------------------------------------------------
  1672.  *
  1673.  * SlaveObjectDeleteProc --
  1674.  *
  1675.  *    Invoked when an object command for a slave interpreter is deleted;
  1676.  *    cleans up all state associated with the slave interpreter and destroys
  1677.  *    the slave interpreter.
  1678.  *
  1679.  * Results:
  1680.  *    None.
  1681.  *
  1682.  * Side effects:
  1683.  *    Cleans up all state associated with the slave interpreter and
  1684.  *    destroys the slave interpreter.
  1685.  *
  1686.  *----------------------------------------------------------------------
  1687.  */
  1688.  
  1689. static void
  1690. SlaveObjectDeleteProc(clientData)
  1691.     ClientData clientData;        /* The SlaveRecord for the command. */
  1692. {
  1693.     Slave *slavePtr;            /* Interim storage for Slave record. */
  1694.     Tcl_Interp *slaveInterp;        /* And for a slave interp. */
  1695.  
  1696.     slaveInterp = (Tcl_Interp *) clientData;
  1697.     slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL); 
  1698.     if (slavePtr == (Slave *) NULL) {
  1699.         panic("SlaveObjectDeleteProc: could not find slave record");
  1700.     }
  1701.  
  1702.     /*
  1703.      * Delete the entry in the slave table in the master interpreter now.
  1704.      * This is to avoid an infinite loop in the Master hash table cleanup in
  1705.      * the master interpreter. This can happen if this slave is being deleted
  1706.      * because the master is being deleted and the slave deletion is deferred
  1707.      * because it is still active.
  1708.      */
  1709.  
  1710.     Tcl_DeleteHashEntry(slavePtr->slaveEntry);
  1711.  
  1712.     /*
  1713.      * Set to NULL so that when the slave record is cleaned up in the slave
  1714.      * it does not try to delete the command causing all sorts of grief.
  1715.      * See SlaveRecordDeleteProc().
  1716.      */
  1717.  
  1718.     slavePtr->interpCmd = NULL;
  1719.  
  1720.     /*
  1721.      * Destroy the interpreter - this will cause all the deleteProcs for
  1722.      * all commands (including aliases) to run.
  1723.      *
  1724.      * NOTE: WE ASSUME THAT THE INTERPRETER HAS NOT BEEN DELETED YET!!
  1725.      */
  1726.  
  1727.     Tcl_DeleteInterp(slavePtr->slaveInterp);
  1728. }
  1729.  
  1730. /*
  1731.  *----------------------------------------------------------------------
  1732.  *
  1733.  * AliasCmd --
  1734.  *
  1735.  *    This is the procedure that services invocations of aliases in a
  1736.  *    slave interpreter. One such command exists for each alias. When
  1737.  *    invoked, this procedure redirects the invocation to the target
  1738.  *    command in the master interpreter as designated by the Alias
  1739.  *    record associated with this command.
  1740.  *
  1741.  * Results:
  1742.  *    A standard Tcl result.
  1743.  *
  1744.  * Side effects:
  1745.  *    Causes forwarding of the invocation; all possible side effects
  1746.  *    may occur as a result of invoking the command to which the
  1747.  *    invocation is forwarded.
  1748.  *
  1749.  *----------------------------------------------------------------------
  1750.  */
  1751.  
  1752. static int
  1753. AliasCmd(clientData, interp, argc, argv)
  1754.     ClientData clientData;        /* Alias record. */
  1755.     Tcl_Interp *interp;            /* Current interpreter. */
  1756.     int argc;                /* Number of arguments. */
  1757.     char **argv;            /* Argument strings. */
  1758. {
  1759.     Alias *aliasPtr;            /* Describes the alias. */
  1760.     Tcl_CmdInfo cmdInfo;        /* Info about target command. */
  1761.     int result;                /* Result of execution. */
  1762.     int i, j, addArgc;            /* Loop counters. */
  1763.     int localArgc;            /* Local argument count. */
  1764.     char **localArgv;            /* Local argument vector. */
  1765.     Interp *iPtr;            /* The target interpreter. */
  1766.     
  1767.     aliasPtr = (Alias *) clientData;
  1768.  
  1769.     result = Tcl_GetCommandInfo(aliasPtr->targetInterp, aliasPtr->targetName,
  1770.             &cmdInfo);
  1771.     if (result == 0) {
  1772.         Tcl_AppendResult(interp, "aliased target \"", aliasPtr->targetName,
  1773.                 "\" for \"", argv[0], "\" not found", (char *) NULL); 
  1774.         return TCL_ERROR;
  1775.     }
  1776.     if (aliasPtr->argc <= 0) {
  1777.         localArgv = argv;
  1778.         localArgc = argc;
  1779.     } else {
  1780.         addArgc = aliasPtr->argc;
  1781.         localArgc = argc + addArgc;
  1782.         localArgv = (char **) ckalloc((unsigned) sizeof(char *) * localArgc);
  1783.         localArgv[0] = argv[0];
  1784.         for (i = 0, j = 1; i < addArgc; i++, j++) {
  1785.             localArgv[j] = aliasPtr->argv[i];
  1786.         }
  1787.         for (i = 1; i < argc; i++, j++) {
  1788.             localArgv[j] = argv[i];
  1789.         }
  1790.     }
  1791.  
  1792.     /*
  1793.      * Invoke the redirected command in the target interpreter. Note
  1794.      * that we are not calling eval because of possible security holes with
  1795.      * $ substitution and bracketed command evaluation.
  1796.      *
  1797.      * We duplicate some code here from Tcl_Eval to implement recursion
  1798.      * level counting and correct deletion of the target interpreter if
  1799.      * that was requested but delayed because of in-progress evaluations.
  1800.      */
  1801.  
  1802.     iPtr = (Interp *) aliasPtr->targetInterp;
  1803.     iPtr->numLevels++;
  1804.     Tcl_Preserve((ClientData) iPtr);
  1805.     Tcl_ResetResult((Tcl_Interp *) iPtr);
  1806.     result = (cmdInfo.proc)(cmdInfo.clientData, (Tcl_Interp *) iPtr,
  1807.             localArgc, localArgv);
  1808.     iPtr->numLevels--;
  1809.     if (iPtr->numLevels == 0) {
  1810.     if (result == TCL_RETURN) {
  1811.         result = TclUpdateReturnInfo(iPtr);
  1812.     }
  1813.     if ((result != TCL_OK) && (result != TCL_ERROR)) {
  1814.         Tcl_ResetResult((Tcl_Interp *) iPtr);
  1815.         if (result == TCL_BREAK) {
  1816.         iPtr->result = "invoked \"break\" outside of a loop";
  1817.         } else if (result == TCL_CONTINUE) {
  1818.         iPtr->result = "invoked \"continue\" outside of a loop";
  1819.         } else {
  1820.         iPtr->result = iPtr->resultSpace;
  1821.         sprintf(iPtr->resultSpace, "command returned bad code: %d",
  1822.             result);
  1823.         }
  1824.         result = TCL_ERROR;
  1825.     }
  1826.     }
  1827.  
  1828.     /*
  1829.      * Clean up any locally allocated argument vector structure.
  1830.      */
  1831.     
  1832.     if (localArgv != argv) {
  1833.         ckfree((char *) localArgv);
  1834.     }
  1835.     
  1836.     /*
  1837.      *
  1838.      * NOTE: Need to be careful if the target interpreter and the current
  1839.      * interpreter are the same - must not destroy result. This may happen
  1840.      * if an alias is created which redirects to a command in the same
  1841.      * interpreter as the one in which the source command will be defined.
  1842.      * Also: We cannot use aliasPtr any more because the alias may have
  1843.      * been deleted.
  1844.      */
  1845.  
  1846.     if (interp != (Tcl_Interp *) iPtr) {
  1847.         if (result == TCL_ERROR) {
  1848.         /*
  1849.          * An error occurred, so transfer error information from the
  1850.          * destination interpreter back to our interpreter.  Some tricky
  1851.          * points:
  1852.          * 1. Must call Tcl_AddErrorInfo in destination interpreter to
  1853.          *    make sure that the errorInfo variable has been initialized
  1854.          *    (it's initialized lazily and might not have been initialized
  1855.          *    yet).
  1856.          * 2. Must clear interp's result before calling Tcl_AddErrorInfo,
  1857.          *    since Tcl_AddErrorInfo will store the interp's result in
  1858.          *    errorInfo before appending aliasPtr->interp's $errorInfo;
  1859.          *    we've already got everything we need in the redirected
  1860.          *    interpreter's $errorInfo.
  1861.          */
  1862.  
  1863.         if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
  1864.         Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
  1865.         }
  1866.         iPtr->flags &= ~ERR_ALREADY_LOGGED;
  1867.             Tcl_ResetResult(interp);
  1868.             Tcl_AddErrorInfo(interp, Tcl_GetVar2((Tcl_Interp *) iPtr,
  1869.                     "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
  1870.             Tcl_SetVar2(interp, "errorCode", (char *) NULL,
  1871.                     Tcl_GetVar2((Tcl_Interp *) iPtr, "errorCode",
  1872.                     (char *) NULL, TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
  1873.         }
  1874.         if (iPtr->freeProc != NULL) {
  1875.             interp->result = iPtr->result;
  1876.             interp->freeProc = iPtr->freeProc;
  1877.             iPtr->freeProc = 0;
  1878.         } else {
  1879.             Tcl_SetResult(interp, iPtr->result, TCL_VOLATILE);
  1880.         }
  1881.         Tcl_ResetResult((Tcl_Interp *) iPtr);
  1882.     }
  1883.     Tcl_Release((ClientData) iPtr);
  1884.     return result;        
  1885. }
  1886.  
  1887. /*
  1888.  *----------------------------------------------------------------------
  1889.  *
  1890.  * AliasCmdDeleteProc --
  1891.  *
  1892.  *    Is invoked when an alias command is deleted in a slave. Cleans up
  1893.  *    all storage associated with this alias.
  1894.  *
  1895.  * Results:
  1896.  *    None.
  1897.  *
  1898.  * Side effects:
  1899.  *    Deletes the alias record and its entry in the alias table for
  1900.  *    the interpreter.
  1901.  *
  1902.  *----------------------------------------------------------------------
  1903.  */
  1904.  
  1905. static void
  1906. AliasCmdDeleteProc(clientData)
  1907.     ClientData clientData;        /* The alias record for this alias. */
  1908. {
  1909.     Alias *aliasPtr;            /* Alias record for alias to delete. */
  1910.     Target *targetPtr;            /* Record for target of this alias. */
  1911.     int i;                /* Loop counter. */
  1912.  
  1913.     aliasPtr = (Alias *) clientData;
  1914.     
  1915.     targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
  1916.     ckfree((char *) targetPtr);
  1917.     Tcl_DeleteHashEntry(aliasPtr->targetEntry);
  1918.  
  1919.     ckfree((char *) aliasPtr->targetName);
  1920.     ckfree((char *) aliasPtr->aliasName);
  1921.     for (i = 0; i < aliasPtr->argc; i++) {
  1922.         ckfree((char *) aliasPtr->argv[i]);
  1923.     }
  1924.     if (aliasPtr->argv != (char **) NULL) {
  1925.         ckfree((char *) aliasPtr->argv);
  1926.     }
  1927.  
  1928.     Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
  1929.  
  1930.     ckfree((char *) aliasPtr);
  1931. }
  1932.  
  1933. /*
  1934.  *----------------------------------------------------------------------
  1935.  *
  1936.  * MasterRecordDeleteProc -
  1937.  *
  1938.  *    Is invoked when an interpreter (which is using the "interp" facility)
  1939.  *    is deleted, and it cleans up the storage associated with the
  1940.  *    "tclMasterRecord" assoc-data entry.
  1941.  *
  1942.  * Results:
  1943.  *    None.
  1944.  *
  1945.  * Side effects:
  1946.  *    Cleans up storage.
  1947.  *
  1948.  *----------------------------------------------------------------------
  1949.  */
  1950.  
  1951. static void
  1952. MasterRecordDeleteProc(clientData, interp)
  1953.     ClientData    clientData;        /* Master record for deleted interp. */
  1954.     Tcl_Interp *interp;            /* Interpreter being deleted. */
  1955. {
  1956.     Target *targetPtr;            /* Loop variable. */
  1957.     Tcl_HashEntry *hPtr;        /* Search element. */
  1958.     Tcl_HashSearch hSearch;        /* Search record (internal). */
  1959.     Slave *slavePtr;            /* Loop variable. */
  1960.     char *cmdName;            /* Name of command to delete. */
  1961.     Master *masterPtr;            /* Interim storage. */
  1962.  
  1963.     masterPtr = (Master *) clientData;
  1964.     for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
  1965.          hPtr != NULL;
  1966.          hPtr = Tcl_NextHashEntry(&hSearch)) {
  1967.         slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
  1968.         cmdName = Tcl_GetCommandName(interp, slavePtr->interpCmd);
  1969.         (void) Tcl_DeleteCommand(interp, cmdName);
  1970.     }
  1971.     Tcl_DeleteHashTable(&(masterPtr->slaveTable));
  1972.  
  1973.     for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
  1974.          hPtr != NULL;
  1975.          hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
  1976.         targetPtr = (Target *) Tcl_GetHashValue(hPtr);
  1977.         cmdName = Tcl_GetCommandName(targetPtr->slaveInterp,
  1978.             targetPtr->slaveCmd);
  1979.         (void) Tcl_DeleteCommand(targetPtr->slaveInterp, cmdName);
  1980.     }
  1981.     Tcl_DeleteHashTable(&(masterPtr->targetTable));
  1982.  
  1983.     ckfree((char *) masterPtr);
  1984. }
  1985.  
  1986. /*
  1987.  *----------------------------------------------------------------------
  1988.  *
  1989.  * SlaveRecordDeleteProc --
  1990.  *
  1991.  *    Is invoked when an interpreter (which is using the interp facility)
  1992.  *    is deleted, and it cleans up the storage associated with the
  1993.  *    tclSlaveRecord assoc-data entry.
  1994.  *
  1995.  * Results:
  1996.  *    None
  1997.  *
  1998.  * Side effects:
  1999.  *    Cleans up storage.
  2000.  *
  2001.  *----------------------------------------------------------------------
  2002.  */
  2003.  
  2004. static void
  2005. SlaveRecordDeleteProc(clientData, interp)
  2006.     ClientData    clientData;        /* Slave record for deleted interp. */
  2007.     Tcl_Interp *interp;            /* Interpreter being deleted. */
  2008. {
  2009.     Slave *slavePtr;            /* Interim storage. */
  2010.     Alias *aliasPtr;
  2011.     Tcl_HashTable *hTblPtr;
  2012.     Tcl_HashEntry *hPtr;
  2013.     Tcl_HashSearch hSearch;
  2014.     
  2015.     slavePtr = (Slave *) clientData;
  2016.  
  2017.     /*
  2018.      * In every case that we call SetAssocData on "tclSlaveRecord",
  2019.      * slavePtr is not NULL. Otherwise we panic.
  2020.      */
  2021.  
  2022.     if (slavePtr == NULL) {
  2023.     panic("SlaveRecordDeleteProc: NULL slavePtr");
  2024.     }
  2025.  
  2026.     if (slavePtr->interpCmd != (Tcl_Command) NULL) {
  2027.     Command *cmdPtr = (Command *) slavePtr->interpCmd;
  2028.  
  2029.     /*
  2030.      * The interpCmd has not been deleted in the master yet,  since
  2031.      * it's callback sets interpCmd to NULL.
  2032.      *
  2033.      * Probably Tcl_DeleteInterp() was called on this interpreter directly,
  2034.      * rather than via "interp delete", or equivalent (deletion of the
  2035.      * command in the master).
  2036.      *
  2037.      * Perform the cleanup done by SlaveObjectDeleteProc() directly,
  2038.      * and turn off the callback now (since we are about to free slavePtr
  2039.      * and this interpreter is going away, while the deletion of commands
  2040.      * in the master may be deferred).
  2041.      */
  2042.  
  2043.     Tcl_DeleteHashEntry(slavePtr->slaveEntry);
  2044.     cmdPtr->clientData = NULL;
  2045.     cmdPtr->deleteProc = NULL;
  2046.     cmdPtr->deleteData = NULL;
  2047.  
  2048.         /*
  2049.          * Get the command name from the master interpreter instead of
  2050.          * relying on the stored name; the command may have been renamed.
  2051.          */
  2052.         
  2053.     Tcl_DeleteCommand(slavePtr->masterInterp,
  2054.                 Tcl_GetCommandName(slavePtr->masterInterp,
  2055.                         slavePtr->interpCmd));
  2056.     }
  2057.  
  2058.     /*
  2059.      * If there are any aliases, delete those now. This removes any
  2060.      * dependency on the order of deletion between commands and the
  2061.      * slave record.
  2062.      */
  2063.  
  2064.     hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
  2065.     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
  2066.              hPtr != (Tcl_HashEntry *) NULL;
  2067.              hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
  2068.         aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  2069.  
  2070.         /*
  2071.          * The call to Tcl_DeleteCommand will release the storage
  2072.          * occuppied by the hash entry and the alias record.
  2073.          * NOTE that we cannot use the alias name directly because its
  2074.          * storage will be deleted in the command deletion callback. Hence
  2075.          * we must use the name for the command as stored in the hash table.
  2076.          */
  2077.  
  2078.         Tcl_DeleteCommand(interp,
  2079.                 Tcl_GetCommandName(interp, aliasPtr->slaveCmd));
  2080.     }
  2081.         
  2082.     /*
  2083.      * Finally dispose of the slave record itself.
  2084.      */
  2085.     
  2086.     ckfree((char *) slavePtr);    
  2087. }
  2088.  
  2089. /*
  2090.  *----------------------------------------------------------------------
  2091.  *
  2092.  * TclInterpInit --
  2093.  *
  2094.  *    Initializes the invoking interpreter for using the "interp"
  2095.  *    facility. This is called from inside Tcl_Init.
  2096.  *
  2097.  * Results:
  2098.  *    None.
  2099.  *
  2100.  * Side effects:
  2101.  *    Adds the "interp" command to an interpreter and initializes several
  2102.  *    records in the associated data of the invoking interpreter.
  2103.  *
  2104.  *----------------------------------------------------------------------
  2105.  */
  2106.  
  2107. int
  2108. TclInterpInit(interp)
  2109.     Tcl_Interp *interp;            /* Interpreter to initialize. */
  2110. {
  2111.     Master *masterPtr;            /* Its Master record. */
  2112.  
  2113.     masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
  2114.     masterPtr->isSafe = 0;
  2115.     Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
  2116.     Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);
  2117.  
  2118.     (void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
  2119.             (ClientData) masterPtr);
  2120.     
  2121.     return TCL_OK;
  2122. }
  2123.  
  2124. /*
  2125.  *----------------------------------------------------------------------
  2126.  *
  2127.  * Tcl_IsSafe --
  2128.  *
  2129.  *    Determines whether an interpreter is safe
  2130.  *
  2131.  * Results:
  2132.  *    1 if it is safe, 0 if it is not.
  2133.  *
  2134.  * Side effects:
  2135.  *    None.
  2136.  *
  2137.  *----------------------------------------------------------------------
  2138.  */
  2139.  
  2140. int
  2141. Tcl_IsSafe(interp)
  2142.     Tcl_Interp *interp;        /* Is this interpreter "safe" ? */
  2143. {
  2144.     Master *masterPtr;        /* Its master record. */
  2145.  
  2146.     if (interp == (Tcl_Interp *) NULL) {
  2147.         return 0;
  2148.     }
  2149.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  2150.     if (masterPtr == (Master *) NULL) {
  2151.         panic("Tcl_IsSafe: could not find master record");
  2152.     }
  2153.     return masterPtr->isSafe;
  2154. }
  2155.  
  2156. /*
  2157.  *----------------------------------------------------------------------
  2158.  *
  2159.  * Tcl_MakeSafe --
  2160.  *
  2161.  *    Makes an interpreter safe.
  2162.  *
  2163.  * Results:
  2164.  *    TCL_OK if it succeeds, TCL_ERROR else.
  2165.  *
  2166.  * Side effects:
  2167.  *    Removes functionality from an interpreter.
  2168.  *
  2169.  *----------------------------------------------------------------------
  2170.  */
  2171.  
  2172. int
  2173. Tcl_MakeSafe(interp)
  2174.     Tcl_Interp *interp;        /* Make this interpreter "safe". */
  2175. {
  2176.     if (interp == (Tcl_Interp *) NULL) {
  2177.         return TCL_ERROR;
  2178.     }
  2179.     return MakeSafe(interp);
  2180. }
  2181.  
  2182. /*
  2183.  *----------------------------------------------------------------------
  2184.  *
  2185.  * Tcl_CreateSlave --
  2186.  *
  2187.  *    Creates a slave interpreter. The slavePath argument denotes the
  2188.  *    name of the new slave relative to the current interpreter; the
  2189.  *    slave is a direct descendant of the one-before-last component of
  2190.  *    the path, e.g. it is a descendant of the current interpreter if
  2191.  *    the slavePath argument contains only one component. Optionally makes
  2192.  *    the slave interpreter safe.
  2193.  *
  2194.  * Results:
  2195.  *    Returns the interpreter structure created, or NULL if an error
  2196.  *    occurred.
  2197.  *
  2198.  * Side effects:
  2199.  *    Creates a new interpreter and a new interpreter object command in
  2200.  *    the interpreter indicated by the slavePath argument.
  2201.  *
  2202.  *----------------------------------------------------------------------
  2203.  */
  2204.  
  2205. Tcl_Interp *
  2206. Tcl_CreateSlave(interp, slavePath, isSafe)
  2207.     Tcl_Interp *interp;        /* Interpreter to start search at. */
  2208.     char *slavePath;        /* Name of slave to create. */
  2209.     int isSafe;            /* Should new slave be "safe" ? */
  2210. {
  2211.     if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
  2212.         return NULL;
  2213.     }
  2214.     return CreateSlave(interp, slavePath, isSafe);
  2215. }
  2216.  
  2217. /*
  2218.  *----------------------------------------------------------------------
  2219.  *
  2220.  * Tcl_GetSlave --
  2221.  *
  2222.  *    Finds a slave interpreter by its path name.
  2223.  *
  2224.  * Results:
  2225.  *    Returns a Tcl_Interp * for the named interpreter or NULL if not
  2226.  *    found.
  2227.  *
  2228.  * Side effects:
  2229.  *    None.
  2230.  *
  2231.  *----------------------------------------------------------------------
  2232.  */
  2233.  
  2234. Tcl_Interp *
  2235. Tcl_GetSlave(interp, slavePath)
  2236.     Tcl_Interp *interp;        /* Interpreter to start search from. */
  2237.     char *slavePath;        /* Path of slave to find. */
  2238. {
  2239.     Master *masterPtr;        /* Interim storage for Master record. */
  2240.  
  2241.     if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
  2242.         return NULL;
  2243.     }
  2244.     masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
  2245.     if (masterPtr == (Master *) NULL) {
  2246.         panic("Tcl_GetSlave: could not find master record");
  2247.     }
  2248.     return GetInterp(interp, masterPtr, slavePath, NULL);
  2249. }
  2250.  
  2251. /*
  2252.  *----------------------------------------------------------------------
  2253.  *
  2254.  * Tcl_GetMaster --
  2255.  *
  2256.  *    Finds the master interpreter of a slave interpreter.
  2257.  *
  2258.  * Results:
  2259.  *    Returns a Tcl_Interp * for the master interpreter or NULL if none.
  2260.  *
  2261.  * Side effects:
  2262.  *    None.
  2263.  *
  2264.  *----------------------------------------------------------------------
  2265.  */
  2266.  
  2267. Tcl_Interp *
  2268. Tcl_GetMaster(interp)
  2269.     Tcl_Interp *interp;        /* Get the master of this interpreter. */
  2270. {
  2271.     Slave *slavePtr;        /* Slave record of this interpreter. */
  2272.  
  2273.     if (interp == (Tcl_Interp *) NULL) {
  2274.         return NULL;
  2275.     }
  2276.     slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
  2277.     if (slavePtr == (Slave *) NULL) {
  2278.         return NULL;
  2279.     }
  2280.     return slavePtr->masterInterp;
  2281. }
  2282.  
  2283. /*
  2284.  *----------------------------------------------------------------------
  2285.  *
  2286.  * Tcl_CreateAlias --
  2287.  *
  2288.  *    Creates an alias between two interpreters.
  2289.  *
  2290.  * Results:
  2291.  *    TCL_OK if successful, TCL_ERROR if failed. If TCL_ERROR is returned
  2292.  *    the result of slaveInterp will contain an error message.
  2293.  *
  2294.  * Side effects:
  2295.  *    Creates a new alias, manipulates the result field of slaveInterp.
  2296.  *
  2297.  *----------------------------------------------------------------------
  2298.  */
  2299.  
  2300. int
  2301. Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
  2302.     Tcl_Interp *slaveInterp;        /* Interpreter for source command. */
  2303.     char *slaveCmd;            /* Command to install in slave. */
  2304.     Tcl_Interp *targetInterp;        /* Interpreter for target command. */
  2305.     char *targetCmd;            /* Name of target command. */
  2306.     int argc;                /* How many additional arguments? */
  2307.     char **argv;            /* These are the additional args. */
  2308. {
  2309.     Master *masterPtr;            /* Master record for target interp. */
  2310.  
  2311.     if ((slaveInterp == (Tcl_Interp *) NULL) ||
  2312.             (targetInterp == (Tcl_Interp *) NULL) ||
  2313.             (slaveCmd == (char *) NULL) ||
  2314.             (targetCmd == (char *) NULL)) {
  2315.         return TCL_ERROR;
  2316.     }
  2317.     masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
  2318.             NULL);
  2319.     if (masterPtr == (Master *) NULL) {
  2320.         panic("Tcl_CreateAlias: could not find master record");
  2321.     }
  2322.     return AliasHelper(slaveInterp, slaveInterp, targetInterp, masterPtr,
  2323.             slaveCmd, targetCmd, argc, argv);
  2324. }
  2325.  
  2326. /*
  2327.  *----------------------------------------------------------------------
  2328.  *
  2329.  * Tcl_GetAlias --
  2330.  *
  2331.  *    Gets information about an alias.
  2332.  *
  2333.  * Results:
  2334.  *    TCL_OK if successful, TCL_ERROR else. If TCL_ERROR is returned, the
  2335.  *    result field of the interpreter given as argument will contain an
  2336.  *    error message.
  2337.  *
  2338.  * Side effects:
  2339.  *    Manipulates the result field of the interpreter given as argument.
  2340.  *
  2341.  *----------------------------------------------------------------------
  2342.  */
  2343.  
  2344. int
  2345. Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
  2346.         argvPtr)
  2347.     Tcl_Interp *interp;            /* Interp to start search from. */
  2348.     char *aliasName;            /* Name of alias to find. */
  2349.     Tcl_Interp **targetInterpPtr;    /* (Return) target interpreter. */
  2350.     char **targetNamePtr;        /* (Return) name of target command. */
  2351.     int *argcPtr;            /* (Return) count of addnl args. */
  2352.     char ***argvPtr;            /* (Return) additional arguments. */
  2353. {
  2354.     Slave *slavePtr;            /* Slave record for slave interp. */
  2355.     Tcl_HashEntry *hPtr;        /* Search element. */
  2356.     Alias *aliasPtr;            /* Storage for alias found. */
  2357.  
  2358.     if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
  2359.         return TCL_ERROR;
  2360.     }
  2361.     slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
  2362.     if (slavePtr == (Slave *) NULL) {
  2363.         panic("Tcl_GetAlias: could not find slave record");
  2364.     }
  2365.     hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
  2366.     if (hPtr == (Tcl_HashEntry *) NULL) {
  2367.         Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
  2368.                 (char *) NULL);
  2369.         return TCL_ERROR;
  2370.     }
  2371.     aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
  2372.     if (targetInterpPtr != (Tcl_Interp **) NULL) {
  2373.         *targetInterpPtr = aliasPtr->targetInterp;
  2374.     }
  2375.     if (targetNamePtr != (char **) NULL) {
  2376.         *targetNamePtr = aliasPtr->targetName;
  2377.     }
  2378.     if (argcPtr != (int *) NULL) {
  2379.         *argcPtr = aliasPtr->argc;
  2380.     }
  2381.     if (argvPtr != (char ***) NULL) {
  2382.         *argvPtr = aliasPtr->argv;
  2383.     }
  2384.     return TCL_OK;
  2385. }
  2386.