/* 

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

  *

  * Copyright (c) 1997 Sun Microsystems, Inc.

  * Copyright (c) 1998-2000 Ajuba Solutions.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

  * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)

  *

  * 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.25.2.1 2006/09/24 21:15:10 msofer 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, or open bracket.

  * 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) (charTypeTable+128)[(int)(c)]

 static CONST char charTypeTable[] = {

     /*

      * 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_((CONST char *script,

 			    int numBytes));

 static int		ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,

 			    Tcl_Parse *parsePtr));

 static int		ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,

 			    int mask, Tcl_Parse *parsePtr));

 /*

  *----------------------------------------------------------------------

  *

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

  *

  *----------------------------------------------------------------------

  */

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

     CONST char *string;		/* First character of string containing

 				 * one or more Tcl commands. */

     register 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 CONST char *src;	/* Points to current character

 				 * in the command. */

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

     int terminators;		/* CHAR_TYPE bits that indicate the end

 				 * of a command. */

     CONST char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to

 				 * point to char after terminating one. */

     int scanned;

     if ((string == NULL) && (numBytes!=0)) {

 	if (interp != NULL) {

 	    Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);

 	}

 	return TCL_ERROR;

     }

     if (numBytes < 0) {

 	numBytes = strlen(string);

     }

     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;

     }

     /*

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

      * command.

      */

     scanned = ParseComment(string, numBytes, parsePtr);

     src = (string + scanned); numBytes -= scanned;

     if (numBytes == 0) {

 	if (nested) {

 	    parsePtr->incomplete = nested;

 	}

     }

     /*

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

 	 */

 	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);

 	src += scanned; numBytes -= scanned;

 	if (numBytes == 0) {

 	    parsePtr->term = src;

 	    break;

 	}

 	if ((type & terminators) != 0) {

 	    parsePtr->term = src;

 	    src++;

 	    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, numBytes,

 		    parsePtr, 1, &termPtr) != TCL_OK) {

 		goto error;

 	    }

 	    src = termPtr; numBytes = parsePtr->end - src;

 	} else if (*src == '{') {

 	    if (Tcl_ParseBraces(interp, src, numBytes,

 		    parsePtr, 1, &termPtr) != TCL_OK) {

 		goto error;

 	    }

 	    src = termPtr; numBytes = parsePtr->end - src;

 	} else {

 	    /*

 	     * This is an unquoted word.  Call ParseTokens and let it do

 	     * all of the work.

 	     */

 	    if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,

 		    parsePtr) != TCL_OK) {

 		goto error;

 	    }

 	    src = parsePtr->term; numBytes = parsePtr->end - src;

 	}

 	/*

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

 	 */

 	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);

 	if (scanned) {

 	    src += scanned; numBytes -= scanned;

 	    continue;

 	}

 	if (numBytes == 0) {

 	    parsePtr->term = src;

 	    break;

 	}

 	if ((type & terminators) != 0) {

 	    parsePtr->term = src;

 	    src++; 

 	    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;

     return TCL_OK;

     error:

     Tcl_FreeParse(parsePtr);

     if (parsePtr->commandStart == NULL) {

 	parsePtr->commandStart = string;

     }

     parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;

     return TCL_ERROR;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclParseWhiteSpace --

  *

  *	Scans up to numBytes bytes starting at src, consuming white

  *	space as defined by Tcl's parsing rules.  

  *

  * Results:

  *	Returns the number of bytes recognized as white space.  Records

  *	at parsePtr, information about the parse.  Records at typePtr

  *	the character type of the non-whitespace character that terminated

  *	the scan.

  *

  * Side effects:

  *	None.

  *

  *----------------------------------------------------------------------

  */

 int

 TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)

     CONST char *src;		/* First character to parse. */

     register int numBytes;	/* Max number of bytes to scan. */

     Tcl_Parse *parsePtr;	/* Information about parse in progress.

 				 * Updated if parsing indicates

 				 * an incomplete command. */

     char *typePtr;		/* Points to location to store character

 				 * type of character that ends run

 				 * of whitespace */

 {

     register char type = TYPE_NORMAL;

     register CONST char *p = src;

     while (1) {

 	while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {

 	    numBytes--; p++;

 	}

 	if (numBytes && (type & TYPE_SUBS)) {

 	    if (*p != '\\') {

 		break;

 	    }

 	    if (--numBytes == 0) {

 		break;

 	    }

 	    if (p[1] != '\n') {

 		break;

 	    }

 	    p+=2;

 	    if (--numBytes == 0) {

 		parsePtr->incomplete = 1;

 		break;

 	    }

 	    continue;

 	}

 	break;

     }

     *typePtr = type;

     return (p - src);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclParseHex --

  *

  *	Scans a hexadecimal number as a Tcl_UniChar value.

  *	(e.g., for parsing \x and \u escape sequences).

  *	At most numBytes bytes are scanned.

  *

  * Results:

  *	The numeric value is stored in *resultPtr.

  *	Returns the number of bytes consumed.

  *

  * Notes:

  *	Relies on the following properties of the ASCII

  *	character set, with which UTF-8 is compatible:

  *

  *	The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' 

  *	occupy consecutive code points, and '0' < 'A' < 'a'.

  *

  *----------------------------------------------------------------------

  */

 int

 TclParseHex(src, numBytes, resultPtr)

     CONST char *src;		/* First character to parse. */

     int numBytes;		/* Max number of byes to scan */

     Tcl_UniChar *resultPtr;	/* Points to storage provided by

 				 * caller where the Tcl_UniChar

 				 * resulting from the conversion is

 				 * to be written. */

 {

     Tcl_UniChar result = 0;

     register CONST char *p = src;

     while (numBytes--) {

 	unsigned char digit = UCHAR(*p);

 	if (!isxdigit(digit))

 	    break;

 	++p;

 	result <<= 4;

 	if (digit >= 'a') {

 	    result |= (10 + digit - 'a');

 	} else if (digit >= 'A') {

 	    result |= (10 + digit - 'A');

 	} else {

 	    result |= (digit - '0');

 	}

     }

     *resultPtr = result;

     return (p - src);

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclParseBackslash --

  *

  *	Scans up to numBytes bytes starting at src, consuming a

  *	backslash sequence as defined by Tcl's parsing rules.  

  *

  * Results:

  * 	Records at readPtr the number of bytes making up the backslash

  * 	sequence.  Records at dst the UTF-8 encoded equivalent of

  * 	that backslash sequence.  Returns the number of bytes written

  * 	to dst, at most TCL_UTF_MAX.  Either readPtr or dst may be

  * 	NULL, if the results are not needed, but the return value is

  * 	the same either way.

  *

  * Side effects:

  * 	None.

  *

  *----------------------------------------------------------------------

  */

 int

 TclParseBackslash(src, numBytes, readPtr, dst)

     CONST char * src;	/* Points to the backslash character of a

 			 * a backslash sequence */

     int numBytes;	/* Max number of bytes to scan */

     int *readPtr;	/* NULL, or points to storage where the

 			 * number of bytes scanned should be written. */

     char *dst;		/* NULL, or points to buffer where the UTF-8

 			 * encoding of the backslash sequence is to be

 			 * written.  At most TCL_UTF_MAX bytes will be

 			 * written there. */

 {

     register CONST char *p = src+1;

     Tcl_UniChar result;

     int count;

     char buf[TCL_UTF_MAX];

     if (numBytes == 0) {

 	if (readPtr != NULL) {

 	    *readPtr = 0;

 	}

 	return 0;

     }

     if (dst == NULL) {

         dst = buf;

     }

     if (numBytes == 1) {

 	/* Can only scan the backslash.  Return it. */

 	result = '\\';

 	count = 1;

 	goto done;

     }

     count = 2;

     switch (*p) {

         /*

          * Note: in the conversions below, use absolute values (e.g.,

          * 0xa) rather than symbolic values (e.g. \n) that get converted

          * by the compiler.  It's possible that compilers on some

          * platforms will do the symbolic conversions differently, which

          * could result in non-portable Tcl scripts.

          */

         case 'a':

             result = 0x7;

             break;

         case 'b':

             result = 0x8;

             break;

         case 'f':

             result = 0xc;

             break;

         case 'n':

             result = 0xa;

             break;

         case 'r':

             result = 0xd;

             break;

         case 't':

             result = 0x9;

             break;

         case 'v':

             result = 0xb;

             break;

         case 'x':

 	    count += TclParseHex(p+1, numBytes-1, &result);

 	    if (count == 2) {

 		/* No hexadigits -> This is just "x". */

 		result = 'x';

 	    } else {

 		/* Keep only the last byte (2 hex digits) */

 		result = (unsigned char) result;

 	    }

             break;

         case 'u':

 	    count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);

 	    if (count == 2) {

 		/* No hexadigits -> This is just "u". */

 		result = 'u';

 	    }

             break;

         case '\n':

             count--;

             do {

                 p++; count++;

             } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));

             result = ' ';

             break;

         case 0:

             result = '\\';

             count = 1;

             break;

         default:

             /*

              * Check for an octal number \oo?o?

              */

             if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */

                 result = (unsigned char)(*p - '0');

                 p++;

                 if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */

 			|| (UCHAR(*p) >= '8')) { 

                     break;

                 }

                 count = 3;

                 result = (unsigned char)((result << 3) + (*p - '0'));

                 p++;

                 if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */

 			|| (UCHAR(*p) >= '8')) {

                     break;

                 }

                 count = 4;

                 result = (unsigned char)((result << 3) + (*p - '0'));

                 break;

             }

             /*

              * We have to convert here in case the user has put a

              * backslash in front of a multi-byte utf-8 character.

              * While this means nothing special, we shouldn't break up

              * a correct utf-8 character. [Bug #217987] test subst-3.2

              */

 	    if (Tcl_UtfCharComplete(p, numBytes - 1)) {

 	        count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */

 	    } else {

 		char utfBytes[TCL_UTF_MAX];

 		memcpy(utfBytes, p, (size_t) (numBytes - 1));

 		utfBytes[numBytes - 1] = '\0';

 	        count = Tcl_UtfToUniChar(utfBytes, &result) + 1;

 	    }

             break;

     }

     done:

     if (readPtr != NULL) {

         *readPtr = count;

     }

     return Tcl_UniCharToUtf((int) result, dst);

 }

 /*

  *----------------------------------------------------------------------

  *

  * ParseComment --

  *

  *	Scans up to numBytes bytes starting at src, consuming a

  *	Tcl comment as defined by Tcl's parsing rules.  

  *

  * Results:

  * 	Records in parsePtr information about the parse.  Returns the

  * 	number of bytes consumed.

  *

  * Side effects:

  * 	None.

  *

  *----------------------------------------------------------------------

  */

 static int

 ParseComment(src, numBytes, parsePtr)

     CONST char *src;		/* First character to parse. */

     register int numBytes;	/* Max number of bytes to scan. */

     Tcl_Parse *parsePtr;	/* Information about parse in progress.

 				 * Updated if parsing indicates

 				 * an incomplete command. */

 {

     register CONST char *p = src;

     while (numBytes) {

 	char type;

 	int scanned;

 	do {

 	    scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);

 	    p += scanned; numBytes -= scanned;

 	} while (numBytes && (*p == '\n') && (p++,numBytes--));

 	if ((numBytes == 0) || (*p != '#')) {

 	    break;

 	}

 	if (parsePtr->commentStart == NULL) {

 	    parsePtr->commentStart = p;

 	}

 	while (numBytes) {

 	    if (*p == '\\') {

 		scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);

 		if (scanned) {

 		    p += scanned; numBytes -= scanned;

 		} else {

 		    /*

 		     * General backslash substitution in comments isn't

 		     * part of the formal spec, but test parse-15.47

 		     * and history indicate that it has been the de facto

 		     * rule.  Don't change it now.

 		     */

 		    TclParseBackslash(p, numBytes, &scanned, NULL);

 		    p += scanned; numBytes -= scanned;

 		}

 	    } else {

 		p++; numBytes--;

 		if (p[-1] == '\n') {

 		    break;

 		}

 	    }

 	}

 	parsePtr->commentSize = p - parsePtr->commentStart;

     }

     return (p - src);

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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.  No more than numBytes

  *	bytes will be scanned.

  *

  * 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, numBytes, mask, parsePtr)

     register CONST char *src;	/* First character to parse. */

     register int numBytes;	/* Max number of bytes to scan. */

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

 {

     char type; 

     int originalTokens, varToken;

     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 (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {

 	if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];

 	tokenPtr->start = src;

 	tokenPtr->numComponents = 0;

 	if ((type & TYPE_SUBS) == 0) {

 	    /*

 	     * This is a simple range of characters.  Scan to find the end

 	     * of the range.

 	     */

 	    while ((++src, --numBytes) 

 		    && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {

 		/* empty loop */

 	    }

 	    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, numBytes,

 		    parsePtr, 1) != TCL_OK) {

 		return TCL_ERROR;

 	    }

 	    src += parsePtr->tokenPtr[varToken].size;

 	    numBytes -= 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++; numBytes--;

 	    while (1) {

 		if (Tcl_ParseCommand(parsePtr->interp, src,

 			numBytes, 1, &nested) != TCL_OK) {

 		    parsePtr->errorType = nested.errorType;

 		    parsePtr->term = nested.term;

 		    parsePtr->incomplete = nested.incomplete;

 		    return TCL_ERROR;

 		}

 		src = nested.commandStart + nested.commandSize;

 		numBytes = parsePtr->end - src;

 		/*

 		 * This is equivalent to Tcl_FreeParse(&nested), but

 		 * presumably inlined here for sake of runtime optimization

 		 */

 		if (nested.tokenPtr != nested.staticTokens) {

 		    ckfree((char *) nested.tokenPtr);

 		}

 		/*

 		 * Check for the closing ']' that ends the command

 		 * substitution.  It must have been the last character of

 		 * the parsed command.

 		 */

 		if ((nested.term < parsePtr->end) && (*nested.term == ']')

 			&& !nested.incomplete) {

 		    break;

 		}

 		if (numBytes == 0) {

 		    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.

 	     */

 	    TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);

 	    if (tokenPtr->size == 1) {

 		/* Just a backslash, due to end of string */

 		tokenPtr->type = TCL_TOKEN_TEXT;

 		parsePtr->numTokens++;

 		src++; numBytes--;

 		continue;

 	    }

 	    if (src[1] == '\n') {

 		if (numBytes == 2) {

 		    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) {

 		    if (parsePtr->numTokens == originalTokens) {

 			goto finishToken;

 		    }

 		    break;

 		}

 	    }

 	    tokenPtr->type = TCL_TOKEN_BS;

 	    parsePtr->numTokens++;

 	    src += tokenPtr->size;

 	    numBytes -= tokenPtr->size;

 	} else if (*src == 0) {

 	    tokenPtr->type = TCL_TOKEN_TEXT;

 	    tokenPtr->size = 1;

 	    parsePtr->numTokens++;

 	    src++; numBytes--;

 	} 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.

 	 */

 	if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	    TclExpandTokenArray(parsePtr);

 	}

 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];

 	tokenPtr->start = src;

 	tokenPtr->numComponents = 0;

 	finishToken:

 	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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C 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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ParseVarName --

  *

  *	Given a string starting with a $ sign, parse off a variable

  *	name and return information about the parse.  No more than

  *	numBytes bytes will be scanned.

  *

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

  *

  *----------------------------------------------------------------------

  */

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

     CONST char *string;		/* String containing variable name.  First

 				 * character must be "$". */

     register 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;

     register CONST char *src;

     unsigned char c;

     int varIndex, offset;

     Tcl_UniChar ch;

     unsigned array;

     if ((numBytes == 0) || (string == NULL)) {

 	return TCL_ERROR;

     }

     if (numBytes < 0) {

 	numBytes = strlen(string);

     }

     if (!append) {

 	parsePtr->numWords = 0;

 	parsePtr->tokenPtr = parsePtr->staticTokens;

 	parsePtr->numTokens = 0;

 	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;

 	parsePtr->string = string;

 	parsePtr->end = (string + numBytes);

 	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++; numBytes--;

     if (numBytes == 0) {

 	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++; numBytes--;

 	tokenPtr->type = TCL_TOKEN_TEXT;

 	tokenPtr->start = src;

 	tokenPtr->numComponents = 0;

 	while (numBytes && (*src != '}')) {

 	    numBytes--; src++;

 	}

 	if (numBytes == 0) {

 	    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;

 	}

 	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 (numBytes) {

 	    if (Tcl_UtfCharComplete(src, numBytes)) {

 	        offset = Tcl_UtfToUniChar(src, &ch);

 	    } else {

 		char utfBytes[TCL_UTF_MAX];

 		memcpy(utfBytes, src, (size_t) numBytes);

 		utfBytes[numBytes] = '\0';

 	        offset = Tcl_UtfToUniChar(utfBytes, &ch);

 	    }

 	    c = UCHAR(ch);

 	    if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */

 		src += offset;  numBytes -= offset;

 		continue;

 	    }

 	    if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {

 		src += 2; numBytes -= 2;

 		while (numBytes && (*src == ':')) {

 		    src++; numBytes--; 

 		}

 		continue;

 	    }

 	    break;

 	}

 	/*

 	 * Support for empty array names here.

 	 */

 	array = (numBytes && (*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, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)

 		    != TCL_OK) {

 		goto error;

 	    }

 	    if ((parsePtr->term == (src + numBytes)) 

 		    || (*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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_ParseVar(interp, string, termPtr)

     Tcl_Interp *interp;			/* Context for looking up variable. */

     register CONST char *string;	/* String containing variable name.

 					 * First character must be "$". */

     CONST 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;

     int code;

     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 "$";

     }

     code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);

     if (code != TCL_OK) {

 	return NULL;

     }

     objPtr = Tcl_GetObjResult(interp);

     /*

      * At this point we should have an object containing the value of

      * a variable.  Just return the string from that object.

      *

      * This should have returned the object for the user to manage, but

      * instead we have some weak reference to the string value in the

      * object, which is why we make sure the object exists after resetting

      * the result.  This isn't ideal, but it's the best we can do with the

      * current documented interface. -- hobbs

      */

     if (!Tcl_IsShared(objPtr)) {

 	Tcl_IncrRefCount(objPtr);

     }

     Tcl_ResetResult(interp);

     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.  No more than numBytes bytes

  *	will be scanned.

  *

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

  *

  *----------------------------------------------------------------------

  */

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

     CONST char *string;		/* String containing the string in braces.

 				 * The first character must be '{'. */

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

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

 {

     Tcl_Token *tokenPtr;

     register CONST char *src;

     int startIndex, level, length;

     if ((numBytes == 0) || (string == NULL)) {

 	return TCL_ERROR;

     }

     if (numBytes < 0) {

 	numBytes = strlen(string);

     }

     if (!append) {

 	parsePtr->numWords = 0;

 	parsePtr->tokenPtr = parsePtr->staticTokens;

 	parsePtr->numTokens = 0;

 	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;

 	parsePtr->string = string;

 	parsePtr->end = (string + numBytes);

 	parsePtr->interp = interp;

 	parsePtr->errorType = TCL_PARSE_SUCCESS;

     }

     src = string;

     startIndex = parsePtr->numTokens;

     if (parsePtr->numTokens == parsePtr->tokensAvailable) {

 	TclExpandTokenArray(parsePtr);

     }

     tokenPtr = &parsePtr->tokenPtr[startIndex];

     tokenPtr->type = TCL_TOKEN_TEXT;

     tokenPtr->start = src+1;

     tokenPtr->numComponents = 0;

     level = 1;

     while (1) {

 	while (++src, --numBytes) {

 	    if (CHAR_TYPE(*src) != TYPE_NORMAL) {

 		break;

 	    }

 	}

 	if (numBytes == 0) {

 	    register int openBrace = 0;

 	    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;

 	    parsePtr->term = string;

 	    parsePtr->incomplete = 1;

 	    if (interp == NULL) {

 		/*

 		 * Skip straight to the exit code since we have no

 		 * interpreter to put error message in.

 		 */

 		goto error;

 	    }

 	    Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);

 	    /*

 	     *  Guess if the problem is due to comments by searching

 	     *  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 preceded

 	     *  by a '<whitespace>#' on the same line.

 	     */

 	    for (; src > string; src--) {

 		switch (*src) {

 		    case '{':

 			openBrace = 1;

 			break;

 		    case '\n':

 			openBrace = 0;

 			break;

 		    case '#' :

 			if (openBrace && (isspace(UCHAR(src[-1])))) {

 			    Tcl_AppendResult(interp,

 				    ": possible unbalanced brace in comment",

 				    (char *) NULL);

 			    goto error;

 			}

 			break;

 		}

 	    }

 	    error:

 	    Tcl_FreeParse(parsePtr);

 	    return TCL_ERROR;

 	}

 	switch (*src) {

 	    case '{':

 		level++;

 		break;

 	    case '}':

 		if (--level == 0) {

 		    /*

 		     * 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;

 		}

 		break;

 	    case '\\':

 		TclParseBackslash(src, numBytes, &length, NULL);

 		if ((length > 1) && (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 (numBytes == 2) {

 			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 - 1;

 		    numBytes -= length - 1;

 		    tokenPtr++;

 		    tokenPtr->type = TCL_TOKEN_TEXT;

 		    tokenPtr->start = src + 1;

 		    tokenPtr->numComponents = 0;

 		} else {

 		    src += length - 1;

 		    numBytes -= length - 1;

 		}

 		break;

 	}

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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.  No more than

  *	numBytes bytes will be scanned.

  *

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

  *

  *----------------------------------------------------------------------

  */

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

     CONST char *string;		/* String containing the quoted string. 

 				 * The first character must be '"'. */

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

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

 {

     if ((numBytes == 0) || (string == NULL)) {

 	return TCL_ERROR;

     }

     if (numBytes < 0) {

 	numBytes = strlen(string);

     }

     if (!append) {

 	parsePtr->numWords = 0;

 	parsePtr->tokenPtr = parsePtr->staticTokens;

 	parsePtr->numTokens = 0;

 	parsePtr->tokensAvailable = NUM_STATIC_TOKENS;

 	parsePtr->string = string;

 	parsePtr->end = (string + numBytes);

 	parsePtr->interp = interp;

 	parsePtr->errorType = TCL_PARSE_SUCCESS;

     }

     if (ParseTokens(string+1, numBytes-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, numBytes)

     CONST char *script;			/* Script to check. */

     int numBytes;			/* Number of bytes in script. */

 {

     Tcl_Parse parse;

     CONST char *p, *end;

     int result;

     p = script;

     end = p + numBytes;

     while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)

 	    == TCL_OK) {

 	p = parse.commandStart + parse.commandSize;

 	if (p >= end) {

 	    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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C int

 Tcl_CommandComplete(script)

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

 {

     CONST 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;

 }