summaryrefslogtreecommitdiffstats
path: root/generic/tclParse.c
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2001-11-19 17:30:27 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2001-11-19 17:30:27 (GMT)
commit5d97cbd3c761f8902a37567f943d0f2e11ede815 (patch)
tree6f63a06354fb04897435602487708d010a077cb6 /generic/tclParse.c
parentd74ef041362e5b4eeea97da995d6829f2a88b479 (diff)
downloadtcl-5d97cbd3c761f8902a37567f943d0f2e11ede815.zip
tcl-5d97cbd3c761f8902a37567f943d0f2e11ede815.tar.gz
tcl-5d97cbd3c761f8902a37567f943d0f2e11ede815.tar.bz2
Code reorganisation: moving all eval functions from tclParse.c to tclBasic.c
Diffstat (limited to 'generic/tclParse.c')
-rw-r--r--generic/tclParse.c907
1 files changed, 2 insertions, 905 deletions
diff --git a/generic/tclParse.c b/generic/tclParse.c
index f19e4e4..ae53606 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -4,9 +4,7 @@
* This file contains procedures that parse Tcl scripts. They
* do so in a general-purpose fashion that can be used for many
* different purposes, including compilation, direct execution,
- * code analysis, etc. This file also includes a few additional
- * procedures such as Tcl_EvalObjv, Tcl_Eval, and Tcl_EvalEx, which
- * allow scripts to be evaluated directly, without compiling.
+ * code analysis, etc.
*
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Ajuba Solutions.
@@ -14,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclParse.c,v 1.17 2001/11/16 20:01:04 msofer Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.18 2001/11/19 17:30:27 msofer Exp $
*/
#include "tclInt.h"
@@ -752,907 +750,6 @@ TclExpandTokenArray(parsePtr)
/*
*----------------------------------------------------------------------
*
- * TclEvalObjvInternal --
- *
- * This procedure evaluates a Tcl command that has already been
- * parsed into words, with one Tcl_Obj holding each word.
- *
- * Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR. A result or error message is left in
- * interp's result. If an error occurs, this procedure does
- * NOT add any information to the errorInfo variable.
- *
- * Side effects:
- * Depends on the command.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclEvalObjvInternal(interp, objc, objv, command, length, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
- * command. Also used for error
- * reporting. */
- int objc; /* Number of words in command. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
- * the words that make up the command. */
- char *command; /* Points to the beginning of the string
- * representation of the command; this
- * is used for traces. If the string
- * representation of the command is
- * unknown, an empty string should be
- * supplied. If it is NULL, no traces will
- * be called. */
- int length; /* Number of bytes in command; if -1, all
- * characters up to the first null byte are
- * used. */
- int flags; /* Collection of OR-ed bits that control
- * the evaluation of the script. Only
- * TCL_EVAL_GLOBAL is currently
- * supported. */
-
-{
- Command *cmdPtr;
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj **newObjv;
- int i, code;
- Trace *tracePtr, *nextPtr;
- char **argv, *commandCopy;
- CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
- * in case TCL_EVAL_GLOBAL was set. */
-
- Tcl_ResetResult(interp);
- if (objc == 0) {
- return TCL_OK;
- }
-
- /*
- * If the interpreter was deleted, return an error.
- */
-
- if (iPtr->flags & DELETED) {
- Tcl_AppendToObj(Tcl_GetObjResult(interp),
- "attempt to call eval in deleted interpreter", -1);
- Tcl_SetErrorCode(interp, "CORE", "IDELETE",
- "attempt to call eval in deleted interpreter",
- (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Check depth of nested calls to Tcl_Eval: if this gets too large,
- * it's probably because of an infinite loop somewhere.
- */
-
- if (iPtr->numLevels >= iPtr->maxNestingDepth) {
- iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
- return TCL_ERROR;
- }
- iPtr->numLevels++;
-
- /*
- * On the Mac, we will never reach the default recursion limit before
- * blowing the stack. So we need to do a check here.
- */
-
- if (TclpCheckStackSpace() == 0) {
- /*NOTREACHED*/
- iPtr->numLevels--;
- iPtr->result = "too many nested calls to Tcl_Eval (infinite loop?)";
- return TCL_ERROR;
- }
-
- /*
- * Find the procedure to execute this command. If there isn't one,
- * then see if there is a command "unknown". If so, create a new
- * word array with "unknown" as the first word and the original
- * command words as arguments. Then call ourselves recursively
- * to execute it.
- */
-
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if (cmdPtr == NULL) {
- newObjv = (Tcl_Obj **) ckalloc((unsigned)
- ((objc + 1) * sizeof (Tcl_Obj *)));
- for (i = objc-1; i >= 0; i--) {
- newObjv[i+1] = objv[i];
- }
- newObjv[0] = Tcl_NewStringObj("::unknown", -1);
- Tcl_IncrRefCount(newObjv[0]);
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
- if (cmdPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid command name \"", Tcl_GetString(objv[0]), "\"",
- (char *) NULL);
- code = TCL_ERROR;
- } else {
- code = TclEvalObjvInternal(interp, objc+1, newObjv, command, length, 0);
- }
- Tcl_DecrRefCount(newObjv[0]);
- ckfree((char *) newObjv);
- goto done;
- }
-
- /*
- * Call trace procedures if needed.
- */
-
- if (command != NULL) {
- argv = NULL;
- commandCopy = command;
-
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
- nextPtr = tracePtr->nextPtr;
- if (iPtr->numLevels > tracePtr->level) {
- continue;
- }
-
- /*
- * This is a bit messy because we have to emulate the old trace
- * interface, which uses strings for everything.
- */
-
- if (argv == NULL) {
- argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
- for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
- }
- argv[objc] = 0;
-
- if (length < 0) {
- length = strlen(command);
- } else if ((size_t)length < strlen(command)) {
- commandCopy = (char *) ckalloc((unsigned) (length + 1));
- strncpy(commandCopy, command, (size_t) length);
- commandCopy[length] = 0;
- }
- }
- (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
- commandCopy, cmdPtr->proc, cmdPtr->clientData,
- objc, argv);
- }
- if (argv != NULL) {
- ckfree((char *) argv);
- }
- if (commandCopy != command) {
- ckfree((char *) commandCopy);
- }
- }
-
- /*
- * Finally, invoke the command's Tcl_ObjCmdProc.
- */
-
- iPtr->cmdCount++;
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
- code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
- iPtr->varFramePtr = savedVarFramePtr;
- if (Tcl_AsyncReady()) {
- code = Tcl_AsyncInvoke(interp, code);
- }
-
- /*
- * If the interpreter has a non-empty string result, the result
- * object is either empty or stale because some procedure set
- * interp->result directly. If so, move the string result to the
- * result object, then reset the string result.
- */
-
- if (*(iPtr->result) != 0) {
- (void) Tcl_GetObjResult(interp);
- }
-
- done:
- iPtr->numLevels--;
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObjv --
- *
- * This procedure evaluates a Tcl command that has already been
- * parsed into words, with one Tcl_Obj holding each word.
- *
- * Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR. A result or error message is left in
- * interp's result.
- *
- * Side effects:
- * Depends on the command.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalObjv(interp, objc, objv, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
- * command. Also used for error
- * reporting. */
- int objc; /* Number of words in command. */
- Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
- * the words that make up the command. */
- int flags; /* Collection of OR-ed bits that control
- * the evaluation of the script. Only
- * TCL_EVAL_GLOBAL is currently
- * supported. */
-{
- Interp *iPtr = (Interp *)interp;
- Trace *tracePtr;
- Tcl_DString cmdBuf;
- char *cmdString = "";
- int cmdLen = 0;
- int code = TCL_OK;
-
- for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
- /*
- * EvalObjv will increment numLevels so use "<" rather than "<="
- */
- if (iPtr->numLevels < tracePtr->level) {
- int i;
- /*
- * The command will be needed for an execution trace or stack trace
- * generate a command string.
- */
- cmdtraced:
- Tcl_DStringInit(&cmdBuf);
- for (i = 0; i < objc; i++) {
- Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i]));
- }
- cmdString = Tcl_DStringValue(&cmdBuf);
- cmdLen = Tcl_DStringLength(&cmdBuf);
- break;
- }
- }
-
- /*
- * Execute the command if we have not done so already
- */
- switch (code) {
- case TCL_OK:
- code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
- if (code == TCL_ERROR && cmdLen == 0)
- goto cmdtraced;
- break;
- case TCL_ERROR:
- Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
- break;
- default:
- /*NOTREACHED*/
- break;
- }
-
- if (cmdLen != 0) {
- Tcl_DStringFree(&cmdBuf);
- }
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LogCommandInfo --
- *
- * This procedure is invoked after an error occurs in an interpreter.
- * It adds information to the "errorInfo" variable to describe the
- * command that was being executed when the error occurred.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Information about the command is added to errorInfo and the
- * line number stored internally in the interpreter is set. If this
- * is the first call to this procedure or Tcl_AddObjErrorInfo since
- * an error occurred, then old information in errorInfo is
- * deleted.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_LogCommandInfo(interp, script, command, length)
- Tcl_Interp *interp; /* Interpreter in which to log information. */
- char *script; /* First character in script containing
- * command (must be <= command). */
- char *command; /* First character in command that
- * generated the error. */
- int length; /* Number of bytes in command (-1 means
- * use all bytes up to first null byte). */
-{
- char buffer[200];
- register char *p;
- char *ellipsis = "";
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->flags & ERR_ALREADY_LOGGED) {
- /*
- * Someone else has already logged error information for this
- * command; we shouldn't add anything more.
- */
-
- return;
- }
-
- /*
- * Compute the line number where the error occurred.
- */
-
- iPtr->errorLine = 1;
- for (p = script; p != command; p++) {
- if (*p == '\n') {
- iPtr->errorLine++;
- }
- }
-
- /*
- * Create an error message to add to errorInfo, including up to a
- * maximum number of characters of the command.
- */
-
- if (length < 0) {
- length = strlen(command);
- }
- if (length > 150) {
- length = 150;
- ellipsis = "...";
- }
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- sprintf(buffer, "\n while executing\n\"%.*s%s\"",
- length, command, ellipsis);
- } else {
- sprintf(buffer, "\n invoked from within\n\"%.*s%s\"",
- length, command, ellipsis);
- }
- Tcl_AddObjErrorInfo(interp, buffer, -1);
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalTokensStandard --
- *
- * Given an array of tokens parsed from a Tcl command (e.g., the
- * tokens that make up a word or the index for an array variable)
- * this procedure evaluates the tokens and concatenates their
- * values to form a single result value.
- *
- * Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR. A result or error message is left in
- * interp's result.
- *
- * Side effects:
- * Depends on the array of tokens being evaled.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalTokensStandard(interp, tokenPtr, count)
- Tcl_Interp *interp; /* Interpreter in which to lookup
- * variables, execute nested commands,
- * and report errors. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
- * to evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
- * Must be at least 1. */
-{
- Tcl_Obj *resultPtr, *indexPtr, *valuePtr, *newPtr;
- char buffer[TCL_UTF_MAX];
-#ifdef TCL_MEM_DEBUG
-# define MAX_VAR_CHARS 5
-#else
-# define MAX_VAR_CHARS 30
-#endif
- char nameBuffer[MAX_VAR_CHARS+1];
- char *varName, *index;
- char *p = NULL; /* Initialized to avoid compiler warning. */
- int length, code;
-
- /*
- * The only tricky thing about this procedure is that it attempts to
- * avoid object creation and string copying whenever possible. For
- * example, if the value is just a nested command, then use the
- * command's result object directly.
- */
-
- code = TCL_OK;
- resultPtr = NULL;
- Tcl_ResetResult(interp);
- for ( ; count > 0; count--, tokenPtr++) {
- valuePtr = NULL;
-
- /*
- * The switch statement below computes the next value to be
- * concat to the result, as either a range of text or an
- * object.
- */
-
- switch (tokenPtr->type) {
- case TCL_TOKEN_TEXT:
- p = tokenPtr->start;
- length = tokenPtr->size;
- break;
-
- case TCL_TOKEN_BS:
- length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
- buffer);
- p = buffer;
- break;
-
- case TCL_TOKEN_COMMAND:
- code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
- 0);
- if (code != TCL_OK) {
- goto done;
- }
- valuePtr = Tcl_GetObjResult(interp);
- break;
-
- case TCL_TOKEN_VARIABLE:
- if (tokenPtr->numComponents == 1) {
- indexPtr = NULL;
- index = NULL;
- } else {
- code = Tcl_EvalTokensStandard(interp, tokenPtr+2,
- tokenPtr->numComponents - 1);
- if (code != TCL_OK) {
- goto done;
- }
- indexPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(indexPtr);
- index = Tcl_GetString(indexPtr);
- }
-
- /*
- * We have to make a copy of the variable name in order
- * to have a null-terminated string. We can't make a
- * temporary modification to the script to null-terminate
- * the name, because a trace callback might potentially
- * reuse the script and be affected by the null character.
- */
-
- if (tokenPtr[1].size <= MAX_VAR_CHARS) {
- varName = nameBuffer;
- } else {
- varName = ckalloc((unsigned) (tokenPtr[1].size + 1));
- }
- strncpy(varName, tokenPtr[1].start, (size_t) tokenPtr[1].size);
- varName[tokenPtr[1].size] = 0;
- valuePtr = Tcl_GetVar2Ex(interp, varName, index,
- TCL_LEAVE_ERR_MSG);
- if (varName != nameBuffer) {
- ckfree(varName);
- }
- if (indexPtr != NULL) {
- Tcl_DecrRefCount(indexPtr);
- }
- if (valuePtr == NULL) {
- code = TCL_ERROR;
- goto done;
- }
- count -= tokenPtr->numComponents;
- tokenPtr += tokenPtr->numComponents;
- break;
-
- default:
- panic("unexpected token type in Tcl_EvalTokensStandard");
- }
-
- /*
- * If valuePtr isn't NULL, the next piece of text comes from that
- * object; otherwise, take length bytes starting at p.
- */
-
- if (resultPtr == NULL) {
- if (valuePtr != NULL) {
- resultPtr = valuePtr;
- } else {
- resultPtr = Tcl_NewStringObj(p, length);
- }
- Tcl_IncrRefCount(resultPtr);
- } else {
- if (Tcl_IsShared(resultPtr)) {
- newPtr = Tcl_DuplicateObj(resultPtr);
- Tcl_DecrRefCount(resultPtr);
- resultPtr = newPtr;
- Tcl_IncrRefCount(resultPtr);
- }
- if (valuePtr != NULL) {
- p = Tcl_GetStringFromObj(valuePtr, &length);
- }
- Tcl_AppendToObj(resultPtr, p, length);
- }
- }
- if (resultPtr != NULL) {
- Tcl_SetObjResult(interp, resultPtr);
- Tcl_DecrRefCount(resultPtr);
- } else {
- code = TCL_ERROR;
- }
-
- done:
- return code;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalTokens --
- *
- * Given an array of tokens parsed from a Tcl command (e.g., the
- * tokens that make up a word or the index for an array variable)
- * this procedure evaluates the tokens and concatenates their
- * values to form a single result value.
- *
- * Results:
- * The return value is a pointer to a newly allocated Tcl_Obj
- * containing the value of the array of tokens. The reference
- * count of the returned object has been incremented. If an error
- * occurs in evaluating the tokens then a NULL value is returned
- * and an error message is left in interp's result.
- *
- * Side effects:
- * A new object is allocated to hold the result.
- *
- *----------------------------------------------------------------------
- *
- * This uses a non-standard return convention; its use is now deprecated.
- * It is a wrapper for the new function Tcl_EvalTokensStandard, and is not
- * used in the core any longer. It is only kept for backward compatibility.
- */
-
-Tcl_Obj *
-Tcl_EvalTokens(interp, tokenPtr, count)
- Tcl_Interp *interp; /* Interpreter in which to lookup
- * variables, execute nested commands,
- * and report errors. */
- Tcl_Token *tokenPtr; /* Pointer to first in an array of tokens
- * to evaluate and concatenate. */
- int count; /* Number of tokens to consider at tokenPtr.
- * Must be at least 1. */
-{
- int code;
- Tcl_Obj *resPtr;
-
- code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
- if (code == TCL_OK) {
- resPtr = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(resPtr);
- Tcl_ResetResult(interp);
- return resPtr;
- } else {
- return NULL;
- }
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalEx --
- *
- * This procedure evaluates a Tcl script without using the compiler
- * or byte-code interpreter. It just parses the script, creates
- * values for each word of each command, then calls EvalObjv
- * to execute each command.
- *
- * Results:
- * The return value is a standard Tcl completion code such as
- * TCL_OK or TCL_ERROR. A result or error message is left in
- * interp's result.
- *
- * Side effects:
- * Depends on the script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EvalEx(interp, script, numBytes, flags)
- Tcl_Interp *interp; /* Interpreter in which to evaluate the
- * script. Also used for error reporting. */
- char *script; /* First character of script to evaluate. */
- int numBytes; /* Number of bytes in script. If < 0, the
- * script consists of all bytes up to the
- * first null character. */
- int flags; /* Collection of OR-ed bits that control
- * the evaluation of the script. Only
- * TCL_EVAL_GLOBAL is currently
- * supported. */
-{
- Interp *iPtr = (Interp *) interp;
- char *p, *next;
- Tcl_Parse parse;
-#define NUM_STATIC_OBJS 20
- Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
- Tcl_Token *tokenPtr;
- int i, code, commandLength, bytesLeft, nested;
- CallFrame *savedVarFramePtr; /* Saves old copy of iPtr->varFramePtr
- * in case TCL_EVAL_GLOBAL was set. */
-
- /*
- * The variables below keep track of how much state has been
- * allocated while evaluating the script, so that it can be freed
- * properly if an error occurs.
- */
-
- int gotParse = 0, objectsUsed = 0;
-
- if (numBytes < 0) {
- numBytes = strlen(script);
- }
- Tcl_ResetResult(interp);
-
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- }
-
- /*
- * Each iteration through the following loop parses the next
- * command from the script and then executes it.
- */
-
- objv = staticObjArray;
- p = script;
- bytesLeft = numBytes;
- if (iPtr->evalFlags & TCL_BRACKET_TERM) {
- nested = 1;
- } else {
- nested = 0;
- }
- iPtr->evalFlags = 0;
- do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
- != TCL_OK) {
- code = TCL_ERROR;
- goto error;
- }
- gotParse = 1;
- if (parse.numWords > 0) {
- /*
- * Generate an array of objects for the words of the command.
- */
-
- if (parse.numWords <= NUM_STATIC_OBJS) {
- objv = staticObjArray;
- } else {
- objv = (Tcl_Obj **) ckalloc((unsigned)
- (parse.numWords * sizeof (Tcl_Obj *)));
- }
- for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
- objectsUsed < parse.numWords;
- objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
- code = Tcl_EvalTokensStandard(interp, tokenPtr+1,
- tokenPtr->numComponents);
- if (code == TCL_OK) {
- objv[objectsUsed] = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(objv[objectsUsed]);
- } else {
- goto error;
- }
- }
-
- /*
- * Execute the command and free the objects for its words.
- */
-
- code = TclEvalObjvInternal(interp, objectsUsed, objv, p, bytesLeft, 0);
- if (code != TCL_OK) {
- goto error;
- }
- for (i = 0; i < objectsUsed; i++) {
- Tcl_DecrRefCount(objv[i]);
- }
- objectsUsed = 0;
- if (objv != staticObjArray) {
- ckfree((char *) objv);
- objv = staticObjArray;
- }
- }
-
- /*
- * Advance to the next command in the script.
- */
-
- next = parse.commandStart + parse.commandSize;
- bytesLeft -= next - p;
- p = next;
- Tcl_FreeParse(&parse);
- gotParse = 0;
- if ((nested != 0) && (p > script) && (p[-1] == ']')) {
- /*
- * We get here in the special case where the TCL_BRACKET_TERM
- * flag was set in the interpreter and we reached a close
- * bracket in the script. Return immediately.
- */
-
- iPtr->termOffset = (p - 1) - script;
- iPtr->varFramePtr = savedVarFramePtr;
- return TCL_OK;
- }
- } while (bytesLeft > 0);
- iPtr->termOffset = p - script;
- iPtr->varFramePtr = savedVarFramePtr;
- return TCL_OK;
-
- error:
- /*
- * Generate various pieces of error information, such as the line
- * number where the error occurred and information to add to the
- * errorInfo variable. Then free resources that had been allocated
- * to the command.
- */
-
- if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- commandLength = parse.commandSize;
- if ((parse.commandStart + commandLength) != (script + numBytes)) {
- /*
- * The command where the error occurred didn't end at the end
- * of the script (i.e. it ended at a terminator character such
- * as ";". Reduce the length by one so that the error message
- * doesn't include the terminator character.
- */
-
- commandLength -= 1;
- }
- Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
- }
-
- for (i = 0; i < objectsUsed; i++) {
- Tcl_DecrRefCount(objv[i]);
- }
- if (gotParse) {
- next = parse.commandStart + parse.commandSize;
- bytesLeft -= next - p;
- p = next;
- Tcl_FreeParse(&parse);
-
- if ((nested != 0) && (p > script)) {
- char *nextCmd = NULL; /* pointer to start of next command */
-
- /*
- * We get here in the special case where the TCL_BRACKET_TERM
- * flag was set in the interpreter.
- *
- * At this point, we want to find the end of the script
- * (either end of script or the closing ']').
- */
-
- while ((p[-1] != ']') && bytesLeft) {
- if (Tcl_ParseCommand(NULL, p, bytesLeft, nested, &parse)
- != TCL_OK) {
- /*
- * We were looking for the ']' to close the script.
- * But if we find a syntax error, it is ok to quit
- * early since in that case we no longer need to know
- * where the ']' is (if there was one). We reset the
- * pointer to the start of the command that after the
- * one causing the return. -- hobbs
- */
-
- p = (nextCmd == NULL) ? parse.commandStart : nextCmd;
- break;
- }
-
- if (nextCmd == NULL) {
- nextCmd = parse.commandStart;
- }
-
- /*
- * Advance to the next command in the script.
- */
-
- next = parse.commandStart + parse.commandSize;
- bytesLeft -= next - p;
- p = next;
- Tcl_FreeParse(&parse);
- }
- iPtr->termOffset = (p - 1) - script;
- } else {
- iPtr->termOffset = p - script;
- }
- }
- if (objv != staticObjArray) {
- ckfree((char *) objv);
- }
- iPtr->varFramePtr = savedVarFramePtr;
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Eval --
- *
- * Execute a Tcl command in a string. This procedure executes the
- * script directly, rather than compiling it to bytecodes. Before
- * the arrival of the bytecode compiler in Tcl 8.0 Tcl_Eval was
- * the main procedure used for executing Tcl commands, but nowadays
- * it isn't used much.
- *
- * Results:
- * The return value is one of the return codes defined in tcl.h
- * (such as TCL_OK), and interp's result contains a value
- * to supplement the return code. The value of the result
- * will persist only until the next call to Tcl_Eval or Tcl_EvalObj:
- * you must copy it or lose it!
- *
- * Side effects:
- * Can be almost arbitrary, depending on the commands in the script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_Eval(interp, string)
- Tcl_Interp *interp; /* Token for command interpreter (returned
- * by previous call to Tcl_CreateInterp). */
- char *string; /* Pointer to TCL command to execute. */
-{
- int code;
-
- code = Tcl_EvalEx(interp, string, -1, 0);
-
- /*
- * For backwards compatibility with old C code that predates the
- * object system in Tcl 8.0, we have to mirror the object result
- * back into the string result (some callers may expect it there).
- */
-
- Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
- TCL_VOLATILE);
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObj, Tcl_GlobalEvalObj --
- *
- * These functions are deprecated but we keep them around for backwards
- * compatibility reasons.
- *
- * Results:
- * See the functions they call.
- *
- * Side effects:
- * See the functions they call.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_EvalObj
-int
-Tcl_EvalObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
-{
- return Tcl_EvalObjEx(interp, objPtr, 0);
-}
-
-#undef Tcl_GlobalEvalObj
-int
-Tcl_GlobalEvalObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
-{
- return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_ParseVarName --
*
* Given a string starting with a $ sign, parse off a variable