shared_source/c_tcl_base_7_5_w_mods/tclparse.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclparse.c,v 1.1.1.1 2001/06/13 04:44:26 dtashley Exp $ */

/* 
 * tclParse.c --
 *
 *      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.
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * 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.1.1.1 2001/06/13 04:44:26 dtashley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following table provides parsing information about each possible
 * 8-bit character.  The table is designed to be referenced with either
 * signed or unsigned characters, so it has 384 entries.  The first 128
 * entries correspond to negative character values, the next 256 correspond
 * to positive character values.  The last 128 entries are identical to the
 * first 128.  The table is always indexed with a 128-byte offset (the 128th
 * entry corresponds to a character value of 0).
 *
 * The macro CHAR_TYPE is used to index into the table and return
 * information about its character argument.  The following return
 * values are defined.
 *
 * TYPE_NORMAL -        All characters that don't have special significance
 *                      to the Tcl parser.
 * TYPE_SPACE -         The character is a whitespace character other
 *                      than newline.
 * TYPE_COMMAND_END -   Character is newline or semicolon.
 * TYPE_SUBS -          Character begins a substitution or has other
 *                      special meaning in ParseTokens: backslash, dollar
 *                      sign, open bracket, or null.
 * TYPE_QUOTE -         Character is a double quote.
 * TYPE_CLOSE_PAREN -   Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -   Character is a right square bracket.
 * TYPE_BRACE -         Character is a curly brace (either left or right).
 */

#define TYPE_NORMAL             0
#define TYPE_SPACE              0x1
#define TYPE_COMMAND_END        0x2
#define TYPE_SUBS               0x4
#define TYPE_QUOTE              0x8
#define TYPE_CLOSE_PAREN        0x10
#define TYPE_CLOSE_BRACK        0x20
#define TYPE_BRACE              0x40

#define CHAR_TYPE(c) (typeTable+128)[(int)(c)]

char typeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,

    /*
     * Positive character values, from 0-127:
     */

    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_SPACE,       TYPE_COMMAND_END, TYPE_SPACE,
    TYPE_SPACE,       TYPE_SPACE,       TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_SPACE,       TYPE_NORMAL,      TYPE_QUOTE,       TYPE_NORMAL,
    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_CLOSE_PAREN, TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_COMMAND_END,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_SUBS,
    TYPE_SUBS,        TYPE_CLOSE_BRACK, TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_BRACE,
    TYPE_NORMAL,      TYPE_BRACE,       TYPE_NORMAL,      TYPE_NORMAL,

    /*
     * Large unsigned character values, from 128-255:
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local procedures defined in this file:
 */

static int              CommandComplete _ANSI_ARGS_((char *script,
                            int length));
static int              ParseTokens _ANSI_ARGS_((char *src, int mask,
                            Tcl_Parse *parsePtr));
static int              EvalObjv _ANSI_ARGS_((Tcl_Interp *interp, int objc,
                            Tcl_Obj *CONST objv[], char *command, int length,
                            int flags));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseCommand --
 *
 *      Given a string, this procedure parses the first Tcl command
 *      in the string and returns information about the structure of
 *      the command.
 *
 * Results:
 *      The return value is TCL_OK if the command was parsed
 *      successfully and TCL_ERROR otherwise.  If an error occurs
 *      and interp isn't NULL then an error message is left in
 *      its result.  On a successful return, parsePtr is filled in
 *      with information about the command that was parsed.
 *
 * Side effects:
 *      If there is insufficient space in parsePtr to hold all the
 *      information about the command, then additional space is
 *      malloc-ed.  If the procedure returns TCL_OK then the caller must
 *      eventually invoke Tcl_FreeParse to release any additional space
 *      that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting;
                                 * if NULL, then no error message is
                                 * provided. */
    char *string;               /* First character of string containing
                                 * one or more Tcl commands.  The string
                                 * must be in writable memory and must
                                 * have one additional byte of space at
                                 * string[length] where we can
                                 * temporarily store a 0 sentinel
                                 * character. */
    int numBytes;               /* Total number of bytes in string.  If < 0,
                                 * the script consists of all bytes up to 
                                 * the first null character. */
    int nested;                 /* Non-zero means this is a nested command:
                                 * close bracket should be considered
                                 * a command terminator. If zero, then close
                                 * bracket has no special meaning. */
    register Tcl_Parse *parsePtr;
                                /* Structure to fill in with information
                                 * about the parsed command; any previous
                                 * information in the structure is
                                 * ignored. */
{
    register char *src;         /* Points to current character
                                 * in the command. */
    int type;                   /* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;        /* Pointer to token being filled in. */
    int wordIndex;              /* Index of word token for current word. */
    char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
    int terminators;            /* CHAR_TYPE bits that indicate the end
                                 * of a command. */
    char *termPtr;              /* Set by Tcl_ParseBraces/QuotedString to
                                 * point to char after terminating one. */
    int length, savedChar;


    if (numBytes < 0) {
        numBytes = (string? strlen(string) : 0);
    }
    parsePtr->commentStart = NULL;
    parsePtr->commentSize = 0;
    parsePtr->commandStart = NULL;
    parsePtr->commandSize = 0;
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;
    parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
    parsePtr->string = string;
    parsePtr->end = string + numBytes;
    parsePtr->term = parsePtr->end;
    parsePtr->interp = interp;
    parsePtr->incomplete = 0;
    parsePtr->errorType = TCL_PARSE_SUCCESS;
    if (nested != 0) {
        terminators = TYPE_COMMAND_END | TYPE_CLOSE_BRACK;
    } else {
        terminators = TYPE_COMMAND_END;
    }

    /*
     * Temporarily overwrite the character just after the end of the
     * string with a 0 byte.  This acts as a sentinel and reduces the
     * number of places where we have to check for the end of the
     * input string.  The original value of the byte is restored at
     * the end of the parse.
     */

    savedChar = string[numBytes];
    if (savedChar != 0) {
        string[numBytes] = 0;
    }

    /*
     * Parse any leading space and comments before the first word of the
     * command.
     */

    src = string;
    while (1) {
        while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
            src++;
        }
        if ((*src == '\\') && (src[1] == '\n')) {
            /*
             * Skip backslash-newline sequence: it should be treated
             * just like white space.
             */

            if ((src + 2) == parsePtr->end) {
                parsePtr->incomplete = 1;
            }
            src += 2;
            continue;
        }
        if (*src != '#') {
            break;
        }
        if (parsePtr->commentStart == NULL) {
            parsePtr->commentStart = src;
        }
        while (1) {
            if (src == parsePtr->end) {
                if (nested) {
                    parsePtr->incomplete = nested;
                }
                parsePtr->commentSize = src - parsePtr->commentStart;
                break;
            } else if (*src == '\\') {
                if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
                    parsePtr->incomplete = 1;
                }
                Tcl_UtfBackslash(src, &length, utfBytes);
                src += length;
            } else if (*src == '\n') {
                src++;
                parsePtr->commentSize = src - parsePtr->commentStart;
                break;
            } else {
                src++;
            }
        }
    }

    /*
     * The following loop parses the words of the command, one word
     * in each iteration through the loop.
     */

    parsePtr->commandStart = src;
    while (1) {
        /*
         * Create the token for the word.
         */

        if (parsePtr->numTokens == parsePtr->tokensAvailable) {
            TclExpandTokenArray(parsePtr);
        }
        wordIndex = parsePtr->numTokens;
        tokenPtr = &parsePtr->tokenPtr[wordIndex];
        tokenPtr->type = TCL_TOKEN_WORD;

        /*
         * Skip white space before the word. Also skip a backslash-newline
         * sequence: it should be treated just like white space.
         */

        while (1) {
            type = CHAR_TYPE(*src);
            if (type == TYPE_SPACE) {
                src++;
                continue;
            } else if ((*src == '\\') && (src[1] == '\n')) {
                if ((src + 2) == parsePtr->end) {
                    parsePtr->incomplete = 1;
                }
                Tcl_UtfBackslash(src, &length, utfBytes);
                src += length;
                continue;
            }
            break;
        }
        if ((type & terminators) != 0) {
            parsePtr->term = src;
            src++;
            break;
        }
        if (src == parsePtr->end) {
            break;
        }
        tokenPtr->start = src;
        parsePtr->numTokens++;
        parsePtr->numWords++;

        /*
         * At this point the word can have one of three forms: something
         * enclosed in quotes, something enclosed in braces, or an
         * unquoted word (anything else).
         */

        if (*src == '"') {
            if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
                    parsePtr, 1, &termPtr) != TCL_OK) {
                goto error;
            }
            src = termPtr;
        } else if (*src == '{') {
            if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
                    parsePtr, 1, &termPtr) != TCL_OK) {
                goto error;
            }
            src = termPtr;
        } else {
            /*
             * This is an unquoted word.  Call ParseTokens and let it do
             * all of the work.
             */

            if (ParseTokens(src, TYPE_SPACE|terminators, 
                    parsePtr) != TCL_OK) {
                goto error;
            }
            src = parsePtr->term;
        }

        /*
         * Finish filling in the token for the word and check for the
         * special case of a word consisting of a single range of
         * literal text.
         */

        tokenPtr = &parsePtr->tokenPtr[wordIndex];
        tokenPtr->size = src - tokenPtr->start;
        tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
        if ((tokenPtr->numComponents == 1)
                && (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
            tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
        }

        /*
         * Do two additional checks: (a) make sure we're really at the
         * end of a word (there might have been garbage left after a
         * quoted or braced word), and (b) check for the end of the
         * command.
         */

        type = CHAR_TYPE(*src);
        if (type == TYPE_SPACE) {
            src++;
            continue;
        } else {
            /*
             * Backslash-newline (and any following white space) must be
             * treated as if it were a space character.
             */

            if ((*src == '\\') && (src[1] == '\n')) {
                if ((src + 2) == parsePtr->end) {
                    parsePtr->incomplete = 1;
                }
                Tcl_UtfBackslash(src, &length, utfBytes);
                src += length;
                continue;
            }
        }

        if ((type & terminators) != 0) {
            parsePtr->term = src;
            src++;
            break;
        }
        if (src == parsePtr->end) {
            break;
        }
        if (src[-1] == '"') { 
            if (interp != NULL) {
                Tcl_SetResult(interp, "extra characters after close-quote",
                        TCL_STATIC);
            }
            parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
        } else {
            if (interp != NULL) {
                Tcl_SetResult(interp, "extra characters after close-brace",
                        TCL_STATIC);
            }
            parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
        }
        parsePtr->term = src;
        goto error;
    }


    parsePtr->commandSize = src - parsePtr->commandStart;
    if (savedChar != 0) {
        string[numBytes] = (char) savedChar;
    }
    return TCL_OK;

    error:
    if (savedChar != 0) {
        string[numBytes] = (char) savedChar;
    }
    Tcl_FreeParse(parsePtr);
    if (parsePtr->commandStart == NULL) {
        parsePtr->commandStart = string;
    }
    parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseTokens --
 *
 *      This procedure forms the heart of the Tcl parser.  It parses one
 *      or more tokens from a string, up to a termination point
 *      specified by the caller.  This procedure is used to parse
 *      unquoted command words (those not in quotes or braces), words in
 *      quotes, and array indices for variables.
 *
 * Results:
 *      Tokens are added to parsePtr and parsePtr->term is filled in
 *      with the address of the character that terminated the parse (the
 *      first one whose CHAR_TYPE matched mask or the character at
 *      parsePtr->end).  The return value is TCL_OK if the parse
 *      completed successfully and TCL_ERROR otherwise.  If a parse
 *      error occurs and parsePtr->interp isn't NULL, then an error
 *      message is left in the interpreter's result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(src, mask, parsePtr)
    register char *src;         /* First character to parse. */
    int mask;                   /* Specifies when to stop parsing.  The
                                 * parse stops at the first unquoted
                                 * character whose CHAR_TYPE contains
                                 * any of the bits in mask. */
    Tcl_Parse *parsePtr;        /* Information about parse in progress.
                                 * Updated with additional tokens and
                                 * termination information. */
{
    int type, originalTokens, varToken;
    char utfBytes[TCL_UTF_MAX];
    Tcl_Token *tokenPtr;
    Tcl_Parse nested;

    /*
     * Each iteration through the following loop adds one token of
     * type TCL_TOKEN_TEXT, TCL_TOKEN_BS, TCL_TOKEN_COMMAND, or
     * TCL_TOKEN_VARIABLE to parsePtr.  For TCL_TOKEN_VARIABLE tokens,
     * additional tokens are added for the parsed variable name.
     */

    originalTokens = parsePtr->numTokens;
    while (1) {
        if (parsePtr->numTokens == parsePtr->tokensAvailable) {
            TclExpandTokenArray(parsePtr);
        }
        tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
        tokenPtr->start = src;
        tokenPtr->numComponents = 0;

        type = CHAR_TYPE(*src);
        if (type & mask) {
            break;
        }

        if ((type & TYPE_SUBS) == 0) {
            /*
             * This is a simple range of characters.  Scan to find the end
             * of the range.
             */

            while (1) {
                src++;
                if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
                    break;
                }
            }
            tokenPtr->type = TCL_TOKEN_TEXT;
            tokenPtr->size = src - tokenPtr->start;
            parsePtr->numTokens++;
        } else if (*src == '$') {
            /*
             * This is a variable reference.  Call Tcl_ParseVarName to do
             * all the dirty work of parsing the name.
             */

            varToken = parsePtr->numTokens;
            if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
                    parsePtr, 1) != TCL_OK) {
                return TCL_ERROR;
            }
            src += parsePtr->tokenPtr[varToken].size;
        } else if (*src == '[') {
            /*
             * Command substitution.  Call Tcl_ParseCommand recursively
             * (and repeatedly) to parse the nested command(s), then
             * throw away the parse information.
             */

            src++;
            while (1) {
                if (Tcl_ParseCommand(parsePtr->interp, src,
                        parsePtr->end - src, 1, &nested) != TCL_OK) {
                    parsePtr->errorType = nested.errorType;
                    parsePtr->term = nested.term;
                    parsePtr->incomplete = nested.incomplete;
                    return TCL_ERROR;
                }
                src = nested.commandStart + nested.commandSize;
                if (nested.tokenPtr != nested.staticTokens) {
                    ckfree((char *) nested.tokenPtr);
                }
                if ((*nested.term == ']') && !nested.incomplete) {
                    break;
                }
                if (src == parsePtr->end) {
                    if (parsePtr->interp != NULL) {
                        Tcl_SetResult(parsePtr->interp,
                            "missing close-bracket", TCL_STATIC);
                    }
                    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
                    parsePtr->term = tokenPtr->start;
                    parsePtr->incomplete = 1;
                    return TCL_ERROR;
                }
            }
            tokenPtr->type = TCL_TOKEN_COMMAND;
            tokenPtr->size = src - tokenPtr->start;
            parsePtr->numTokens++;
        } else if (*src == '\\') {
            /*
             * Backslash substitution.
             */

            if (src[1] == '\n') {
                if ((src + 2) == parsePtr->end) {
                    parsePtr->incomplete = 1;
                }

                /*
                 * Note: backslash-newline is special in that it is
                 * treated the same as a space character would be.  This
                 * means that it could terminate the token.
                 */

                if (mask & TYPE_SPACE) {
                    break;
                }
            }
            tokenPtr->type = TCL_TOKEN_BS;
            Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
            parsePtr->numTokens++;
            src += tokenPtr->size;
        } else if (*src == 0) {
            /*
             * We encountered a null character.  If it is the null
             * character at the end of the string, then return.
             * Otherwise generate a text token for the single
             * character.
             */

            if (src == parsePtr->end) {
                break;
            }
            tokenPtr->type = TCL_TOKEN_TEXT;
            tokenPtr->size = 1;
            parsePtr->numTokens++;
            src++;
        } else {
            panic("ParseTokens encountered unknown character");
        }
    }
    if (parsePtr->numTokens == originalTokens) {
        /*
         * There was nothing in this range of text.  Add an empty token
         * for the empty range, so that there is always at least one
         * token added.
         */

        tokenPtr->type = TCL_TOKEN_TEXT;
        tokenPtr->size = 0;
        parsePtr->numTokens++;
    }
    parsePtr->term = src;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeParse --
 *
 *      This procedure is invoked to free any dynamic storage that may
 *      have been allocated by a previous call to Tcl_ParseCommand.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      If there is any dynamically allocated memory in *parsePtr,
 *      it is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FreeParse(parsePtr)
    Tcl_Parse *parsePtr;        /* Structure that was filled in by a
                                 * previous call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
        ckfree((char *) parsePtr->tokenPtr);
        parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclExpandTokenArray --
 *
 *      This procedure is invoked when the current space for tokens in
 *      a Tcl_Parse structure fills up; it allocates memory to grow the
 *      token array
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Memory is allocated for a new larger token array; the memory
 *      for the old array is freed, if it had been dynamically allocated.
 *
 *----------------------------------------------------------------------
 */

void
TclExpandTokenArray(parsePtr)
    Tcl_Parse *parsePtr;        /* Parse structure whose token space
                                 * has overflowed. */
{
    int newCount;
    Tcl_Token *newPtr;

    newCount = parsePtr->tokensAvailable*2;
    newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
    memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
            (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
        ckfree((char *) parsePtr->tokenPtr);
    }
    parsePtr->tokenPtr = newPtr;
    parsePtr->tokensAvailable = newCount;
}

/*
 *----------------------------------------------------------------------
 *
 * 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.  If an error occurs, this procedure does
 *      NOT add any information to the errorInfo variable.
 *
 * Side effects:
 *      Depends on the command.
 *
 *----------------------------------------------------------------------
 */

static int
EvalObjv(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. */
    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 = EvalObjv(interp, objc+1, newObjv, command, length, 0);
        }
        Tcl_DecrRefCount(newObjv[0]);
        ckfree((char *) newObjv);
        goto done;
    }
    
    /*
     * Call trace procedures if needed.
     */

    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 = EvalObjv(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_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.
 *
 *----------------------------------------------------------------------
 */

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

    resultPtr = NULL;
    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 error;
                }
                valuePtr = Tcl_GetObjResult(interp);
                break;

            case TCL_TOKEN_VARIABLE:
                if (tokenPtr->numComponents == 1) {
                    indexPtr = NULL;
                } else {
                    indexPtr = Tcl_EvalTokens(interp, tokenPtr+2,
                            tokenPtr->numComponents - 1);
                    if (indexPtr == NULL) {
                        goto error;
                    }
                }

                /*
                 * 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;
                if (indexPtr != NULL) {
                    index = TclGetString(indexPtr);
                } else {
                    index = NULL;
                }
                valuePtr = Tcl_GetVar2Ex(interp, varName, index,
                        TCL_LEAVE_ERR_MSG);
                if (varName != nameBuffer) {
                    ckfree(varName);
                }
                if (indexPtr != NULL) {
                    Tcl_DecrRefCount(indexPtr);
                }
                if (valuePtr == NULL) {
                    goto error;
                }
                count -= tokenPtr->numComponents;
                tokenPtr += tokenPtr->numComponents;
                break;

            default:
                panic("unexpected token type in Tcl_EvalTokens");
        }

        /*
         * 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);
        }
    }
    return resultPtr;

    error:
    if (resultPtr != NULL) {
        Tcl_DecrRefCount(resultPtr);
    }
    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)) {
                objv[objectsUsed] = Tcl_EvalTokens(interp, tokenPtr+1,
                        tokenPtr->numComponents);
                if (objv[objectsUsed] == NULL) {
                    code = TCL_ERROR;
                    goto error;
                }
            }
    
            /*
             * Execute the command and free the objects for its words.
             */
    
            code = EvalObjv(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) {
        p = parse.commandStart + parse.commandSize;
        Tcl_FreeParse(&parse);
        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;
        } 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
 *      name and return information about the parse.
 *
 * Results:
 *      The return value is TCL_OK if the command was parsed
 *      successfully and TCL_ERROR otherwise.  If an error occurs and
 *      interp isn't NULL then an error message is left in its result. 
 *      On a successful return, tokenPtr and numTokens fields of
 *      parsePtr are filled in with information about the variable name
 *      that was parsed.  The "size" field of the first new token gives
 *      the total number of bytes in the variable name.  Other fields in
 *      parsePtr are undefined.
 *
 * Side effects:
 *      If there is insufficient space in parsePtr to hold all the
 *      information about the command, then additional space is
 *      malloc-ed.  If the procedure returns TCL_OK then the caller must
 *      eventually invoke Tcl_FreeParse to release any additional space
 *      that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting;
                                 * if NULL, then no error message is
                                 * provided. */
    char *string;               /* String containing variable name.  First
                                 * character must be "$". */
    int numBytes;               /* Total number of bytes in string.  If < 0,
                                 * the string consists of all bytes up to the
                                 * first null character. */
    Tcl_Parse *parsePtr;        /* Structure to fill in with information
                                 * about the variable name. */
    int append;                 /* Non-zero means append tokens to existing
                                 * information in parsePtr; zero means ignore
                                 * existing tokens in parsePtr and reinitialize
                                 * it. */
{
    Tcl_Token *tokenPtr;
    char *end, *src;
    unsigned char c;
    int varIndex, offset;
    Tcl_UniChar ch;
    unsigned array;

    if (numBytes >= 0) {
        end = string + numBytes;
    } else {
        end = string + strlen(string);
    }

    if (!append) {
        parsePtr->numWords = 0;
        parsePtr->tokenPtr = parsePtr->staticTokens;
        parsePtr->numTokens = 0;
        parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
        parsePtr->string = string;
        parsePtr->end = end;
        parsePtr->interp = interp;
        parsePtr->errorType = TCL_PARSE_SUCCESS;
        parsePtr->incomplete = 0;
    }

    /*
     * Generate one token for the variable, an additional token for the
     * name, plus any number of additional tokens for the index, if
     * there is one.
     */

    src = string;
    if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
        TclExpandTokenArray(parsePtr);
    }
    tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
    tokenPtr->type = TCL_TOKEN_VARIABLE;
    tokenPtr->start = src;
    varIndex = parsePtr->numTokens;
    parsePtr->numTokens++;
    tokenPtr++;
    src++;
    if (src >= end) {
        goto justADollarSign;
    }
    tokenPtr->type = TCL_TOKEN_TEXT;
    tokenPtr->start = src;
    tokenPtr->numComponents = 0;

    /*
     * The name of the variable can have three forms:
     * 1. The $ sign is followed by an open curly brace.  Then 
     *    the variable name is everything up to the next close
     *    curly brace, and the variable is a scalar variable.
     * 2. The $ sign is not followed by an open curly brace.  Then
     *    the variable name is everything up to the next
     *    character that isn't a letter, digit, or underscore.
     *    :: sequences are also considered part of the variable
     *    name, in order to support namespaces. If the following
     *    character is an open parenthesis, then the information
     *    between parentheses is the array element name.
     * 3. The $ sign is followed by something that isn't a letter,
     *    digit, or underscore:  in this case, there is no variable
     *    name and the token is just "$".
     */

    if (*src == '{') {
        src++;
        tokenPtr->type = TCL_TOKEN_TEXT;
        tokenPtr->start = src;
        tokenPtr->numComponents = 0;
        while (1) {
            if (src == end) {
                if (interp != NULL) {
                    Tcl_SetResult(interp,
                        "missing close-brace for variable name",
                        TCL_STATIC);
                }
                parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
                parsePtr->term = tokenPtr->start-1;
                parsePtr->incomplete = 1;
                goto error;
            }
            if (*src == '}') {
                break;
            }
            src++;
        }
        tokenPtr->size = src - tokenPtr->start;
        tokenPtr[-1].size = src - tokenPtr[-1].start;
        parsePtr->numTokens++;
        src++;
    } else {
        tokenPtr->type = TCL_TOKEN_TEXT;
        tokenPtr->start = src;
        tokenPtr->numComponents = 0;
        while (src != end) {
            offset = Tcl_UtfToUniChar(src, &ch);
            c = UCHAR(ch);
            if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
                src += offset;
                continue;
            }
            if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
                src += 2;
                while ((src != end) && (*src == ':')) {
                    src += 1;
                }
                continue;
            }
            break;
        }

        /*
         * Support for empty array names here.
         */
        array = ((src != end) && (*src == '('));
        tokenPtr->size = src - tokenPtr->start;
        if (tokenPtr->size == 0 && !array) {
            goto justADollarSign;
        }
        parsePtr->numTokens++;
        if (array) {
            /*
             * This is a reference to an array element.  Call
             * ParseTokens recursively to parse the element name,
             * since it could contain any number of substitutions.
             */

            if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
                    != TCL_OK) {
                goto error;
            }
            if ((parsePtr->term == end) || (*parsePtr->term != ')')) { 
                if (parsePtr->interp != NULL) {
                    Tcl_SetResult(parsePtr->interp, "missing )",
                            TCL_STATIC);
                }
                parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
                parsePtr->term = src;
                parsePtr->incomplete = 1;
                goto error;
            }
            src = parsePtr->term + 1;
        }
    }
    tokenPtr = &parsePtr->tokenPtr[varIndex];
    tokenPtr->size = src - tokenPtr->start;
    tokenPtr->numComponents = parsePtr->numTokens - (varIndex + 1);
    return TCL_OK;

    /*
     * The dollar sign isn't followed by a variable name.
     * replace the TCL_TOKEN_VARIABLE token with a
     * TCL_TOKEN_TEXT token for the dollar sign.
     */

    justADollarSign:
    tokenPtr = &parsePtr->tokenPtr[varIndex];
    tokenPtr->type = TCL_TOKEN_TEXT;
    tokenPtr->size = 1;
    tokenPtr->numComponents = 0;
    return TCL_OK;

    error:
    Tcl_FreeParse(parsePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseVar --
 *
 *      Given a string starting with a $ sign, parse off a variable
 *      name and return its value.
 *
 * Results:
 *      The return value is the contents of the variable given by
 *      the leading characters of string.  If termPtr isn't NULL,
 *      *termPtr gets filled in with the address of the character
 *      just after the last one in the variable specifier.  If the
 *      variable doesn't exist, then the return value is NULL and
 *      an error message will be left in interp's result.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_ParseVar(interp, string, termPtr)
    Tcl_Interp *interp;                 /* Context for looking up variable. */
    register char *string;              /* String containing variable name.
                                         * First character must be "$". */
    char **termPtr;                     /* If non-NULL, points to word to fill
                                         * in with character just after last
                                         * one in the variable specifier. */

{
    Tcl_Parse parse;
    register Tcl_Obj *objPtr;

    if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
        return NULL;
    }

    if (termPtr != NULL) {
        *termPtr = string + parse.tokenPtr->size;
    }
    if (parse.numTokens == 1) {
        /*
         * There isn't a variable name after all: the $ is just a $.
         */

        return "$";
    }

    objPtr = Tcl_EvalTokens(interp, parse.tokenPtr, parse.numTokens);
    if (objPtr == NULL) {
        return NULL;
    }

    /*
     * At this point we should have an object containing the value of
     * a variable.  Just return the string from that object.
     */

#ifdef TCL_COMPILE_DEBUG
    if (objPtr->refCount < 2) {
        panic("Tcl_ParseVar got temporary object from Tcl_EvalTokens");
    }
#endif /*TCL_COMPILE_DEBUG*/    
    TclDecrRefCount(objPtr);
    return TclGetString(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseBraces --
 *
 *      Given a string in braces such as a Tcl command argument or a string
 *      value in a Tcl expression, this procedure parses the string and
 *      returns information about the parse.
 *
 * Results:
 *      The return value is TCL_OK if the string was parsed successfully and
 *      TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
 *      an error message is left in its result. On a successful return,
 *      tokenPtr and numTokens fields of parsePtr are filled in with
 *      information about the string that was parsed. Other fields in
 *      parsePtr are undefined. termPtr is set to point to the character
 *      just after the last one in the braced string.
 *
 * Side effects:
 *      If there is insufficient space in parsePtr to hold all the
 *      information about the command, then additional space is
 *      malloc-ed. If the procedure returns TCL_OK then the caller must
 *      eventually invoke Tcl_FreeParse to release any additional space
 *      that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting;
                                 * if NULL, then no error message is
                                 * provided. */
    char *string;               /* String containing the string in braces.
                                 * The first character must be '{'. */
    int numBytes;               /* Total number of bytes in string. If < 0,
                                 * the string consists of all bytes up to
                                 * the first null character. */
    register Tcl_Parse *parsePtr;
                                /* Structure to fill in with information
                                 * about the string. */
    int append;                 /* Non-zero means append tokens to existing
                                 * information in parsePtr; zero means
                                 * ignore existing tokens in parsePtr and
                                 * reinitialize it. */
    char **termPtr;             /* If non-NULL, points to word in which to
                                 * store a pointer to the character just
                                 * after the terminating '}' if the parse
                                 * was successful. */

{
    char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
    Tcl_Token *tokenPtr;
    register char *src, *end;
    int startIndex, level, length;

    if ((numBytes >= 0) || (string == NULL)) {
        end = string + numBytes;
    } else {
        end = string + strlen(string);
    }
    
    if (!append) {
        parsePtr->numWords = 0;
        parsePtr->tokenPtr = parsePtr->staticTokens;
        parsePtr->numTokens = 0;
        parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
        parsePtr->string = string;
        parsePtr->end = end;
        parsePtr->interp = interp;
        parsePtr->errorType = TCL_PARSE_SUCCESS;
    }

    src = string+1;
    startIndex = parsePtr->numTokens;

    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
        TclExpandTokenArray(parsePtr);
    }
    tokenPtr = &parsePtr->tokenPtr[startIndex];
    tokenPtr->type = TCL_TOKEN_TEXT;
    tokenPtr->start = src;
    tokenPtr->numComponents = 0;
    level = 1;
    while (1) {
        while (CHAR_TYPE(*src) == TYPE_NORMAL) {
            src++;
        }
        if (*src == '}') {
            level--;
            if (level == 0) {
                break;
            }
            src++;
        } else if (*src == '{') {
            level++;
            src++;
        } else if (*src == '\\') {
            Tcl_UtfBackslash(src, &length, utfBytes);
            if (src[1] == '\n') {
                /*
                 * A backslash-newline sequence must be collapsed, even
                 * inside braces, so we have to split the word into
                 * multiple tokens so that the backslash-newline can be
                 * represented explicitly.
                 */
                
                if ((src + 2) == end) {
                    parsePtr->incomplete = 1;
                }
                tokenPtr->size = (src - tokenPtr->start);
                if (tokenPtr->size != 0) {
                    parsePtr->numTokens++;
                }
                if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
                    TclExpandTokenArray(parsePtr);
                }
                tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
                tokenPtr->type = TCL_TOKEN_BS;
                tokenPtr->start = src;
                tokenPtr->size = length;
                tokenPtr->numComponents = 0;
                parsePtr->numTokens++;
                
                src += length;
                tokenPtr++;
                tokenPtr->type = TCL_TOKEN_TEXT;
                tokenPtr->start = src;
                tokenPtr->numComponents = 0;
            } else {
                src += length;
            }
        } else if (src == end) {
            int openBrace;

            if (interp != NULL) {
                Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
            }
            /*
             *  Search the source string for a possible open
             *  brace within the context of a comment.  Since we
             *  aren't performing a full Tcl parse, just look for
             *  an open brace preceeded by a '<whitspace>#' on 
             *  the same line.
             */
            openBrace = 0;
            while (src > string ) {
                switch (*src) {
                    case '{': 
                        openBrace = 1; 
                        break;
                    case '\n':
                        openBrace = 0; 
                        break;
                    case '#':
                        if ((openBrace == 1) && (isspace(UCHAR(src[-1])))) {
                            if (interp != NULL) {
                                Tcl_AppendResult(interp,
                                        ": possible unbalanced brace in comment",
                                        (char *) NULL);
                            }
                            openBrace = -1;
                            break;
                        }
                        break;
                }
                if (openBrace == -1) {
                    break;
                }
                src--;
            }
            parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
            parsePtr->term = string;
            parsePtr->incomplete = 1;
            goto error;
        } else {
            src++;
        }
    }

    /*
     * Decide if we need to finish emitting a partially-finished token.
     * There are 3 cases:
     *     {abc \newline xyz} or {xyz}  - finish emitting "xyz" token
     *     {abc \newline}               - don't emit token after \newline
     *     {}                           - finish emitting zero-sized token
     * The last case ensures that there is a token (even if empty) that
     * describes the braced string.
     */
    
    if ((src != tokenPtr->start)
            || (parsePtr->numTokens == startIndex)) {
        tokenPtr->size = (src - tokenPtr->start);
        parsePtr->numTokens++;
    }
    if (termPtr != NULL) {
        *termPtr = src+1;
    }
    return TCL_OK;

    error:
    Tcl_FreeParse(parsePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseQuotedString --
 *
 *      Given a double-quoted string such as a quoted Tcl command argument
 *      or a quoted value in a Tcl expression, this procedure parses the
 *      string and returns information about the parse.
 *
 * Results:
 *      The return value is TCL_OK if the string was parsed successfully and
 *      TCL_ERROR otherwise. If an error occurs and interp isn't NULL then
 *      an error message is left in its result. On a successful return,
 *      tokenPtr and numTokens fields of parsePtr are filled in with
 *      information about the string that was parsed. Other fields in
 *      parsePtr are undefined. termPtr is set to point to the character
 *      just after the quoted string's terminating close-quote.
 *
 * Side effects:
 *      If there is insufficient space in parsePtr to hold all the
 *      information about the command, then additional space is
 *      malloc-ed. If the procedure returns TCL_OK then the caller must
 *      eventually invoke Tcl_FreeParse to release any additional space
 *      that was allocated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting;
                                 * if NULL, then no error message is
                                 * provided. */
    char *string;               /* String containing the quoted string. 
                                 * The first character must be '"'. */
    int numBytes;               /* Total number of bytes in string. If < 0,
                                 * the string consists of all bytes up to
                                 * the first null character. */
    register Tcl_Parse *parsePtr;
                                /* Structure to fill in with information
                                 * about the string. */
    int append;                 /* Non-zero means append tokens to existing
                                 * information in parsePtr; zero means
                                 * ignore existing tokens in parsePtr and
                                 * reinitialize it. */
    char **termPtr;             /* If non-NULL, points to word in which to
                                 * store a pointer to the character just
                                 * after the quoted string's terminating
                                 * close-quote if the parse succeeds. */
{
    char *end;
    
    if ((numBytes >= 0) || (string == NULL)) {
        end = string + numBytes;
    } else {
        end = string + strlen(string);
    }
    
    if (!append) {
        parsePtr->numWords = 0;
        parsePtr->tokenPtr = parsePtr->staticTokens;
        parsePtr->numTokens = 0;
        parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
        parsePtr->string = string;
        parsePtr->end = end;
        parsePtr->interp = interp;
        parsePtr->errorType = TCL_PARSE_SUCCESS;
    }
    
    if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
        goto error;
    }
    if (*parsePtr->term != '"') {
        if (interp != NULL) {
            Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
        }
        parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
        parsePtr->term = string;
        parsePtr->incomplete = 1;
        goto error;
    }
    if (termPtr != NULL) {
        *termPtr = (parsePtr->term + 1);
    }
    return TCL_OK;

    error:
    Tcl_FreeParse(parsePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CommandComplete --
 *
 *      This procedure is shared by TclCommandComplete and
 *      Tcl_ObjCommandcoComplete; it does all the real work of seeing
 *      whether a script is complete
 *
 * Results:
 *      1 is returned if the script is complete, 0 if there are open
 *      delimiters such as " or (. 1 is also returned if there is a
 *      parse error in the script other than unmatched delimiters.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

static int
CommandComplete(script, length)
    char *script;                       /* Script to check. */
    int length;                         /* Number of bytes in script. */
{
    Tcl_Parse parse;
    char *p, *end;
    int result;

    p = script;
    end = p + length;
    while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
            == TCL_OK) {
        p = parse.commandStart + parse.commandSize;
        if (*p == 0) {
            break;
        }
        Tcl_FreeParse(&parse);
    }
    if (parse.incomplete) {
        result = 0;
    } else {
        result = 1;
    }
    Tcl_FreeParse(&parse);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CommandComplete --
 *
 *      Given a partial or complete Tcl script, this procedure
 *      determines whether the script is complete in the sense
 *      of having matched braces and quotes and brackets.
 *
 * Results:
 *      1 is returned if the script is complete, 0 otherwise.
 *      1 is also returned if there is a parse error in the script
 *      other than unmatched delimiters.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CommandComplete(script)
    char *script;                       /* Script to check. */
{
    return CommandComplete(script, (int) strlen(script));
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjCommandComplete --
 *
 *      Given a partial or complete Tcl command in a Tcl object, this
 *      procedure determines whether the command is complete in the sense of
 *      having matched braces and quotes and brackets.
 *
 * Results:
 *      1 is returned if the command is complete, 0 otherwise.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
TclObjCommandComplete(objPtr)
    Tcl_Obj *objPtr;                    /* Points to object holding script
                                         * to check. */
{
    char *script;
    int length;

    script = Tcl_GetStringFromObj(objPtr, &length);
    return CommandComplete(script, length);
}

/*
 *----------------------------------------------------------------------
 *
 * TclIsLocalScalar --
 *
 *      Check to see if a given string is a legal scalar variable
 *      name with no namespace qualifiers or substitutions.
 *
 * Results:
 *      Returns 1 if the variable is a local scalar.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
TclIsLocalScalar(src, len)
    CONST char *src;
    int len;
{
    CONST char *p;
    CONST char *lastChar = src + (len - 1);

    for (p = src; p <= lastChar; p++) {
        if ((CHAR_TYPE(*p) != TYPE_NORMAL) &&
                (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
            /*
             * TCL_COMMAND_END is returned for the last character
             * of the string.  By this point we know it isn't
             * an array or namespace reference.
             */

            return 0;
        }
        if  (*p == '(') {
            if (*lastChar == ')') { /* we have an array element */
                return 0;
            }
        } else if (*p == ':') {
            if ((p != lastChar) && *(p+1) == ':') { /* qualified name */
                return 0;
            }
        }
    }
        
    return 1;
}


/* $History: tclparse.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 1:37a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

/* End of TCLPARSE.C */