home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcl2-73c.zip / tcl7.3 / tclbasic.c < prev    next >
C/C++ Source or Header  |  1994-09-16  |  39KB  |  1,375 lines
  1. /* 
  2.  * tclBasic.c --
  3.  *
  4.  *    Contains the basic facilities for TCL command interpretation,
  5.  *    including interpreter creation and deletion, command creation
  6.  *    and deletion, and command parsing and execution.
  7.  *
  8.  * Copyright (c) 1987-1993 The Regents of the University of California.
  9.  * All rights reserved.
  10.  *
  11.  * Permission is hereby granted, without written agreement and without
  12.  * license or royalty fees, to use, copy, modify, and distribute this
  13.  * software and its documentation for any purpose, provided that the
  14.  * above copyright notice and the following two paragraphs appear in
  15.  * all copies of this software.
  16.  * 
  17.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  18.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  19.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  20.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  21.  *
  22.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  23.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  24.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  25.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  26.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  27.  */
  28.  
  29. #ifndef lint
  30. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclBasic.c,v 1.153 93/09/09 16:43:19 ouster Exp $ SPRITE (Berkeley)";
  31. #endif
  32.  
  33. #include "tclInt.h"
  34. #ifndef TCL_GENERIC_ONLY
  35. #   include "tclUnix.h"
  36. #endif
  37.  
  38. /*
  39.  * The following structure defines all of the commands in the Tcl core,
  40.  * and the C procedures that execute them.
  41.  */
  42.  
  43. typedef struct {
  44.     char *name;            /* Name of command. */
  45.     Tcl_CmdProc *proc;        /* Procedure that executes command. */
  46. } CmdInfo;
  47.  
  48. /*
  49.  * Built-in commands, and the procedures associated with them:
  50.  */
  51.  
  52. static CmdInfo builtInCmds[] = {
  53.     /*
  54.      * Commands in the generic core:
  55.      */
  56.  
  57.     {"append",        Tcl_AppendCmd},
  58.     {"array",        Tcl_ArrayCmd},
  59.     {"break",        Tcl_BreakCmd},
  60.     {"case",        Tcl_CaseCmd},
  61.     {"catch",        Tcl_CatchCmd},
  62.     {"concat",        Tcl_ConcatCmd},
  63.     {"continue",    Tcl_ContinueCmd},
  64.     {"error",        Tcl_ErrorCmd},
  65.     {"eval",        Tcl_EvalCmd},
  66.     {"expr",        Tcl_ExprCmd},
  67.     {"for",        Tcl_ForCmd},
  68.     {"foreach",        Tcl_ForeachCmd},
  69.     {"format",        Tcl_FormatCmd},
  70.     {"global",        Tcl_GlobalCmd},
  71.     {"history",        Tcl_HistoryCmd},
  72.     {"if",        Tcl_IfCmd},
  73.     {"incr",        Tcl_IncrCmd},
  74.     {"info",        Tcl_InfoCmd},
  75.     {"join",        Tcl_JoinCmd},
  76.     {"lappend",        Tcl_LappendCmd},
  77.     {"lindex",        Tcl_LindexCmd},
  78.     {"linsert",        Tcl_LinsertCmd},
  79.     {"list",        Tcl_ListCmd},
  80.     {"llength",        Tcl_LlengthCmd},
  81.     {"lrange",        Tcl_LrangeCmd},
  82.     {"lreplace",    Tcl_LreplaceCmd},
  83.     {"lsearch",        Tcl_LsearchCmd},
  84.     {"lsort",        Tcl_LsortCmd},
  85.     {"proc",        Tcl_ProcCmd},
  86.     {"regexp",        Tcl_RegexpCmd},
  87.     {"regsub",        Tcl_RegsubCmd},
  88.     {"rename",        Tcl_RenameCmd},
  89.     {"return",        Tcl_ReturnCmd},
  90.     {"scan",        Tcl_ScanCmd},
  91.     {"set",        Tcl_SetCmd},
  92.     {"split",        Tcl_SplitCmd},
  93.     {"string",        Tcl_StringCmd},
  94.     {"switch",        Tcl_SwitchCmd},
  95.     {"trace",        Tcl_TraceCmd},
  96.     {"unset",        Tcl_UnsetCmd},
  97.     {"uplevel",        Tcl_UplevelCmd},
  98.     {"upvar",        Tcl_UpvarCmd},
  99.     {"while",        Tcl_WhileCmd},
  100.  
  101.     /*
  102.      * Commands in the UNIX core:
  103.      */
  104.  
  105. #ifdef __OS2__
  106.     {"system",        Tcl_SystemCmd},
  107. #endif
  108.  
  109. #ifndef TCL_GENERIC_ONLY
  110.     {"cd",        Tcl_CdCmd},
  111.     {"close",        Tcl_CloseCmd},
  112.     {"eof",        Tcl_EofCmd},
  113.     {"exec",        Tcl_ExecCmd},
  114.     {"exit",        Tcl_ExitCmd},
  115.     {"file",        Tcl_FileCmd},
  116.     {"flush",        Tcl_FlushCmd},
  117.     {"gets",        Tcl_GetsCmd},
  118.     {"glob",        Tcl_GlobCmd},
  119.     {"open",        Tcl_OpenCmd},
  120.     {"pid",        Tcl_PidCmd},
  121.     {"puts",        Tcl_PutsCmd},
  122.     {"pwd",        Tcl_PwdCmd},
  123.     {"read",        Tcl_ReadCmd},
  124.     {"seek",        Tcl_SeekCmd},
  125.     {"source",        Tcl_SourceCmd},
  126.     {"tell",        Tcl_TellCmd},
  127.     {"time",        Tcl_TimeCmd},
  128. #endif /* TCL_GENERIC_ONLY */
  129.     {NULL,        (Tcl_CmdProc *) NULL}
  130. };
  131.  
  132. /*
  133.  *----------------------------------------------------------------------
  134.  *
  135.  * Tcl_CreateInterp --
  136.  *
  137.  *    Create a new TCL command interpreter.
  138.  *
  139.  * Results:
  140.  *    The return value is a token for the interpreter, which may be
  141.  *    used in calls to procedures like Tcl_CreateCmd, Tcl_Eval, or
  142.  *    Tcl_DeleteInterp.
  143.  *
  144.  * Side effects:
  145.  *    The command interpreter is initialized with an empty variable
  146.  *    table and the built-in commands.  SIGPIPE signals are set to
  147.  *    be ignored (see comment below for details).
  148.  *
  149.  *----------------------------------------------------------------------
  150.  */
  151.  
  152. Tcl_Interp *
  153. Tcl_CreateInterp()
  154. {
  155.     register Interp *iPtr;
  156.     register Command *cmdPtr;
  157.     register CmdInfo *cmdInfoPtr;
  158.     int i;
  159.     static int firstInterp = 1;
  160.  
  161.     iPtr = (Interp *) ckalloc(sizeof(Interp));
  162.     iPtr->result = iPtr->resultSpace;
  163.     iPtr->freeProc = 0;
  164.     iPtr->errorLine = 0;
  165.     Tcl_InitHashTable(&iPtr->commandTable, TCL_STRING_KEYS);
  166.     Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
  167.     Tcl_InitHashTable(&iPtr->globalTable, TCL_STRING_KEYS);
  168.     iPtr->numLevels = 0;
  169.     iPtr->maxNestingDepth = 1000;
  170.     iPtr->framePtr = NULL;
  171.     iPtr->varFramePtr = NULL;
  172.     iPtr->activeTracePtr = NULL;
  173.     iPtr->returnCode = TCL_OK;
  174.     iPtr->errorInfo = NULL;
  175.     iPtr->errorCode = NULL;
  176.     iPtr->numEvents = 0;
  177.     iPtr->events = NULL;
  178.     iPtr->curEvent = 0;
  179.     iPtr->curEventNum = 0;
  180.     iPtr->revPtr = NULL;
  181.     iPtr->historyFirst = NULL;
  182.     iPtr->revDisables = 1;
  183.     iPtr->evalFirst = iPtr->evalLast = NULL;
  184.     iPtr->appendResult = NULL;
  185.     iPtr->appendAvl = 0;
  186.     iPtr->appendUsed = 0;
  187.     for (i = 0; i < NUM_REGEXPS; i++) {
  188.     iPtr->patterns[i] = NULL;
  189.     iPtr->patLengths[i] = -1;
  190.     iPtr->regexps[i] = NULL;
  191.     }
  192.     strcpy(iPtr->pdFormat, DEFAULT_PD_FORMAT);
  193.     iPtr->pdPrec = DEFAULT_PD_PREC;
  194.     iPtr->cmdCount = 0;
  195.     iPtr->noEval = 0;
  196.     iPtr->evalFlags = 0;
  197.     iPtr->scriptFile = NULL;
  198.     iPtr->flags = 0;
  199.     iPtr->tracePtr = NULL;
  200.     iPtr->deleteCallbackPtr = NULL;
  201.     iPtr->resultSpace[0] = 0;
  202.  
  203.     /*
  204.      * Create the built-in commands.  Do it here, rather than calling
  205.      * Tcl_CreateCommand, because it's faster (there's no need to
  206.      * check for a pre-existing command by the same name).
  207.      */
  208.  
  209.     for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
  210.     int new;
  211.     Tcl_HashEntry *hPtr;
  212.  
  213.     hPtr = Tcl_CreateHashEntry(&iPtr->commandTable,
  214.         cmdInfoPtr->name, &new);
  215.     if (new) {
  216.         cmdPtr = (Command *) ckalloc(sizeof(Command));
  217.         cmdPtr->proc = cmdInfoPtr->proc;
  218.         cmdPtr->clientData = (ClientData) NULL;
  219.         cmdPtr->deleteProc = NULL;
  220.         cmdPtr->deleteData = (ClientData) NULL;
  221.         Tcl_SetHashValue(hPtr, cmdPtr);
  222.     }
  223.     }
  224.  
  225. #ifndef TCL_GENERIC_ONLY
  226.     TclSetupEnv((Tcl_Interp *) iPtr);
  227.  
  228.     /*
  229.      * The code below causes SIGPIPE (broken pipe) errors to
  230.      * be ignored.  This is needed so that Tcl processes don't
  231.      * die if they create child processes (e.g. using "exec" or
  232.      * "open") that terminate prematurely.  The signal handler
  233.      * is only set up when the first interpreter is created; 
  234.      * after this the application can override the handler with
  235.      * a different one of its own, if it wants.
  236.      */
  237.  
  238.     if (firstInterp) {
  239. #ifndef __OS2__
  240.     (void) signal(SIGPIPE, SIG_IGN);
  241. #endif
  242.     firstInterp = 0;
  243.     }
  244. #endif
  245.  
  246.     Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
  247.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  248.         TclPrecTraceProc, (ClientData) NULL);
  249.     return (Tcl_Interp *) iPtr;
  250. }
  251.  
  252. /*
  253.  *----------------------------------------------------------------------
  254.  *
  255.  * Tcl_Init --
  256.  *
  257.  *    This procedure is typically invoked by Tcl_AppInit procedures
  258.  *    to perform additional initialization for a Tcl interpreter,
  259.  *    such as sourcing the "init.tcl" script.
  260.  *
  261.  * Results:
  262.  *    Returns a standard Tcl completion code and sets interp->result
  263.  *    if there is an error.
  264.  *
  265.  * Side effects:
  266.  *    Depends on what's in the init.tcl script.
  267.  *
  268.  *----------------------------------------------------------------------
  269.  */
  270.  
  271. int
  272. Tcl_Init(interp)
  273.     Tcl_Interp *interp;        /* Interpreter to initialize. */
  274. {
  275.     static char initCmd[] =
  276.     "if [file exists [info library]/init.tcl] {\n\
  277.         source [info library]/init.tcl\n\
  278.     } else {\n\
  279.         set msg \"can't find [info library]/init.tcl; perhaps you \"\n\
  280.         append msg \"need to\\ninstall Tcl or set your TCL_LIBRARY \"\n\
  281.         append msg \"environment variable?\"\n\
  282.         error $msg\n\
  283.     }";
  284.     return Tcl_Eval(interp, initCmd);
  285. }
  286.  
  287. /*
  288.  *--------------------------------------------------------------
  289.  *
  290.  * Tcl_CallWhenDeleted --
  291.  *
  292.  *    Arrange for a procedure to be called before a given
  293.  *    interpreter is deleted.
  294.  *
  295.  * Results:
  296.  *    None.
  297.  *
  298.  * Side effects:
  299.  *    When Tcl_DeleteInterp is invoked to delete interp,
  300.  *    proc will be invoked.  See the manual entry for
  301.  *    details.
  302.  *
  303.  *--------------------------------------------------------------
  304.  */
  305.  
  306. void
  307. Tcl_CallWhenDeleted(interp, proc, clientData)
  308.     Tcl_Interp *interp;        /* Interpreter to watch. */
  309.     Tcl_InterpDeleteProc *proc;    /* Procedure to call when interpreter
  310.                  * is about to be deleted. */
  311.     ClientData clientData;    /* One-word value to pass to proc. */
  312. {
  313.     DeleteCallback *dcPtr, *prevPtr;
  314.     Interp *iPtr = (Interp *) interp;
  315.  
  316.     dcPtr = (DeleteCallback *) ckalloc(sizeof(DeleteCallback));
  317.     dcPtr->proc = proc;
  318.     dcPtr->clientData = clientData;
  319.     dcPtr->nextPtr = NULL;
  320.     if (iPtr->deleteCallbackPtr == NULL) {
  321.     iPtr->deleteCallbackPtr = dcPtr;
  322.     } else {
  323.     prevPtr = iPtr->deleteCallbackPtr;
  324.     while (prevPtr->nextPtr != NULL) {
  325.         prevPtr = prevPtr->nextPtr;
  326.     }
  327.     prevPtr->nextPtr = dcPtr;
  328.     }
  329. }
  330.  
  331. /*
  332.  *--------------------------------------------------------------
  333.  *
  334.  * Tcl_DontCallWhenDeleted --
  335.  *
  336.  *    Cancel the arrangement for a procedure to be called when
  337.  *    a given interpreter is deleted.
  338.  *
  339.  * Results:
  340.  *    None.
  341.  *
  342.  * Side effects:
  343.  *    If proc and clientData were previously registered as a
  344.  *    callback via Tcl_CallWhenDeleted, they are unregistered.
  345.  *    If they weren't previously registered then nothing
  346.  *    happens.
  347.  *
  348.  *--------------------------------------------------------------
  349.  */
  350.  
  351. void
  352. Tcl_DontCallWhenDeleted(interp, proc, clientData)
  353.     Tcl_Interp *interp;        /* Interpreter to watch. */
  354.     Tcl_InterpDeleteProc *proc;    /* Procedure to call when interpreter
  355.                  * is about to be deleted. */
  356.     ClientData clientData;    /* One-word value to pass to proc. */
  357. {
  358.     DeleteCallback *prevPtr, *dcPtr;
  359.     Interp *iPtr = (Interp *) interp;
  360.  
  361.     for (prevPtr = NULL, dcPtr = iPtr->deleteCallbackPtr;
  362.         dcPtr != NULL; prevPtr = dcPtr, dcPtr = dcPtr->nextPtr) {
  363.     if ((dcPtr->proc != proc) || (dcPtr->clientData != clientData)) {
  364.         continue;
  365.     }
  366.     if (prevPtr == NULL) {
  367.         iPtr->deleteCallbackPtr = dcPtr->nextPtr;
  368.     } else {
  369.         prevPtr->nextPtr = dcPtr->nextPtr;
  370.     }
  371.     ckfree((char *) dcPtr);
  372.     break;
  373.     }
  374. }
  375.  
  376. /*
  377.  *----------------------------------------------------------------------
  378.  *
  379.  * Tcl_DeleteInterp --
  380.  *
  381.  *    Delete an interpreter and free up all of the resources associated
  382.  *    with it.
  383.  *
  384.  * Results:
  385.  *    None.
  386.  *
  387.  * Side effects:
  388.  *    The interpreter is destroyed.  The caller should never again
  389.  *    use the interp token.
  390.  *
  391.  *----------------------------------------------------------------------
  392.  */
  393.  
  394. void
  395. Tcl_DeleteInterp(interp)
  396.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  397.                  * by a previous call to Tcl_CreateInterp). */
  398. {
  399.     Interp *iPtr = (Interp *) interp;
  400.     Tcl_HashEntry *hPtr;
  401.     Tcl_HashSearch search;
  402.     register Command *cmdPtr;
  403.     DeleteCallback *dcPtr;
  404.     int i;
  405.  
  406.     /*
  407.      * If the interpreter is in use, delay the deletion until later.
  408.      */
  409.  
  410.     iPtr->flags |= DELETED;
  411.     if (iPtr->numLevels != 0) {
  412.     return;
  413.     }
  414.  
  415.     /*
  416.      * Invoke deletion callbacks.
  417.      */
  418.  
  419.     while (iPtr->deleteCallbackPtr != NULL) {
  420.     dcPtr = iPtr->deleteCallbackPtr;
  421.     iPtr->deleteCallbackPtr = dcPtr->nextPtr;
  422.     (*dcPtr->proc)(dcPtr->clientData, interp);
  423.     ckfree((char *) dcPtr);
  424.     }
  425.  
  426.     /*
  427.      * Free up any remaining resources associated with the
  428.      * interpreter.
  429.      */
  430.  
  431.     for (hPtr = Tcl_FirstHashEntry(&iPtr->commandTable, &search);
  432.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  433.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  434.     if (cmdPtr->deleteProc != NULL) { 
  435.         (*cmdPtr->deleteProc)(cmdPtr->deleteData);
  436.     }
  437.     ckfree((char *) cmdPtr);
  438.     }
  439.     Tcl_DeleteHashTable(&iPtr->commandTable);
  440.     for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
  441.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  442.     ckfree((char *) Tcl_GetHashValue(hPtr));
  443.     }
  444.     Tcl_DeleteHashTable(&iPtr->mathFuncTable);
  445.     TclDeleteVars(iPtr, &iPtr->globalTable);
  446.  
  447.     /*
  448.      * Free up the result *after* deleting variables, since variable
  449.      * deletion could have transferred ownership of the result string
  450.      * to Tcl.
  451.      */
  452.  
  453.     Tcl_FreeResult(interp);
  454.     if (iPtr->errorInfo != NULL) {
  455.     ckfree(iPtr->errorInfo);
  456.     }
  457.     if (iPtr->errorCode != NULL) {
  458.     ckfree(iPtr->errorCode);
  459.     }
  460.     if (iPtr->events != NULL) {
  461.     int i;
  462.  
  463.     for (i = 0; i < iPtr->numEvents; i++) {
  464.         ckfree(iPtr->events[i].command);
  465.     }
  466.     ckfree((char *) iPtr->events);
  467.     }
  468.     while (iPtr->revPtr != NULL) {
  469.     HistoryRev *nextPtr = iPtr->revPtr->nextPtr;
  470.  
  471.     ckfree((char *) iPtr->revPtr);
  472.     iPtr->revPtr = nextPtr;
  473.     }
  474.     if (iPtr->appendResult != NULL) {
  475.     ckfree(iPtr->appendResult);
  476.     }
  477.     for (i = 0; i < NUM_REGEXPS; i++) {
  478.     if (iPtr->patterns[i] == NULL) {
  479.         break;
  480.     }
  481.     ckfree(iPtr->patterns[i]);
  482.     ckfree((char *) iPtr->regexps[i]);
  483.     }
  484.     while (iPtr->tracePtr != NULL) {
  485.     Trace *nextPtr = iPtr->tracePtr->nextPtr;
  486.  
  487.     ckfree((char *) iPtr->tracePtr);
  488.     iPtr->tracePtr = nextPtr;
  489.     }
  490.     ckfree((char *) iPtr);
  491. }
  492.  
  493. /*
  494.  *----------------------------------------------------------------------
  495.  *
  496.  * Tcl_CreateCommand --
  497.  *
  498.  *    Define a new command in a command table.
  499.  *
  500.  * Results:
  501.  *    None.
  502.  *
  503.  * Side effects:
  504.  *    If a command named cmdName already exists for interp, it is
  505.  *    deleted.  In the future, when cmdName is seen as the name of
  506.  *    a command by Tcl_Eval, proc will be called.  When the command
  507.  *    is deleted from the table, deleteProc will be called.  See the
  508.  *    manual entry for details on the calling sequence.
  509.  *
  510.  *----------------------------------------------------------------------
  511.  */
  512.  
  513. void
  514. Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc)
  515.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  516.                  * by a previous call to Tcl_CreateInterp). */
  517.     char *cmdName;        /* Name of command. */
  518.     Tcl_CmdProc *proc;        /* Command procedure to associate with
  519.                  * cmdName. */
  520.     ClientData clientData;    /* Arbitrary one-word value to pass to proc. */
  521.     Tcl_CmdDeleteProc *deleteProc;
  522.                 /* If not NULL, gives a procedure to call when
  523.                  * this command is deleted. */
  524. {
  525.     Interp *iPtr = (Interp *) interp;
  526.     register Command *cmdPtr;
  527.     Tcl_HashEntry *hPtr;
  528.     int new;
  529.  
  530.     hPtr = Tcl_CreateHashEntry(&iPtr->commandTable, cmdName, &new);
  531.     if (!new) {
  532.     /*
  533.      * Command already exists:  delete the old one.
  534.      */
  535.  
  536.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  537.     if (cmdPtr->deleteProc != NULL) {
  538.         (*cmdPtr->deleteProc)(cmdPtr->deleteData);
  539.     }
  540.     } else {
  541.     cmdPtr = (Command *) ckalloc(sizeof(Command));
  542.     Tcl_SetHashValue(hPtr, cmdPtr);
  543.     }
  544.     cmdPtr->proc = proc;
  545.     cmdPtr->clientData = clientData;
  546.     cmdPtr->deleteProc = deleteProc;
  547.     cmdPtr->deleteData = clientData;
  548. }
  549.  
  550. /*
  551.  *----------------------------------------------------------------------
  552.  *
  553.  * Tcl_SetCommandInfo --
  554.  *
  555.  *    Modifies various information about a Tcl command.
  556.  *
  557.  * Results:
  558.  *    If cmdName exists in interp, then the information at *infoPtr
  559.  *    is stored with the command in place of the current information
  560.  *    and 1 is returned.  If the command doesn't exist then 0 is
  561.  *    returned.
  562.  *
  563.  * Side effects:
  564.  *    None.
  565.  *
  566.  *----------------------------------------------------------------------
  567.  */
  568.  
  569. int
  570. Tcl_SetCommandInfo(interp, cmdName, infoPtr)
  571.     Tcl_Interp *interp;            /* Interpreter in which to look
  572.                      * for command. */
  573.     char *cmdName;            /* Name of desired command. */
  574.     Tcl_CmdInfo *infoPtr;        /* Where to store information about
  575.                      * command. */
  576. {
  577.     Tcl_HashEntry *hPtr;
  578.     Command *cmdPtr;
  579.  
  580.     hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
  581.     if (hPtr == NULL) {
  582.     return 0;
  583.     }
  584.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  585.     cmdPtr->proc = infoPtr->proc;
  586.     cmdPtr->clientData = infoPtr->clientData;
  587.     cmdPtr->deleteProc = infoPtr->deleteProc;
  588.     cmdPtr->deleteData = infoPtr->deleteData;
  589.     return 1;
  590. }
  591.  
  592. /*
  593.  *----------------------------------------------------------------------
  594.  *
  595.  * Tcl_GetCommandInfo --
  596.  *
  597.  *    Returns various information about a Tcl command.
  598.  *
  599.  * Results:
  600.  *    If cmdName exists in interp, then *infoPtr is modified to
  601.  *    hold information about cmdName and 1 is returned.  If the
  602.  *    command doesn't exist then 0 is returned and *infoPtr isn't
  603.  *    modified.
  604.  *
  605.  * Side effects:
  606.  *    None.
  607.  *
  608.  *----------------------------------------------------------------------
  609.  */
  610.  
  611. int
  612. Tcl_GetCommandInfo(interp, cmdName, infoPtr)
  613.     Tcl_Interp *interp;            /* Interpreter in which to look
  614.                      * for command. */
  615.     char *cmdName;            /* Name of desired command. */
  616.     Tcl_CmdInfo *infoPtr;        /* Where to store information about
  617.                      * command. */
  618. {
  619.     Tcl_HashEntry *hPtr;
  620.     Command *cmdPtr;
  621.  
  622.     hPtr = Tcl_FindHashEntry(&((Interp *) interp)->commandTable, cmdName);
  623.     if (hPtr == NULL) {
  624.     return 0;
  625.     }
  626.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  627.     infoPtr->proc = cmdPtr->proc;
  628.     infoPtr->clientData = cmdPtr->clientData;
  629.     infoPtr->deleteProc = cmdPtr->deleteProc;
  630.     infoPtr->deleteData = cmdPtr->deleteData;
  631.     return 1;
  632. }
  633.  
  634. /*
  635.  *----------------------------------------------------------------------
  636.  *
  637.  * Tcl_DeleteCommand --
  638.  *
  639.  *    Remove the given command from the given interpreter.
  640.  *
  641.  * Results:
  642.  *    0 is returned if the command was deleted successfully.
  643.  *    -1 is returned if there didn't exist a command by that
  644.  *    name.
  645.  *
  646.  * Side effects:
  647.  *    CmdName will no longer be recognized as a valid command for
  648.  *    interp.
  649.  *
  650.  *----------------------------------------------------------------------
  651.  */
  652.  
  653. int
  654. Tcl_DeleteCommand(interp, cmdName)
  655.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  656.                  * by a previous call to Tcl_CreateInterp). */
  657.     char *cmdName;        /* Name of command to remove. */
  658. {
  659.     Interp *iPtr = (Interp *) interp;
  660.     Tcl_HashEntry *hPtr;
  661.     Command *cmdPtr;
  662.  
  663.     hPtr = Tcl_FindHashEntry(&iPtr->commandTable, cmdName);
  664.     if (hPtr == NULL) {
  665.     return -1;
  666.     }
  667.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  668.     if (cmdPtr->deleteProc != NULL) {
  669.     (*cmdPtr->deleteProc)(cmdPtr->deleteData);
  670.     }
  671.     ckfree((char *) cmdPtr);
  672.     Tcl_DeleteHashEntry(hPtr);
  673.     return 0;
  674. }
  675.  
  676. /*
  677.  *-----------------------------------------------------------------
  678.  *
  679.  * Tcl_Eval --
  680.  *
  681.  *    Parse and execute a command in the Tcl language.
  682.  *
  683.  * Results:
  684.  *    The return value is one of the return codes defined in tcl.hd
  685.  *    (such as TCL_OK), and interp->result contains a string value
  686.  *    to supplement the return code.  The value of interp->result
  687.  *    will persist only until the next call to Tcl_Eval:  copy it or
  688.  *    lose it! *TermPtr is filled in with the character just after
  689.  *    the last one that was part of the command (usually a NULL
  690.  *    character or a closing bracket).
  691.  *
  692.  * Side effects:
  693.  *    Almost certainly;  depends on the command.
  694.  *
  695.  *-----------------------------------------------------------------
  696.  */
  697.  
  698. int
  699. Tcl_Eval(interp, cmd)
  700.     Tcl_Interp *interp;        /* Token for command interpreter (returned
  701.                  * by a previous call to Tcl_CreateInterp). */
  702.     char *cmd;            /* Pointer to TCL command to interpret. */
  703. {
  704.     /*
  705.      * The storage immediately below is used to generate a copy
  706.      * of the command, after all argument substitutions.  Pv will
  707.      * contain the argv values passed to the command procedure.
  708.      */
  709.  
  710. #   define NUM_CHARS 200
  711.     char copyStorage[NUM_CHARS];
  712.     ParseValue pv;
  713.     char *oldBuffer;
  714.  
  715.     /*
  716.      * This procedure generates an (argv, argc) array for the command,
  717.      * It starts out with stack-allocated space but uses dynamically-
  718.      * allocated storage to increase it if needed.
  719.      */
  720.  
  721. #   define NUM_ARGS 10
  722.     char *(argStorage[NUM_ARGS]);
  723.     char **argv = argStorage;
  724.     int argc;
  725.     int argSize = NUM_ARGS;
  726.  
  727.     register char *src;            /* Points to current character
  728.                      * in cmd. */
  729.     char termChar;            /* Return when this character is found
  730.                      * (either ']' or '\0').  Zero means
  731.                      * that newlines terminate commands. */
  732.     int flags;                /* Interp->evalFlags value when the
  733.                      * procedure was called. */
  734.     int result;                /* Return value. */
  735.     register Interp *iPtr = (Interp *) interp;
  736.     Tcl_HashEntry *hPtr;
  737.     Command *cmdPtr;
  738.     char *termPtr;            /* Contains character just after the
  739.                      * last one in the command. */
  740.     char *cmdStart;            /* Points to first non-blank char. in
  741.                      * command (used in calling trace
  742.                      * procedures). */
  743.     char *ellipsis = "";        /* Used in setting errorInfo variable;
  744.                      * set to "..." to indicate that not
  745.                      * all of offending command is included
  746.                      * in errorInfo.  "" means that the
  747.                      * command is all there. */
  748.     register Trace *tracePtr;
  749.  
  750.     /*
  751.      * Initialize the result to an empty string and clear out any
  752.      * error information.  This makes sure that we return an empty
  753.      * result if there are no commands in the command string.
  754.      */
  755.  
  756.     Tcl_FreeResult((Tcl_Interp *) iPtr);
  757.     iPtr->result = iPtr->resultSpace;
  758.     iPtr->resultSpace[0] = 0;
  759.     result = TCL_OK;
  760.  
  761.     /*
  762.      * Initialize the area in which command copies will be assembled.
  763.      */
  764.  
  765.     pv.buffer = copyStorage;
  766.     pv.end = copyStorage + NUM_CHARS - 1;
  767.     pv.expandProc = TclExpandParseValue;
  768.     pv.clientData = (ClientData) NULL;
  769.  
  770.     src = cmd;
  771.     flags = iPtr->evalFlags;
  772.     iPtr->evalFlags = 0;
  773.     if (flags & TCL_BRACKET_TERM) {
  774.     termChar = ']';
  775.     } else {
  776.     termChar = 0;
  777.     }
  778.     termPtr = src;
  779.     cmdStart = src;
  780.  
  781.     /*
  782.      * Check depth of nested calls to Tcl_Eval:  if this gets too large,
  783.      * it's probably because of an infinite loop somewhere.
  784.      */
  785.  
  786.     iPtr->numLevels++;
  787.     if (iPtr->numLevels > iPtr->maxNestingDepth) {
  788.     iPtr->numLevels--;
  789.     iPtr->result =  "too many nested calls to Tcl_Eval (infinite loop?)";
  790.     iPtr->termPtr = termPtr;
  791.     return TCL_ERROR;
  792.     }
  793.  
  794.     /*
  795.      * There can be many sub-commands (separated by semi-colons or
  796.      * newlines) in one command string.  This outer loop iterates over
  797.      * individual commands.
  798.      */
  799.  
  800.     while (*src != termChar) {
  801.     iPtr->flags &= ~(ERR_IN_PROGRESS | ERROR_CODE_SET);
  802.  
  803.     /*
  804.      * Skim off leading white space and semi-colons, and skip
  805.      * comments.
  806.      */
  807.  
  808.     while (1) {
  809.         register char c = *src;
  810.  
  811.         if ((CHAR_TYPE(c) != TCL_SPACE) && (c != ';') && (c != '\n')) {
  812.         break;
  813.         }
  814.         src += 1;
  815.     }
  816.     if (*src == '#') {
  817.         for (src++; *src != 0; src++) {
  818.         if ((*src == '\n') && (src[-1] != '\\')) {
  819.             src++;
  820.             break;
  821.         }
  822.         }
  823.         continue;
  824.     }
  825.     cmdStart = src;
  826.  
  827.     /*
  828.      * Parse the words of the command, generating the argc and
  829.      * argv for the command procedure.  May have to call
  830.      * TclParseWords several times, expanding the argv array
  831.      * between calls.
  832.      */
  833.  
  834.     pv.next = oldBuffer = pv.buffer;
  835.     argc = 0;
  836.     while (1) {
  837.         int newArgs, maxArgs;
  838.         char **newArgv;
  839.         int i;
  840.  
  841.         /*
  842.          * Note:  the "- 2" below guarantees that we won't use the
  843.          * last two argv slots here.  One is for a NULL pointer to
  844.          * mark the end of the list, and the other is to leave room
  845.          * for inserting the command name "unknown" as the first
  846.          * argument (see below).
  847.          */
  848.  
  849.         maxArgs = argSize - argc - 2;
  850.         result = TclParseWords((Tcl_Interp *) iPtr, src, flags,
  851.             maxArgs, &termPtr, &newArgs, &argv[argc], &pv);
  852.         src = termPtr;
  853.         if (result != TCL_OK) {
  854.         ellipsis = "...";
  855.         goto done;
  856.         }
  857.  
  858.         /*
  859.          * Careful!  Buffer space may have gotten reallocated while
  860.          * parsing words.  If this happened, be sure to update all
  861.          * of the older argv pointers to refer to the new space.
  862.          */
  863.  
  864.         if (oldBuffer != pv.buffer) {
  865.         int i;
  866.  
  867.         for (i = 0; i < argc; i++) {
  868.             argv[i] = pv.buffer + (argv[i] - oldBuffer);
  869.         }
  870.         oldBuffer = pv.buffer;
  871.         }
  872.         argc += newArgs;
  873.         if (newArgs < maxArgs) {
  874.         argv[argc] = (char *) NULL;
  875.         break;
  876.         }
  877.  
  878.         /*
  879.          * Args didn't all fit in the current array.  Make it bigger.
  880.          */
  881.  
  882.         argSize *= 2;
  883.         newArgv = (char **)
  884.             ckalloc((unsigned) argSize * sizeof(char *));
  885.         for (i = 0; i < argc; i++) {
  886.         newArgv[i] = argv[i];
  887.         }
  888.         if (argv != argStorage) {
  889.         ckfree((char *) argv);
  890.         }
  891.         argv = newArgv;
  892.     }
  893.  
  894.     /*
  895.      * If this is an empty command (or if we're just parsing
  896.      * commands without evaluating them), then just skip to the
  897.      * next command.
  898.      */
  899.  
  900.     if ((argc == 0) || iPtr->noEval) {
  901.         continue;
  902.     }
  903.     argv[argc] = NULL;
  904.  
  905.     /*
  906.      * Save information for the history module, if needed.
  907.      */
  908.  
  909.     if (flags & TCL_RECORD_BOUNDS) {
  910.         iPtr->evalFirst = cmdStart;
  911.         iPtr->evalLast = src-1;
  912.     }
  913.  
  914.     /*
  915.      * Find the procedure to execute this command.  If there isn't
  916.      * one, then see if there is a command "unknown".  If so,
  917.      * invoke it instead, passing it the words of the original
  918.      * command as arguments.
  919.      */
  920.  
  921.     hPtr = Tcl_FindHashEntry(&iPtr->commandTable, argv[0]);
  922.     if (hPtr == NULL) {
  923.         int i;
  924.  
  925.         hPtr = Tcl_FindHashEntry(&iPtr->commandTable, "unknown");
  926.         if (hPtr == NULL) {
  927.         Tcl_ResetResult(interp);
  928.         Tcl_AppendResult(interp, "invalid command name: \"",
  929.             argv[0], "\"", (char *) NULL);
  930.         result = TCL_ERROR;
  931.         goto done;
  932.         }
  933.         for (i = argc; i >= 0; i--) {
  934.         argv[i+1] = argv[i];
  935.         }
  936.         argv[0] = "unknown";
  937.         argc++;
  938.     }
  939.     cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
  940.  
  941.     /*
  942.      * Call trace procedures, if any.
  943.      */
  944.  
  945.     for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
  946.         tracePtr = tracePtr->nextPtr) {
  947.         char saved;
  948.  
  949.         if (tracePtr->level < iPtr->numLevels) {
  950.         continue;
  951.         }
  952.         saved = *src;
  953.         *src = 0;
  954.         (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
  955.             cmdStart, cmdPtr->proc, cmdPtr->clientData, argc, argv);
  956.         *src = saved;
  957.     }
  958.  
  959.     /*
  960.      * At long last, invoke the command procedure.  Reset the
  961.      * result to its default empty value first (it could have
  962.      * gotten changed by earlier commands in the same command
  963.      * string).
  964.      */
  965.  
  966.     iPtr->cmdCount++;
  967.     Tcl_FreeResult(iPtr);
  968.     iPtr->result = iPtr->resultSpace;
  969.     iPtr->resultSpace[0] = 0;
  970.     result = (*cmdPtr->proc)(cmdPtr->clientData, interp, argc, argv);
  971.     if (tcl_AsyncReady) {
  972.         result = Tcl_AsyncInvoke(interp, result);
  973.     }
  974.     if (result != TCL_OK) {
  975.         break;
  976.     }
  977.     }
  978.  
  979.     /*
  980.      * Free up any extra resources that were allocated.
  981.      */
  982.  
  983.     done:
  984.     if (pv.buffer != copyStorage) {
  985.     ckfree((char *) pv.buffer);
  986.     }
  987.     if (argv != argStorage) {
  988.     ckfree((char *) argv);
  989.     }
  990.     iPtr->numLevels--;
  991.     if (iPtr->numLevels == 0) {
  992.     if (result == TCL_RETURN) {
  993.         result = TCL_OK;
  994.     }
  995.     if ((result != TCL_UNWIND) && (result != TCL_OK) && (result != TCL_ERROR)) {
  996.         Tcl_ResetResult(interp);
  997.         if (result == TCL_BREAK) {
  998.         iPtr->result = "invoked \"break\" outside of a loop";
  999.         } else if (result == TCL_CONTINUE) {
  1000.         iPtr->result = "invoked \"continue\" outside of a loop";
  1001.         } else {
  1002.         iPtr->result = iPtr->resultSpace;
  1003.         sprintf(iPtr->resultSpace, "command returned bad code: %d",
  1004.             result);
  1005.         }
  1006.         result = TCL_ERROR;
  1007.     }
  1008.     if (iPtr->flags & DELETED) {
  1009.         Tcl_DeleteInterp(interp);
  1010.     }
  1011.     }
  1012.  
  1013.     /*
  1014.      * If an error occurred, record information about what was being
  1015.      * executed when the error occurred.
  1016.      */
  1017.  
  1018.     if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
  1019.     int numChars;
  1020.     register char *p;
  1021.  
  1022.     /*
  1023.      * Compute the line number where the error occurred.
  1024.      */
  1025.  
  1026.     iPtr->errorLine = 1;
  1027.     for (p = cmd; p != cmdStart; p++) {
  1028.         if (*p == '\n') {
  1029.         iPtr->errorLine++;
  1030.         }
  1031.     }
  1032.     for ( ; isspace(UCHAR(*p)) || (*p == ';'); p++) {
  1033.         if (*p == '\n') {
  1034.         iPtr->errorLine++;
  1035.         }
  1036.     }
  1037.  
  1038.     /*
  1039.      * Figure out how much of the command to print in the error
  1040.      * message (up to a certain number of characters, or up to
  1041.      * the first new-line).
  1042.      */
  1043.  
  1044.     numChars = src - cmdStart;
  1045.     if (numChars > (NUM_CHARS-50)) {
  1046.         numChars = NUM_CHARS-50;
  1047.         ellipsis = " ...";
  1048.     }
  1049.  
  1050.     if (!(iPtr->flags & ERR_IN_PROGRESS)) {
  1051.         sprintf(copyStorage, "\n    while executing\n\"%.*s%s\"",
  1052.             numChars, cmdStart, ellipsis);
  1053.     } else {
  1054.         sprintf(copyStorage, "\n    invoked from within\n\"%.*s%s\"",
  1055.             numChars, cmdStart, ellipsis);
  1056.     }
  1057.     Tcl_AddErrorInfo(interp, copyStorage);
  1058.     iPtr->flags &= ~ERR_ALREADY_LOGGED;
  1059.     } else {
  1060.     iPtr->flags &= ~ERR_ALREADY_LOGGED;
  1061.     }
  1062.     iPtr->termPtr = termPtr;
  1063.     return result;
  1064. }
  1065.  
  1066. /*
  1067.  *----------------------------------------------------------------------
  1068.  *
  1069.  * Tcl_CreateTrace --
  1070.  *
  1071.  *    Arrange for a procedure to be called to trace command execution.
  1072.  *
  1073.  * Results:
  1074.  *    The return value is a token for the trace, which may be passed
  1075.  *    to Tcl_DeleteTrace to eliminate the trace.
  1076.  *
  1077.  * Side effects:
  1078.  *    From now on, proc will be called just before a command procedure
  1079.  *    is called to execute a Tcl command.  Calls to proc will have the
  1080.  *    following form:
  1081.  *
  1082.  *    void
  1083.  *    proc(clientData, interp, level, command, cmdProc, cmdClientData,
  1084.  *        argc, argv)
  1085.  *        ClientData clientData;
  1086.  *        Tcl_Interp *interp;
  1087.  *        int level;
  1088.  *        char *command;
  1089.  *        int (*cmdProc)();
  1090.  *        ClientData cmdClientData;
  1091.  *        int argc;
  1092.  *        char **argv;
  1093.  *    {
  1094.  *    }
  1095.  *
  1096.  *    The clientData and interp arguments to proc will be the same
  1097.  *    as the corresponding arguments to this procedure.  Level gives
  1098.  *    the nesting level of command interpretation for this interpreter
  1099.  *    (0 corresponds to top level).  Command gives the ASCII text of
  1100.  *    the raw command, cmdProc and cmdClientData give the procedure that
  1101.  *    will be called to process the command and the ClientData value it
  1102.  *    will receive, and argc and argv give the arguments to the
  1103.  *    command, after any argument parsing and substitution.  Proc
  1104.  *    does not return a value.
  1105.  *
  1106.  *----------------------------------------------------------------------
  1107.  */
  1108.  
  1109. Tcl_Trace
  1110. Tcl_CreateTrace(interp, level, proc, clientData)
  1111.     Tcl_Interp *interp;        /* Interpreter in which to create the trace. */
  1112.     int level;            /* Only call proc for commands at nesting level
  1113.                  * <= level (1 => top level). */
  1114.     Tcl_CmdTraceProc *proc;    /* Procedure to call before executing each
  1115.                  * command. */
  1116.     ClientData clientData;    /* Arbitrary one-word value to pass to proc. */
  1117. {
  1118.     register Trace *tracePtr;
  1119.     register Interp *iPtr = (Interp *) interp;
  1120.  
  1121.     tracePtr = (Trace *) ckalloc(sizeof(Trace));
  1122.     tracePtr->level = level;
  1123.     tracePtr->proc = proc;
  1124.     tracePtr->clientData = clientData;
  1125.     tracePtr->nextPtr = iPtr->tracePtr;
  1126.     iPtr->tracePtr = tracePtr;
  1127.  
  1128.     return (Tcl_Trace) tracePtr;
  1129. }
  1130.  
  1131. /*
  1132.  *----------------------------------------------------------------------
  1133.  *
  1134.  * Tcl_DeleteTrace --
  1135.  *
  1136.  *    Remove a trace.
  1137.  *
  1138.  * Results:
  1139.  *    None.
  1140.  *
  1141.  * Side effects:
  1142.  *    From now on there will be no more calls to the procedure given
  1143.  *    in trace.
  1144.  *
  1145.  *----------------------------------------------------------------------
  1146.  */
  1147.  
  1148. void
  1149. Tcl_DeleteTrace(interp, trace)
  1150.     Tcl_Interp *interp;        /* Interpreter that contains trace. */
  1151.     Tcl_Trace trace;        /* Token for trace (returned previously by
  1152.                  * Tcl_CreateTrace). */
  1153. {
  1154.     register Interp *iPtr = (Interp *) interp;
  1155.     register Trace *tracePtr = (Trace *) trace;
  1156.     register Trace *tracePtr2;
  1157.  
  1158.     if (iPtr->tracePtr == tracePtr) {
  1159.     iPtr->tracePtr = tracePtr->nextPtr;
  1160.     ckfree((char *) tracePtr);
  1161.     } else {
  1162.     for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
  1163.         tracePtr2 = tracePtr2->nextPtr) {
  1164.         if (tracePtr2->nextPtr == tracePtr) {
  1165.         tracePtr2->nextPtr = tracePtr->nextPtr;
  1166.         ckfree((char *) tracePtr);
  1167.         return;
  1168.         }
  1169.     }
  1170.     }
  1171. }
  1172.  
  1173. /*
  1174.  *----------------------------------------------------------------------
  1175.  *
  1176.  * Tcl_AddErrorInfo --
  1177.  *
  1178.  *    Add information to a message being accumulated that describes
  1179.  *    the current error.
  1180.  *
  1181.  * Results:
  1182.  *    None.
  1183.  *
  1184.  * Side effects:
  1185.  *    The contents of message are added to the "errorInfo" variable.
  1186.  *    If Tcl_Eval has been called since the current value of errorInfo
  1187.  *    was set, errorInfo is cleared before adding the new message.
  1188.  *
  1189.  *----------------------------------------------------------------------
  1190.  */
  1191.  
  1192. void
  1193. Tcl_AddErrorInfo(interp, message)
  1194.     Tcl_Interp *interp;        /* Interpreter to which error information
  1195.                  * pertains. */
  1196.     char *message;        /* Message to record. */
  1197. {
  1198.     register Interp *iPtr = (Interp *) interp;
  1199.  
  1200.     /*
  1201.      * If an error is already being logged, then the new errorInfo
  1202.      * is the concatenation of the old info and the new message.
  1203.      * If this is the first piece of info for the error, then the
  1204.      * new errorInfo is the concatenation of the message in
  1205.      * interp->result and the new message.
  1206.      */
  1207.  
  1208.     if (!(iPtr->flags & ERR_IN_PROGRESS)) {
  1209.     Tcl_SetVar2(interp, "errorInfo", (char *) NULL, interp->result,
  1210.         TCL_GLOBAL_ONLY);
  1211.     iPtr->flags |= ERR_IN_PROGRESS;
  1212.  
  1213.     /*
  1214.      * If the errorCode variable wasn't set by the code that generated
  1215.      * the error, set it to "NONE".
  1216.      */
  1217.  
  1218.     if (!(iPtr->flags & ERROR_CODE_SET)) {
  1219.         (void) Tcl_SetVar2(interp, "errorCode", (char *) NULL, "NONE",
  1220.             TCL_GLOBAL_ONLY);
  1221.     }
  1222.     }
  1223.     Tcl_SetVar2(interp, "errorInfo", (char *) NULL, message,
  1224.         TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  1225. }
  1226.  
  1227. /*
  1228.  *----------------------------------------------------------------------
  1229.  *
  1230.  * Tcl_VarEval --
  1231.  *
  1232.  *    Given a variable number of string arguments, concatenate them
  1233.  *    all together and execute the result as a Tcl command.
  1234.  *
  1235.  * Results:
  1236.  *    A standard Tcl return result.  An error message or other
  1237.  *    result may be left in interp->result.
  1238.  *
  1239.  * Side effects:
  1240.  *    Depends on what was done by the command.
  1241.  *
  1242.  *----------------------------------------------------------------------
  1243.  */
  1244.     /* VARARGS2 */ /* ARGSUSED */
  1245. int
  1246. #ifndef lint
  1247. Tcl_VarEval(va_alist)
  1248. #else
  1249. Tcl_VarEval(iPtr, p, va_alist)
  1250.     Tcl_Interp *iPtr;        /* Interpreter in which to execute command. */
  1251.     char *p;            /* One or more strings to concatenate,
  1252.                  * terminated with a NULL string. */
  1253. #endif
  1254.     va_dcl
  1255. {
  1256.     va_list argList;
  1257. #define FIXED_SIZE 200
  1258.     char fixedSpace[FIXED_SIZE+1];
  1259.     int spaceAvl, spaceUsed, length;
  1260.     char *string, *cmd;
  1261.     Tcl_Interp *interp;
  1262.     int result;
  1263.  
  1264.     /*
  1265.      * Copy the strings one after the other into a single larger
  1266.      * string.  Use stack-allocated space for small commands, but if
  1267.      * the command gets too large than call ckalloc to create the
  1268.      * space.
  1269.      */
  1270.  
  1271.     va_start(argList);
  1272.     interp = va_arg(argList, Tcl_Interp *);
  1273.     spaceAvl = FIXED_SIZE;
  1274.     spaceUsed = 0;
  1275.     cmd = fixedSpace;
  1276.     while (1) {
  1277.     string = va_arg(argList, char *);
  1278.     if (string == NULL) {
  1279.         break;
  1280.     }
  1281.     length = strlen(string);
  1282.     if ((spaceUsed + length) > spaceAvl) {
  1283.         char *new;
  1284.  
  1285.         spaceAvl = spaceUsed + length;
  1286.         spaceAvl += spaceAvl/2;
  1287.         new = ckalloc((unsigned) spaceAvl);
  1288.         memcpy((VOID *) new, (VOID *) cmd, spaceUsed);
  1289.         if (cmd != fixedSpace) {
  1290.         ckfree(cmd);
  1291.         }
  1292.         cmd = new;
  1293.     }
  1294.     strcpy(cmd + spaceUsed, string);
  1295.     spaceUsed += length;
  1296.     }
  1297.     va_end(argList);
  1298.     cmd[spaceUsed] = '\0';
  1299.  
  1300.     result = Tcl_Eval(interp, cmd);
  1301.     if (cmd != fixedSpace) {
  1302.     ckfree(cmd);
  1303.     }
  1304.     return result;
  1305. }
  1306.  
  1307. /*
  1308.  *----------------------------------------------------------------------
  1309.  *
  1310.  * Tcl_GlobalEval --
  1311.  *
  1312.  *    Evaluate a command at global level in an interpreter.
  1313.  *
  1314.  * Results:
  1315.  *    A standard Tcl result is returned, and interp->result is
  1316.  *    modified accordingly.
  1317.  *
  1318.  * Side effects:
  1319.  *    The command string is executed in interp, and the execution
  1320.  *    is carried out in the variable context of global level (no
  1321.  *    procedures active), just as if an "uplevel #0" command were
  1322.  *    being executed.
  1323.  *
  1324.  *----------------------------------------------------------------------
  1325.  */
  1326.  
  1327. int
  1328. Tcl_GlobalEval(interp, command)
  1329.     Tcl_Interp *interp;        /* Interpreter in which to evaluate command. */
  1330.     char *command;        /* Command to evaluate. */
  1331. {
  1332.     register Interp *iPtr = (Interp *) interp;
  1333.     int result;
  1334.     CallFrame *savedVarFramePtr;
  1335.  
  1336.     savedVarFramePtr = iPtr->varFramePtr;
  1337.     iPtr->varFramePtr = NULL;
  1338.     result = Tcl_Eval(interp, command);
  1339.     iPtr->varFramePtr = savedVarFramePtr;
  1340.     return result;
  1341. }
  1342.  
  1343. /*
  1344.  *----------------------------------------------------------------------
  1345.  *
  1346.  * Tcl_SetRecursionLimit --
  1347.  *
  1348.  *    Set the maximum number of recursive calls that may be active
  1349.  *    for an interpreter at once.
  1350.  *
  1351.  * Results:
  1352.  *    The return value is the old limit on nesting for interp.
  1353.  *
  1354.  * Side effects:
  1355.  *    None.
  1356.  *
  1357.  *----------------------------------------------------------------------
  1358.  */
  1359.  
  1360. int
  1361. Tcl_SetRecursionLimit(interp, depth)
  1362.     Tcl_Interp *interp;            /* Interpreter whose nesting limit
  1363.                      * is to be set. */
  1364.     int depth;                /* New value for maximimum depth. */
  1365. {
  1366.     Interp *iPtr = (Interp *) interp;
  1367.     int old;
  1368.  
  1369.     old = iPtr->maxNestingDepth;
  1370.     if (depth > 0) {
  1371.     iPtr->maxNestingDepth = depth;
  1372.     }
  1373.     return old;
  1374. }
  1375.