/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclparseexpr.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclparseexpr.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclparseexpr.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclparseexpr.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclparseexpr.c,v 1.1.1.1 2001/06/13 04:44:43 dtashley Exp $ */  
   
 /*  
  * tclParseExpr.c --  
  *  
  *      This file contains procedures that parse Tcl expressions. 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.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclparseexpr.c,v 1.1.1.1 2001/06/13 04:44:43 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclCompile.h"  
   
 /*  
  * The stuff below is a bit of a hack so that this file can be used in  
  * environments that include no UNIX, i.e. no errno: just arrange to use  
  * the errno from tclExecute.c here.  
  */  
   
 #ifndef TCL_GENERIC_ONLY  
 #include "tclPort.h"  
 #else  
 #define NO_ERRNO_H  
 #endif  
   
 #ifdef NO_ERRNO_H  
 extern int errno;                       /* Use errno from tclExecute.c. */  
 #define ERANGE 34  
 #endif  
   
 /*  
  * Boolean variable that controls whether expression parse tracing  
  * is enabled.  
  */  
   
 #ifdef TCL_COMPILE_DEBUG  
 static int traceParseExpr = 0;  
 #endif /* TCL_COMPILE_DEBUG */  
   
 /*  
  * The ParseInfo structure holds state while parsing an expression.  
  * A pointer to an ParseInfo record is passed among the routines in  
  * this module.  
  */  
   
 typedef struct ParseInfo {  
     Tcl_Parse *parsePtr;        /* Points to structure to fill in with  
                                  * information about the expression. */  
     int lexeme;                 /* Type of last lexeme scanned in expr.  
                                  * See below for definitions. Corresponds to  
                                  * size characters beginning at start. */  
     char *start;                /* First character in lexeme. */  
     int size;                   /* Number of bytes in lexeme. */  
     char *next;                 /* Position of the next character to be  
                                  * scanned in the expression string. */  
     char *prevEnd;              /* Points to the character just after the  
                                  * last one in the previous lexeme. Used to  
                                  * compute size of subexpression tokens. */  
     char *originalExpr;         /* Points to the start of the expression  
                                  * originally passed to Tcl_ParseExpr. */  
     char *lastChar;             /* Points just after last byte of expr. */  
 } ParseInfo;  
   
 /*  
  * Definitions of the different lexemes that appear in expressions. The  
  * order of these must match the corresponding entries in the  
  * operatorStrings array below.  
  */  
   
 #define LITERAL         0  
 #define FUNC_NAME       1  
 #define OPEN_BRACKET    2  
 #define OPEN_BRACE      3  
 #define OPEN_PAREN      4  
 #define CLOSE_PAREN     5  
 #define DOLLAR          6  
 #define QUOTE           7  
 #define COMMA           8  
 #define END             9  
 #define UNKNOWN         10  
   
 /*  
  * Binary operators:  
  */  
   
 #define MULT            11  
 #define DIVIDE          12  
 #define MOD             13  
 #define PLUS            14  
 #define MINUS           15  
 #define LEFT_SHIFT      16  
 #define RIGHT_SHIFT     17  
 #define LESS            18  
 #define GREATER         19  
 #define LEQ             20  
 #define GEQ             21  
 #define EQUAL           22  
 #define NEQ             23  
 #define BIT_AND         24  
 #define BIT_XOR         25  
 #define BIT_OR          26  
 #define AND             27  
 #define OR              28  
 #define QUESTY          29  
 #define COLON           30  
   
 /*  
  * Unary operators. Unary minus and plus are represented by the (binary)  
  * lexemes MINUS and PLUS.  
  */  
   
 #define NOT             31  
 #define BIT_NOT         32  
   
 /*  
  * Mapping from lexemes to strings; used for debugging messages. These  
  * entries must match the order and number of the lexeme definitions above.  
  */  
   
 #ifdef TCL_COMPILE_DEBUG  
 static char *lexemeStrings[] = {  
     "LITERAL", "FUNCNAME",  
     "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN",  
     "*", "/", "%", "+", "-",  
     "<<", ">>", "<", ">", "<=", ">=", "==", "!=",  
     "&", "^", "|", "&&", "||", "?", ":",  
     "!", "~"  
 };  
 #endif /* TCL_COMPILE_DEBUG */  
   
 /*  
  * Declarations for local procedures to this file:  
  */  
   
 static int              GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));  
 static void             LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static int              ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));  
 static void             PrependSubExprTokens _ANSI_ARGS_((char *op,  
                             int opBytes, char *src, int srcBytes,  
                             int firstIndex, ParseInfo *infoPtr));  
   
 /*  
  * Macro used to debug the execution of the recursive descent parser used  
  * to parse expressions.  
  */  
   
 #ifdef TCL_COMPILE_DEBUG  
 #define HERE(production, level) \  
     if (traceParseExpr) { \  
         fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \  
                 (level), " ", (production), \  
                 lexemeStrings[infoPtr->lexeme], infoPtr->next); \  
     }  
 #else  
 #define HERE(production, level)  
 #endif /* TCL_COMPILE_DEBUG */  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_ParseExpr --  
  *  
  *      Given a string, this procedure parses the first Tcl expression  
  *      in the string and returns information about the structure of  
  *      the expression. This procedure is the top-level interface to the  
  *      the expression parsing module.  
  *  
  * 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 expression that  
  *      was parsed.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the expression, 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_ParseExpr(interp, string, numBytes, parsePtr)  
     Tcl_Interp *interp;         /* Used for error reporting. */  
     char *string;               /* The source string to parse. */  
     int numBytes;               /* 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 with information about  
                                  * the parsed expression; any previous  
                                  * information in the structure is  
                                  * ignored. */  
 {  
     ParseInfo info;  
     int code;  
     char savedChar;  
   
     if (numBytes < 0) {  
         numBytes = (string? strlen(string) : 0);  
     }  
 #ifdef TCL_COMPILE_DEBUG  
     if (traceParseExpr) {  
         fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",  
                 numBytes, string);  
     }  
 #endif /* TCL_COMPILE_DEBUG */  
       
     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->interp = interp;  
     parsePtr->term = string;  
     parsePtr->incomplete = 0;  
   
     /*  
      * 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];  
     string[numBytes] = 0;  
   
     /*  
      * Initialize the ParseInfo structure that holds state while parsing  
      * the expression.  
      */  
   
     info.parsePtr = parsePtr;  
     info.lexeme = UNKNOWN;  
     info.start = NULL;  
     info.size = 0;  
     info.next = string;  
     info.prevEnd = string;  
     info.originalExpr = string;  
     info.lastChar = (string + numBytes); /* just after last char of expr */  
   
     /*  
      * Get the first lexeme then parse the expression.  
      */  
   
     code = GetLexeme(&info);  
     if (code != TCL_OK) {  
         goto error;  
     }  
     code = ParseCondExpr(&info);  
     if (code != TCL_OK) {  
         goto error;  
     }  
     if (info.lexeme != END) {  
         LogSyntaxError(&info);  
         goto error;  
     }  
     string[numBytes] = (char) savedChar;  
     return TCL_OK;  
       
     error:  
     string[numBytes] = (char) savedChar;  
     if (parsePtr->tokenPtr != parsePtr->staticTokens) {  
         ckfree((char *) parsePtr->tokenPtr);  
     }  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseCondExpr --  
  *  
  *      This procedure parses a Tcl conditional expression:  
  *      condExpr ::= lorExpr ['?' condExpr ':' condExpr]  
  *  
  *      Note that this is the topmost recursive-descent parsing routine used  
  *      by TclParseExpr to parse expressions. This avoids an extra procedure  
  *      call since such a procedure would only return the result of calling  
  *      ParseCondExpr. Other recursive-descent procedures that need to parse  
  *      complete expressions also call ParseCondExpr.  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseCondExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;  
     int firstIndex, numToMove, code;  
     char *srcStart;  
       
     HERE("condExpr", 1);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseLorExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
       
     if (infoPtr->lexeme == QUESTY) {  
         /*  
          * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire  
          * conditional expression, and a TCL_TOKEN_OPERATOR token for  
          * the "?" operator. Note that these two tokens must be inserted  
          * before the LOR operand tokens generated above.  
          */  
   
         if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {  
             TclExpandTokenArray(parsePtr);  
         }  
         firstTokenPtr = &parsePtr->tokenPtr[firstIndex];  
         tokenPtr = (firstTokenPtr + 2);  
         numToMove = (parsePtr->numTokens - firstIndex);  
         memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,  
                 (size_t) (numToMove * sizeof(Tcl_Token)));  
         parsePtr->numTokens += 2;  
           
         tokenPtr = firstTokenPtr;  
         tokenPtr->type = TCL_TOKEN_SUB_EXPR;  
         tokenPtr->start = srcStart;  
           
         tokenPtr++;  
         tokenPtr->type = TCL_TOKEN_OPERATOR;  
         tokenPtr->start = infoPtr->start;  
         tokenPtr->size = 1;  
         tokenPtr->numComponents = 0;  
       
         /*  
          * Skip over the '?'.  
          */  
           
         code = GetLexeme(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Parse the "then" expression.  
          */  
   
         code = ParseCondExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
         if (infoPtr->lexeme != COLON) {  
             LogSyntaxError(infoPtr);  
             return TCL_ERROR;  
         }  
         code = GetLexeme(infoPtr); /* skip over the ':' */  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Parse the "else" expression.  
          */  
   
         code = ParseCondExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Now set the size-related fields in the '?' subexpression token.  
          */  
   
         condTokenPtr = &parsePtr->tokenPtr[firstIndex];  
         condTokenPtr->size = (infoPtr->prevEnd - srcStart);  
         condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseLorExpr --  
  *  
  *      This procedure parses a Tcl logical or expression:  
  *      lorExpr ::= landExpr {'||' landExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseLorExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, code;  
     char *srcStart, *operator;  
       
     HERE("lorExpr", 2);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseLandExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     while (infoPtr->lexeme == OR) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the '||' */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseLandExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the LOR subexpression and the '||' operator.  
          */  
   
         PrependSubExprTokens(operator, 2, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseLandExpr --  
  *  
  *      This procedure parses a Tcl logical and expression:  
  *      landExpr ::= bitOrExpr {'&&' bitOrExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseLandExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, code;  
     char *srcStart, *operator;  
   
     HERE("landExpr", 3);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseBitOrExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     while (infoPtr->lexeme == AND) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the '&&' */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseBitOrExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the LAND subexpression and the '&&' operator.  
          */  
   
         PrependSubExprTokens(operator, 2, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseBitOrExpr --  
  *  
  *      This procedure parses a Tcl bitwise or expression:  
  *      bitOrExpr ::= bitXorExpr {'|' bitXorExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseBitOrExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, code;  
     char *srcStart, *operator;  
   
     HERE("bitOrExpr", 4);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseBitXorExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
       
     while (infoPtr->lexeme == BIT_OR) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the '|' */  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         code = ParseBitXorExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
           
         /*  
          * Generate tokens for the BITOR subexpression and the '|' operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseBitXorExpr --  
  *  
  *      This procedure parses a Tcl bitwise exclusive or expression:  
  *      bitXorExpr ::= bitAndExpr {'^' bitAndExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseBitXorExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, code;  
     char *srcStart, *operator;  
   
     HERE("bitXorExpr", 5);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseBitAndExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
       
     while (infoPtr->lexeme == BIT_XOR) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the '^' */  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         code = ParseBitAndExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
           
         /*  
          * Generate tokens for the XOR subexpression and the '^' operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseBitAndExpr --  
  *  
  *      This procedure parses a Tcl bitwise and expression:  
  *      bitAndExpr ::= equalityExpr {'&' equalityExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseBitAndExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, code;  
     char *srcStart, *operator;  
   
     HERE("bitAndExpr", 6);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseEqualityExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
       
     while (infoPtr->lexeme == BIT_AND) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the '&' */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseEqualityExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
           
         /*  
          * Generate tokens for the BITAND subexpression and '&' operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseEqualityExpr --  
  *  
  *      This procedure parses a Tcl equality (inequality) expression:  
  *      equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseEqualityExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, code;  
     char *srcStart, *operator;  
   
     HERE("equalityExpr", 7);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseRelationalExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     lexeme = infoPtr->lexeme;  
     while ((lexeme == EQUAL) || (lexeme == NEQ)) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over == or != */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseRelationalExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and '==' or '!=' operator.  
          */  
   
         PrependSubExprTokens(operator, 2, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
         lexeme = infoPtr->lexeme;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseRelationalExpr --  
  *  
  *      This procedure parses a Tcl relational expression:  
  *      relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseRelationalExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, operatorSize, code;  
     char *srcStart, *operator;  
   
     HERE("relationalExpr", 8);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseShiftExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     lexeme = infoPtr->lexeme;  
     while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)  
             || (lexeme == GEQ)) {  
         operator = infoPtr->start;  
         if ((lexeme == LEQ) || (lexeme == GEQ)) {  
             operatorSize = 2;  
         } else {  
             operatorSize = 1;  
         }  
         code = GetLexeme(infoPtr); /* skip over the operator */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseShiftExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and the operator.  
          */  
   
         PrependSubExprTokens(operator, operatorSize, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
         lexeme = infoPtr->lexeme;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseShiftExpr --  
  *  
  *      This procedure parses a Tcl shift expression:  
  *      shiftExpr ::= addExpr {('<<' | '>>') addExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseShiftExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, code;  
     char *srcStart, *operator;  
   
     HERE("shiftExpr", 9);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseAddExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     lexeme = infoPtr->lexeme;  
     while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over << or >> */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseAddExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and '<<' or '>>' operator.  
          */  
   
         PrependSubExprTokens(operator, 2, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
         lexeme = infoPtr->lexeme;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseAddExpr --  
  *  
  *      This procedure parses a Tcl addition expression:  
  *      addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseAddExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, code;  
     char *srcStart, *operator;  
   
     HERE("addExpr", 10);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseMultiplyExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     lexeme = infoPtr->lexeme;  
     while ((lexeme == PLUS) || (lexeme == MINUS)) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over + or - */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseMultiplyExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and '+' or '-' operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
         lexeme = infoPtr->lexeme;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseMultiplyExpr --  
  *  
  *      This procedure parses a Tcl multiply expression:  
  *      multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseMultiplyExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, code;  
     char *srcStart, *operator;  
   
     HERE("multiplyExpr", 11);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     code = ParseUnaryExpr(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
   
     lexeme = infoPtr->lexeme;  
     while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over * or / or % */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseUnaryExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and * or / or % operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
         lexeme = infoPtr->lexeme;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParseUnaryExpr --  
  *  
  *      This procedure parses a Tcl unary expression:  
  *      unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParseUnaryExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     int firstIndex, lexeme, code;  
     char *srcStart, *operator;  
   
     HERE("unaryExpr", 12);  
     srcStart = infoPtr->start;  
     firstIndex = parsePtr->numTokens;  
       
     lexeme = infoPtr->lexeme;  
     if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)  
             || (lexeme == NOT)) {  
         operator = infoPtr->start;  
         code = GetLexeme(infoPtr); /* skip over the unary operator */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseUnaryExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         /*  
          * Generate tokens for the subexpression and the operator.  
          */  
   
         PrependSubExprTokens(operator, 1, srcStart,  
                 (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);  
     } else {                    /* must be a primaryExpr */  
         code = ParsePrimaryExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ParsePrimaryExpr --  
  *  
  *      This procedure parses a Tcl primary expression:  
  *      primaryExpr ::= literal | varReference | quotedString |  
  *                      '[' command ']' | mathFuncCall | '(' condExpr ')'  
  *  
  * Results:  
  *      The return value is TCL_OK on a successful parse and TCL_ERROR  
  *      on failure. If TCL_ERROR is returned, then the interpreter's result  
  *      contains an error message.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ParsePrimaryExpr(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     Tcl_Interp *interp = parsePtr->interp;  
     Tcl_Token *tokenPtr, *exprTokenPtr;  
     Tcl_Parse nested;  
     char *dollarPtr, *stringStart, *termPtr, *src;  
     int lexeme, exprIndex, firstIndex, numToMove, code;  
   
     /*  
      * We simply recurse on parenthesized subexpressions.  
      */  
   
     HERE("primaryExpr", 13);  
     lexeme = infoPtr->lexeme;  
     if (lexeme == OPEN_PAREN) {  
         code = GetLexeme(infoPtr); /* skip over the '(' */  
         if (code != TCL_OK) {  
             return code;  
         }  
         code = ParseCondExpr(infoPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
         if (infoPtr->lexeme != CLOSE_PAREN) {  
             goto syntaxError;  
         }  
         code = GetLexeme(infoPtr); /* skip over the ')' */  
         if (code != TCL_OK) {  
             return code;  
         }  
         return TCL_OK;  
     }  
   
     /*  
      * Start a TCL_TOKEN_SUB_EXPR token for the primary.  
      */  
   
     if (parsePtr->numTokens == parsePtr->tokensAvailable) {  
         TclExpandTokenArray(parsePtr);  
     }  
     exprIndex = parsePtr->numTokens;  
     exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
     exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;  
     exprTokenPtr->start = infoPtr->start;  
     parsePtr->numTokens++;  
   
     /*  
      * Process the primary then finish setting the fields of the  
      * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now  
      * stored in "exprTokenPtr" in the code below since the token array  
      * might be reallocated.  
      */  
   
     firstIndex = parsePtr->numTokens;  
     switch (lexeme) {  
     case LITERAL:  
         /*  
          * Int or double number.  
          */  
           
         if (parsePtr->numTokens == parsePtr->tokensAvailable) {  
             TclExpandTokenArray(parsePtr);  
         }  
         tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];  
         tokenPtr->type = TCL_TOKEN_TEXT;  
         tokenPtr->start = infoPtr->start;  
         tokenPtr->size = infoPtr->size;  
         tokenPtr->numComponents = 0;  
         parsePtr->numTokens++;  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = infoPtr->size;  
         exprTokenPtr->numComponents = 1;  
         break;  
           
     case DOLLAR:  
         /*  
          * $var variable reference.  
          */  
           
         dollarPtr = (infoPtr->next - 1);  
         code = Tcl_ParseVarName(interp, dollarPtr,  
                 (infoPtr->lastChar - dollarPtr), parsePtr, 1);  
         if (code != TCL_OK) {  
             return code;  
         }  
         infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;  
         exprTokenPtr->numComponents =  
                 (parsePtr->tokenPtr[firstIndex].numComponents + 1);  
         break;  
           
     case QUOTE:  
         /*  
          * '"' string '"'  
          */  
           
         stringStart = infoPtr->next;  
         code = Tcl_ParseQuotedString(interp, infoPtr->start,  
                 (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
         infoPtr->next = termPtr;  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = (termPtr - exprTokenPtr->start);  
         exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;  
   
         /*  
          * If parsing the quoted string resulted in more than one token,  
          * insert a TCL_TOKEN_WORD token before them. This indicates that  
          * the quoted string represents a concatenation of multiple tokens.  
          */  
   
         if (exprTokenPtr->numComponents > 1) {  
             if (parsePtr->numTokens >= parsePtr->tokensAvailable) {  
                 TclExpandTokenArray(parsePtr);  
             }  
             tokenPtr = &parsePtr->tokenPtr[firstIndex];  
             numToMove = (parsePtr->numTokens - firstIndex);  
             memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,  
                     (size_t) (numToMove * sizeof(Tcl_Token)));  
             parsePtr->numTokens++;  
   
             exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
             exprTokenPtr->numComponents++;  
   
             tokenPtr->type = TCL_TOKEN_WORD;  
             tokenPtr->start = exprTokenPtr->start;  
             tokenPtr->size = exprTokenPtr->size;  
             tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);  
         }  
         break;  
           
     case OPEN_BRACKET:  
         /*  
          * '[' command {command} ']'  
          */  
   
         if (parsePtr->numTokens == parsePtr->tokensAvailable) {  
             TclExpandTokenArray(parsePtr);  
         }  
         tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];  
         tokenPtr->type = TCL_TOKEN_COMMAND;  
         tokenPtr->start = infoPtr->start;  
         tokenPtr->numComponents = 0;  
         parsePtr->numTokens++;  
   
         /*  
          * Call Tcl_ParseCommand repeatedly to parse the nested command(s)  
          * to find their end, then throw away that parse information.  
          */  
           
         src = infoPtr->next;  
         while (1) {  
             if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,  
                     &nested) != TCL_OK) {  
                 parsePtr->term = nested.term;  
                 parsePtr->errorType = nested.errorType;  
                 parsePtr->incomplete = nested.incomplete;  
                 return TCL_ERROR;  
             }  
             src = (nested.commandStart + nested.commandSize);  
             if (nested.tokenPtr != nested.staticTokens) {  
                 ckfree((char *) nested.tokenPtr);  
             }  
             if ((src[-1] == ']') && !nested.incomplete) {  
                 break;  
             }  
             if (src == parsePtr->end) {  
                 if (parsePtr->interp != NULL) {  
                     Tcl_SetResult(interp, "missing close-bracket",  
                             TCL_STATIC);  
                 }  
                 parsePtr->term = tokenPtr->start;  
                 parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;  
                 parsePtr->incomplete = 1;  
                 return TCL_ERROR;  
             }  
         }  
         tokenPtr->size = (src - tokenPtr->start);  
         infoPtr->next = src;  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = (src - tokenPtr->start);  
         exprTokenPtr->numComponents = 1;  
         break;  
   
     case OPEN_BRACE:  
         /*  
          * '{' string '}'  
          */  
   
         code = Tcl_ParseBraces(interp, infoPtr->start,  
                 (infoPtr->lastChar - infoPtr->start), parsePtr, 1,  
                 &termPtr);  
         if (code != TCL_OK) {  
             return code;  
         }  
         infoPtr->next = termPtr;  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = (termPtr - infoPtr->start);  
         exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;  
   
         /*  
          * If parsing the braced string resulted in more than one token,  
          * insert a TCL_TOKEN_WORD token before them. This indicates that  
          * the braced string represents a concatenation of multiple tokens.  
          */  
   
         if (exprTokenPtr->numComponents > 1) {  
             if (parsePtr->numTokens >= parsePtr->tokensAvailable) {  
                 TclExpandTokenArray(parsePtr);  
             }  
             tokenPtr = &parsePtr->tokenPtr[firstIndex];  
             numToMove = (parsePtr->numTokens - firstIndex);  
             memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,  
                     (size_t) (numToMove * sizeof(Tcl_Token)));  
             parsePtr->numTokens++;  
   
             exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
             exprTokenPtr->numComponents++;  
               
             tokenPtr->type = TCL_TOKEN_WORD;  
             tokenPtr->start = exprTokenPtr->start;  
             tokenPtr->size = exprTokenPtr->size;  
             tokenPtr->numComponents = exprTokenPtr->numComponents-1;  
         }  
         break;  
           
     case FUNC_NAME:  
         /*  
          * math_func '(' expr {',' expr} ')'  
          */  
           
         if (parsePtr->numTokens == parsePtr->tokensAvailable) {  
             TclExpandTokenArray(parsePtr);  
         }  
         tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];  
         tokenPtr->type = TCL_TOKEN_OPERATOR;  
         tokenPtr->start = infoPtr->start;  
         tokenPtr->size = infoPtr->size;  
         tokenPtr->numComponents = 0;  
         parsePtr->numTokens++;  
           
         code = GetLexeme(infoPtr); /* skip over function name */  
         if (code != TCL_OK) {  
             return code;  
         }  
         if (infoPtr->lexeme != OPEN_PAREN) {  
             goto syntaxError;  
         }  
         code = GetLexeme(infoPtr); /* skip over '(' */  
         if (code != TCL_OK) {  
             return code;  
         }  
   
         while (infoPtr->lexeme != CLOSE_PAREN) {  
             code = ParseCondExpr(infoPtr);  
             if (code != TCL_OK) {  
                 return code;  
             }  
               
             if (infoPtr->lexeme == COMMA) {  
                 code = GetLexeme(infoPtr); /* skip over , */  
                 if (code != TCL_OK) {  
                     return code;  
                 }  
             } else if (infoPtr->lexeme != CLOSE_PAREN) {  
                 goto syntaxError;  
             }  
         }  
   
         exprTokenPtr = &parsePtr->tokenPtr[exprIndex];  
         exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);  
         exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;  
         break;  
           
     default:  
         goto syntaxError;  
     }  
   
     /*  
      * Advance to the next lexeme before returning.  
      */  
       
     code = GetLexeme(infoPtr);  
     if (code != TCL_OK) {  
         return code;  
     }  
     parsePtr->term = infoPtr->next;  
     return TCL_OK;  
   
     syntaxError:  
     LogSyntaxError(infoPtr);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetLexeme --  
  *  
  *      Lexical scanner for Tcl expressions: scans a single operator or  
  *      other syntactic element from an expression string.  
  *  
  * Results:  
  *      TCL_OK is returned unless an error occurred. In that case a standard  
  *      Tcl error code is returned and, if infoPtr->parsePtr->interp is  
  *      non-NULL, the interpreter's result is set to hold an error  
  *      message. TCL_ERROR is returned if an integer overflow, or a  
  *      floating-point overflow or underflow occurred while reading in a  
  *      number. If the lexical analysis is successful, infoPtr->lexeme  
  *      refers to the next symbol in the expression string, and  
  *      infoPtr->next is advanced past the lexeme. Also, if the lexeme is a  
  *      LITERAL or FUNC_NAME, then infoPtr->start is set to the first  
  *      character of the lexeme; otherwise it is set NULL.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold all the  
  *      information about the subexpression, then additional space is  
  *      malloc-ed..  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 GetLexeme(infoPtr)  
     ParseInfo *infoPtr;         /* Holds state needed to parse the expr,  
                                  * including the resulting lexeme. */  
 {  
     register char *src;         /* Points to current source char. */  
     char *termPtr;              /* Points to char terminating a literal. */  
     double doubleValue;         /* Value of a scanned double literal. */  
     char c;  
     int startsWithDigit, offset;  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     Tcl_Interp *interp = parsePtr->interp;  
     Tcl_UniChar ch;  
   
     /*  
      * Record where the previous lexeme ended. Since we always read one  
      * lexeme ahead during parsing, this helps us know the source length of  
      * subexpression tokens.  
      */  
   
     infoPtr->prevEnd = infoPtr->next;  
   
     /*  
      * Scan over leading white space at the start of a lexeme. Note that a  
      * backslash-newline is treated as a space.  
      */  
   
     src = infoPtr->next;  
     c = *src;  
     while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */  
         if (c == '\\') {  
             if (src[1] == '\n') {  
                 src += 2;  
             } else {  
                 break;  /* no longer white space */  
             }  
         } else {  
             src++;  
         }  
         c = *src;  
     }  
     parsePtr->term = src;  
     if (src >= infoPtr->lastChar) {  
         infoPtr->lexeme = END;  
         infoPtr->next = src;  
         return TCL_OK;  
     }  
   
     /*  
      * Try to parse the lexeme first as an integer or floating-point  
      * number. Don't check for a number if the first character c is  
      * "+" or "-". If we did, we might treat a binary operator as unary  
      * by mistake, which would eventually cause a syntax error.  
      */  
   
     if ((c != '+') && (c != '-')) {  
         startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */  
         if (startsWithDigit && TclLooksLikeInt(src, -1)) {  
             errno = 0;  
             (void) strtoul(src, &termPtr, 0);  
             if (errno == ERANGE) {  
                 if (interp != NULL) {  
                     char *s = "integer value too large to represent";  
                     Tcl_ResetResult(interp);  
                     Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);  
                     Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,  
                             (char *) NULL);  
                 }  
                 parsePtr->errorType = TCL_PARSE_BAD_NUMBER;  
                 return TCL_ERROR;  
             }  
             if (termPtr != src) {  
                 /*  
                  * src was the start of a valid integer, but was it  
                  * a bad octal?  Stopping at a digit would cause that.  
                  */  
                 if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */  
                     /*  
                      * We only want to report an error for the number,  
                      * but we may have something like "08+1"  
                      */  
                     if (interp != NULL) {  
                         while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */  
                         Tcl_ResetResult(interp);  
                         offset = termPtr - src;  
                         c = src[offset];  
                         src[offset] = 0;  
                         Tcl_AppendResult(interp, "\"", src,  
                                 "\" is an invalid octal number",  
                                 (char *) NULL);  
                         src[offset] = c;  
                     }  
                     parsePtr->errorType = TCL_PARSE_BAD_NUMBER;  
                     return TCL_ERROR;  
                 }  
   
                 infoPtr->lexeme = LITERAL;  
                 infoPtr->start = src;  
                 infoPtr->size = (termPtr - src);  
                 infoPtr->next = termPtr;  
                 parsePtr->term = termPtr;  
                 return TCL_OK;  
             }  
         } else if (startsWithDigit || (c == '.')  
                 || (c == 'n') || (c == 'N')) {  
             errno = 0;  
             doubleValue = strtod(src, &termPtr);  
             if (termPtr != src) {  
                 if (errno != 0) {  
                     if (interp != NULL) {  
                         TclExprFloatError(interp, doubleValue);  
                     }  
                     parsePtr->errorType = TCL_PARSE_BAD_NUMBER;  
                     return TCL_ERROR;  
                 }  
                   
                 /*  
                  * src was the start of a valid double.  
                  */  
                   
                 infoPtr->lexeme = LITERAL;  
                 infoPtr->start = src;  
                 infoPtr->size = (termPtr - src);  
                 infoPtr->next = termPtr;  
                 parsePtr->term = termPtr;  
                 return TCL_OK;  
             }  
         }  
     }  
   
     /*  
      * Not an integer or double literal. Initialize the lexeme's fields  
      * assuming the common case of a single character lexeme.  
      */  
   
     infoPtr->start = src;  
     infoPtr->size = 1;  
     infoPtr->next = src+1;  
     parsePtr->term = infoPtr->next;  
       
     switch (*src) {  
         case '[':  
             infoPtr->lexeme = OPEN_BRACKET;  
             return TCL_OK;  
   
         case '{':  
             infoPtr->lexeme = OPEN_BRACE;  
             return TCL_OK;  
   
         case '(':  
             infoPtr->lexeme = OPEN_PAREN;  
             return TCL_OK;  
   
         case ')':  
             infoPtr->lexeme = CLOSE_PAREN;  
             return TCL_OK;  
   
         case '$':  
             infoPtr->lexeme = DOLLAR;  
             return TCL_OK;  
   
         case '\"':  
             infoPtr->lexeme = QUOTE;  
             return TCL_OK;  
   
         case ',':  
             infoPtr->lexeme = COMMA;  
             return TCL_OK;  
   
         case '*':  
             infoPtr->lexeme = MULT;  
             return TCL_OK;  
   
         case '/':  
             infoPtr->lexeme = DIVIDE;  
             return TCL_OK;  
   
         case '%':  
             infoPtr->lexeme = MOD;  
             return TCL_OK;  
   
         case '+':  
             infoPtr->lexeme = PLUS;  
             return TCL_OK;  
   
         case '-':  
             infoPtr->lexeme = MINUS;  
             return TCL_OK;  
   
         case '?':  
             infoPtr->lexeme = QUESTY;  
             return TCL_OK;  
   
         case ':':  
             infoPtr->lexeme = COLON;  
             return TCL_OK;  
   
         case '<':  
             switch (src[1]) {  
                 case '<':  
                     infoPtr->lexeme = LEFT_SHIFT;  
                     infoPtr->size = 2;  
                     infoPtr->next = src+2;  
                     break;  
                 case '=':  
                     infoPtr->lexeme = LEQ;  
                     infoPtr->size = 2;  
                     infoPtr->next = src+2;  
                     break;  
                 default:  
                     infoPtr->lexeme = LESS;  
                     break;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '>':  
             switch (src[1]) {  
                 case '>':  
                     infoPtr->lexeme = RIGHT_SHIFT;  
                     infoPtr->size = 2;  
                     infoPtr->next = src+2;  
                     break;  
                 case '=':  
                     infoPtr->lexeme = GEQ;  
                     infoPtr->size = 2;  
                     infoPtr->next = src+2;  
                     break;  
                 default:  
                     infoPtr->lexeme = GREATER;  
                     break;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '=':  
             if (src[1] == '=') {  
                 infoPtr->lexeme = EQUAL;  
                 infoPtr->size = 2;  
                 infoPtr->next = src+2;  
             } else {  
                 infoPtr->lexeme = UNKNOWN;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '!':  
             if (src[1] == '=') {  
                 infoPtr->lexeme = NEQ;  
                 infoPtr->size = 2;  
                 infoPtr->next = src+2;  
             } else {  
                 infoPtr->lexeme = NOT;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '&':  
             if (src[1] == '&') {  
                 infoPtr->lexeme = AND;  
                 infoPtr->size = 2;  
                 infoPtr->next = src+2;  
             } else {  
                 infoPtr->lexeme = BIT_AND;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '^':  
             infoPtr->lexeme = BIT_XOR;  
             return TCL_OK;  
   
         case '|':  
             if (src[1] == '|') {  
                 infoPtr->lexeme = OR;  
                 infoPtr->size = 2;  
                 infoPtr->next = src+2;  
             } else {  
                 infoPtr->lexeme = BIT_OR;  
             }  
             parsePtr->term = infoPtr->next;  
             return TCL_OK;  
   
         case '~':  
             infoPtr->lexeme = BIT_NOT;  
             return TCL_OK;  
   
         default:  
             offset = Tcl_UtfToUniChar(src, &ch);  
             c = UCHAR(ch);  
             if (isalpha(UCHAR(c))) {    /* INTL: ISO only. */  
                 infoPtr->lexeme = FUNC_NAME;  
                 while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */  
                     src += offset;  
                     offset = Tcl_UtfToUniChar(src, &ch);  
                     c = UCHAR(ch);  
                 }  
                 infoPtr->size = (src - infoPtr->start);  
                 infoPtr->next = src;  
                 parsePtr->term = infoPtr->next;  
                 return TCL_OK;  
             }  
             infoPtr->lexeme = UNKNOWN;  
             return TCL_OK;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * PrependSubExprTokens --  
  *  
  *      This procedure is called after the operands of an subexpression have  
  *      been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for  
  *      the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.  
  *      These two tokens are inserted before the operand tokens.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      If there is insufficient space in parsePtr to hold the new tokens,  
  *      additional space is malloc-ed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)  
     char *op;                   /* Points to first byte of the operator  
                                  * in the source script. */  
     int opBytes;                /* Number of bytes in the operator. */  
     char *src;                  /* Points to first byte of the subexpression  
                                  * in the source script. */  
     int srcBytes;               /* Number of bytes in subexpression's  
                                  * source. */  
     int firstIndex;             /* Index of first token already emitted for  
                                  * operator's first (or only) operand. */  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     Tcl_Parse *parsePtr = infoPtr->parsePtr;  
     Tcl_Token *tokenPtr, *firstTokenPtr;  
     int numToMove;  
   
     if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {  
         TclExpandTokenArray(parsePtr);  
     }  
     firstTokenPtr = &parsePtr->tokenPtr[firstIndex];  
     tokenPtr = (firstTokenPtr + 2);  
     numToMove = (parsePtr->numTokens - firstIndex);  
     memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,  
             (size_t) (numToMove * sizeof(Tcl_Token)));  
     parsePtr->numTokens += 2;  
       
     tokenPtr = firstTokenPtr;  
     tokenPtr->type = TCL_TOKEN_SUB_EXPR;  
     tokenPtr->start = src;  
     tokenPtr->size = srcBytes;  
     tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);  
       
     tokenPtr++;  
     tokenPtr->type = TCL_TOKEN_OPERATOR;  
     tokenPtr->start = op;  
     tokenPtr->size = opBytes;  
     tokenPtr->numComponents = 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * LogSyntaxError --  
  *  
  *      This procedure is invoked after an error occurs when parsing an  
  *      expression. It sets the interpreter result to an error message  
  *      describing the error.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Sets the interpreter result to an error message describing the  
  *      expression that was being parsed when the error occurred.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 LogSyntaxError(infoPtr)  
     ParseInfo *infoPtr;         /* Holds the parse state for the  
                                  * expression being parsed. */  
 {  
     int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);  
     char buffer[100];  
   
     sprintf(buffer, "syntax error in expression \"%.*s\"",  
             ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);  
     Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),  
             buffer, (char *) NULL);  
     infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;  
     infoPtr->parsePtr->term = infoPtr->start;  
 }  
   
   
 /* $History: tclparseexpr.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:37a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLPARSEEXPR.C */  
1    /* $Header$ */
2    /*
3     * tclParseExpr.c --
4     *
5     *      This file contains procedures that parse Tcl expressions. They
6     *      do so in a general-purpose fashion that can be used for many
7     *      different purposes, including compilation, direct execution,
8     *      code analysis, etc.
9     *
10     * Copyright (c) 1997 Sun Microsystems, Inc.
11     *
12     * See the file "license.terms" for information on usage and redistribution
13     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14     *
15     * RCS: @(#) $Id: tclparseexpr.c,v 1.1.1.1 2001/06/13 04:44:43 dtashley Exp $
16     */
17    
18    #include "tclInt.h"
19    #include "tclCompile.h"
20    
21    /*
22     * The stuff below is a bit of a hack so that this file can be used in
23     * environments that include no UNIX, i.e. no errno: just arrange to use
24     * the errno from tclExecute.c here.
25     */
26    
27    #ifndef TCL_GENERIC_ONLY
28    #include "tclPort.h"
29    #else
30    #define NO_ERRNO_H
31    #endif
32    
33    #ifdef NO_ERRNO_H
34    extern int errno;                       /* Use errno from tclExecute.c. */
35    #define ERANGE 34
36    #endif
37    
38    /*
39     * Boolean variable that controls whether expression parse tracing
40     * is enabled.
41     */
42    
43    #ifdef TCL_COMPILE_DEBUG
44    static int traceParseExpr = 0;
45    #endif /* TCL_COMPILE_DEBUG */
46    
47    /*
48     * The ParseInfo structure holds state while parsing an expression.
49     * A pointer to an ParseInfo record is passed among the routines in
50     * this module.
51     */
52    
53    typedef struct ParseInfo {
54        Tcl_Parse *parsePtr;        /* Points to structure to fill in with
55                                     * information about the expression. */
56        int lexeme;                 /* Type of last lexeme scanned in expr.
57                                     * See below for definitions. Corresponds to
58                                     * size characters beginning at start. */
59        char *start;                /* First character in lexeme. */
60        int size;                   /* Number of bytes in lexeme. */
61        char *next;                 /* Position of the next character to be
62                                     * scanned in the expression string. */
63        char *prevEnd;              /* Points to the character just after the
64                                     * last one in the previous lexeme. Used to
65                                     * compute size of subexpression tokens. */
66        char *originalExpr;         /* Points to the start of the expression
67                                     * originally passed to Tcl_ParseExpr. */
68        char *lastChar;             /* Points just after last byte of expr. */
69    } ParseInfo;
70    
71    /*
72     * Definitions of the different lexemes that appear in expressions. The
73     * order of these must match the corresponding entries in the
74     * operatorStrings array below.
75     */
76    
77    #define LITERAL         0
78    #define FUNC_NAME       1
79    #define OPEN_BRACKET    2
80    #define OPEN_BRACE      3
81    #define OPEN_PAREN      4
82    #define CLOSE_PAREN     5
83    #define DOLLAR          6
84    #define QUOTE           7
85    #define COMMA           8
86    #define END             9
87    #define UNKNOWN         10
88    
89    /*
90     * Binary operators:
91     */
92    
93    #define MULT            11
94    #define DIVIDE          12
95    #define MOD             13
96    #define PLUS            14
97    #define MINUS           15
98    #define LEFT_SHIFT      16
99    #define RIGHT_SHIFT     17
100    #define LESS            18
101    #define GREATER         19
102    #define LEQ             20
103    #define GEQ             21
104    #define EQUAL           22
105    #define NEQ             23
106    #define BIT_AND         24
107    #define BIT_XOR         25
108    #define BIT_OR          26
109    #define AND             27
110    #define OR              28
111    #define QUESTY          29
112    #define COLON           30
113    
114    /*
115     * Unary operators. Unary minus and plus are represented by the (binary)
116     * lexemes MINUS and PLUS.
117     */
118    
119    #define NOT             31
120    #define BIT_NOT         32
121    
122    /*
123     * Mapping from lexemes to strings; used for debugging messages. These
124     * entries must match the order and number of the lexeme definitions above.
125     */
126    
127    #ifdef TCL_COMPILE_DEBUG
128    static char *lexemeStrings[] = {
129        "LITERAL", "FUNCNAME",
130        "[", "{", "(", ")", "$", "\"", ",", "END", "UNKNOWN",
131        "*", "/", "%", "+", "-",
132        "<<", ">>", "<", ">", "<=", ">=", "==", "!=",
133        "&", "^", "|", "&&", "||", "?", ":",
134        "!", "~"
135    };
136    #endif /* TCL_COMPILE_DEBUG */
137    
138    /*
139     * Declarations for local procedures to this file:
140     */
141    
142    static int              GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
143    static void             LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr));
144    static int              ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
145    static int              ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
146    static int              ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
147    static int              ParseBitXorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
148    static int              ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
149    static int              ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
150    static int              ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
151    static int              ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
152    static int              ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
153    static int              ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
154    static int              ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
155    static int              ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
156    static int              ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
157    static void             PrependSubExprTokens _ANSI_ARGS_((char *op,
158                                int opBytes, char *src, int srcBytes,
159                                int firstIndex, ParseInfo *infoPtr));
160    
161    /*
162     * Macro used to debug the execution of the recursive descent parser used
163     * to parse expressions.
164     */
165    
166    #ifdef TCL_COMPILE_DEBUG
167    #define HERE(production, level) \
168        if (traceParseExpr) { \
169            fprintf(stderr, "%*s%s: lexeme=%s, next=\"%.20s\"\n", \
170                    (level), " ", (production), \
171                    lexemeStrings[infoPtr->lexeme], infoPtr->next); \
172        }
173    #else
174    #define HERE(production, level)
175    #endif /* TCL_COMPILE_DEBUG */
176    
177    /*
178     *----------------------------------------------------------------------
179     *
180     * Tcl_ParseExpr --
181     *
182     *      Given a string, this procedure parses the first Tcl expression
183     *      in the string and returns information about the structure of
184     *      the expression. This procedure is the top-level interface to the
185     *      the expression parsing module.
186     *
187     * Results:
188     *      The return value is TCL_OK if the command was parsed successfully
189     *      and TCL_ERROR otherwise. If an error occurs and interp isn't NULL
190     *      then an error message is left in its result. On a successful return,
191     *      parsePtr is filled in with information about the expression that
192     *      was parsed.
193     *
194     * Side effects:
195     *      If there is insufficient space in parsePtr to hold all the
196     *      information about the expression, then additional space is
197     *      malloc-ed. If the procedure returns TCL_OK then the caller must
198     *      eventually invoke Tcl_FreeParse to release any additional space
199     *      that was allocated.
200     *
201     *----------------------------------------------------------------------
202     */
203    
204    int
205    Tcl_ParseExpr(interp, string, numBytes, parsePtr)
206        Tcl_Interp *interp;         /* Used for error reporting. */
207        char *string;               /* The source string to parse. */
208        int numBytes;               /* Number of bytes in string. If < 0, the
209                                     * string consists of all bytes up to the
210                                     * first null character. */
211        Tcl_Parse *parsePtr;        /* Structure to fill with information about
212                                     * the parsed expression; any previous
213                                     * information in the structure is
214                                     * ignored. */
215    {
216        ParseInfo info;
217        int code;
218        char savedChar;
219    
220        if (numBytes < 0) {
221            numBytes = (string? strlen(string) : 0);
222        }
223    #ifdef TCL_COMPILE_DEBUG
224        if (traceParseExpr) {
225            fprintf(stderr, "Tcl_ParseExpr: string=\"%.*s\"\n",
226                    numBytes, string);
227        }
228    #endif /* TCL_COMPILE_DEBUG */
229        
230        parsePtr->commentStart = NULL;
231        parsePtr->commentSize = 0;
232        parsePtr->commandStart = NULL;
233        parsePtr->commandSize = 0;
234        parsePtr->numWords = 0;
235        parsePtr->tokenPtr = parsePtr->staticTokens;
236        parsePtr->numTokens = 0;
237        parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
238        parsePtr->string = string;
239        parsePtr->end = (string + numBytes);
240        parsePtr->interp = interp;
241        parsePtr->term = string;
242        parsePtr->incomplete = 0;
243    
244        /*
245         * Temporarily overwrite the character just after the end of the
246         * string with a 0 byte.  This acts as a sentinel and reduces the
247         * number of places where we have to check for the end of the
248         * input string.  The original value of the byte is restored at
249         * the end of the parse.
250         */
251    
252        savedChar = string[numBytes];
253        string[numBytes] = 0;
254    
255        /*
256         * Initialize the ParseInfo structure that holds state while parsing
257         * the expression.
258         */
259    
260        info.parsePtr = parsePtr;
261        info.lexeme = UNKNOWN;
262        info.start = NULL;
263        info.size = 0;
264        info.next = string;
265        info.prevEnd = string;
266        info.originalExpr = string;
267        info.lastChar = (string + numBytes); /* just after last char of expr */
268    
269        /*
270         * Get the first lexeme then parse the expression.
271         */
272    
273        code = GetLexeme(&info);
274        if (code != TCL_OK) {
275            goto error;
276        }
277        code = ParseCondExpr(&info);
278        if (code != TCL_OK) {
279            goto error;
280        }
281        if (info.lexeme != END) {
282            LogSyntaxError(&info);
283            goto error;
284        }
285        string[numBytes] = (char) savedChar;
286        return TCL_OK;
287        
288        error:
289        string[numBytes] = (char) savedChar;
290        if (parsePtr->tokenPtr != parsePtr->staticTokens) {
291            ckfree((char *) parsePtr->tokenPtr);
292        }
293        return TCL_ERROR;
294    }
295    
296    /*
297     *----------------------------------------------------------------------
298     *
299     * ParseCondExpr --
300     *
301     *      This procedure parses a Tcl conditional expression:
302     *      condExpr ::= lorExpr ['?' condExpr ':' condExpr]
303     *
304     *      Note that this is the topmost recursive-descent parsing routine used
305     *      by TclParseExpr to parse expressions. This avoids an extra procedure
306     *      call since such a procedure would only return the result of calling
307     *      ParseCondExpr. Other recursive-descent procedures that need to parse
308     *      complete expressions also call ParseCondExpr.
309     *
310     * Results:
311     *      The return value is TCL_OK on a successful parse and TCL_ERROR
312     *      on failure. If TCL_ERROR is returned, then the interpreter's result
313     *      contains an error message.
314     *
315     * Side effects:
316     *      If there is insufficient space in parsePtr to hold all the
317     *      information about the subexpression, then additional space is
318     *      malloc-ed.
319     *
320     *----------------------------------------------------------------------
321     */
322    
323    static int
324    ParseCondExpr(infoPtr)
325        ParseInfo *infoPtr;         /* Holds the parse state for the
326                                     * expression being parsed. */
327    {
328        Tcl_Parse *parsePtr = infoPtr->parsePtr;
329        Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
330        int firstIndex, numToMove, code;
331        char *srcStart;
332        
333        HERE("condExpr", 1);
334        srcStart = infoPtr->start;
335        firstIndex = parsePtr->numTokens;
336        
337        code = ParseLorExpr(infoPtr);
338        if (code != TCL_OK) {
339            return code;
340        }
341        
342        if (infoPtr->lexeme == QUESTY) {
343            /*
344             * Emit two tokens: one TCL_TOKEN_SUB_EXPR token for the entire
345             * conditional expression, and a TCL_TOKEN_OPERATOR token for
346             * the "?" operator. Note that these two tokens must be inserted
347             * before the LOR operand tokens generated above.
348             */
349    
350            if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
351                TclExpandTokenArray(parsePtr);
352            }
353            firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
354            tokenPtr = (firstTokenPtr + 2);
355            numToMove = (parsePtr->numTokens - firstIndex);
356            memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
357                    (size_t) (numToMove * sizeof(Tcl_Token)));
358            parsePtr->numTokens += 2;
359            
360            tokenPtr = firstTokenPtr;
361            tokenPtr->type = TCL_TOKEN_SUB_EXPR;
362            tokenPtr->start = srcStart;
363            
364            tokenPtr++;
365            tokenPtr->type = TCL_TOKEN_OPERATOR;
366            tokenPtr->start = infoPtr->start;
367            tokenPtr->size = 1;
368            tokenPtr->numComponents = 0;
369        
370            /*
371             * Skip over the '?'.
372             */
373            
374            code = GetLexeme(infoPtr);
375            if (code != TCL_OK) {
376                return code;
377            }
378    
379            /*
380             * Parse the "then" expression.
381             */
382    
383            code = ParseCondExpr(infoPtr);
384            if (code != TCL_OK) {
385                return code;
386            }
387            if (infoPtr->lexeme != COLON) {
388                LogSyntaxError(infoPtr);
389                return TCL_ERROR;
390            }
391            code = GetLexeme(infoPtr); /* skip over the ':' */
392            if (code != TCL_OK) {
393                return code;
394            }
395    
396            /*
397             * Parse the "else" expression.
398             */
399    
400            code = ParseCondExpr(infoPtr);
401            if (code != TCL_OK) {
402                return code;
403            }
404    
405            /*
406             * Now set the size-related fields in the '?' subexpression token.
407             */
408    
409            condTokenPtr = &parsePtr->tokenPtr[firstIndex];
410            condTokenPtr->size = (infoPtr->prevEnd - srcStart);
411            condTokenPtr->numComponents = parsePtr->numTokens - (firstIndex+1);
412        }
413        return TCL_OK;
414    }
415    
416    /*
417     *----------------------------------------------------------------------
418     *
419     * ParseLorExpr --
420     *
421     *      This procedure parses a Tcl logical or expression:
422     *      lorExpr ::= landExpr {'||' landExpr}
423     *
424     * Results:
425     *      The return value is TCL_OK on a successful parse and TCL_ERROR
426     *      on failure. If TCL_ERROR is returned, then the interpreter's result
427     *      contains an error message.
428     *
429     * Side effects:
430     *      If there is insufficient space in parsePtr to hold all the
431     *      information about the subexpression, then additional space is
432     *      malloc-ed.
433     *
434     *----------------------------------------------------------------------
435     */
436    
437    static int
438    ParseLorExpr(infoPtr)
439        ParseInfo *infoPtr;         /* Holds the parse state for the
440                                     * expression being parsed. */
441    {
442        Tcl_Parse *parsePtr = infoPtr->parsePtr;
443        int firstIndex, code;
444        char *srcStart, *operator;
445        
446        HERE("lorExpr", 2);
447        srcStart = infoPtr->start;
448        firstIndex = parsePtr->numTokens;
449        
450        code = ParseLandExpr(infoPtr);
451        if (code != TCL_OK) {
452            return code;
453        }
454    
455        while (infoPtr->lexeme == OR) {
456            operator = infoPtr->start;
457            code = GetLexeme(infoPtr); /* skip over the '||' */
458            if (code != TCL_OK) {
459                return code;
460            }
461            code = ParseLandExpr(infoPtr);
462            if (code != TCL_OK) {
463                return code;
464            }
465    
466            /*
467             * Generate tokens for the LOR subexpression and the '||' operator.
468             */
469    
470            PrependSubExprTokens(operator, 2, srcStart,
471                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
472        }
473        return TCL_OK;
474    }
475    
476    /*
477     *----------------------------------------------------------------------
478     *
479     * ParseLandExpr --
480     *
481     *      This procedure parses a Tcl logical and expression:
482     *      landExpr ::= bitOrExpr {'&&' bitOrExpr}
483     *
484     * Results:
485     *      The return value is TCL_OK on a successful parse and TCL_ERROR
486     *      on failure. If TCL_ERROR is returned, then the interpreter's result
487     *      contains an error message.
488     *
489     * Side effects:
490     *      If there is insufficient space in parsePtr to hold all the
491     *      information about the subexpression, then additional space is
492     *      malloc-ed.
493     *
494     *----------------------------------------------------------------------
495     */
496    
497    static int
498    ParseLandExpr(infoPtr)
499        ParseInfo *infoPtr;         /* Holds the parse state for the
500                                     * expression being parsed. */
501    {
502        Tcl_Parse *parsePtr = infoPtr->parsePtr;
503        int firstIndex, code;
504        char *srcStart, *operator;
505    
506        HERE("landExpr", 3);
507        srcStart = infoPtr->start;
508        firstIndex = parsePtr->numTokens;
509        
510        code = ParseBitOrExpr(infoPtr);
511        if (code != TCL_OK) {
512            return code;
513        }
514    
515        while (infoPtr->lexeme == AND) {
516            operator = infoPtr->start;
517            code = GetLexeme(infoPtr); /* skip over the '&&' */
518            if (code != TCL_OK) {
519                return code;
520            }
521            code = ParseBitOrExpr(infoPtr);
522            if (code != TCL_OK) {
523                return code;
524            }
525    
526            /*
527             * Generate tokens for the LAND subexpression and the '&&' operator.
528             */
529    
530            PrependSubExprTokens(operator, 2, srcStart,
531                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
532        }
533        return TCL_OK;
534    }
535    
536    /*
537     *----------------------------------------------------------------------
538     *
539     * ParseBitOrExpr --
540     *
541     *      This procedure parses a Tcl bitwise or expression:
542     *      bitOrExpr ::= bitXorExpr {'|' bitXorExpr}
543     *
544     * Results:
545     *      The return value is TCL_OK on a successful parse and TCL_ERROR
546     *      on failure. If TCL_ERROR is returned, then the interpreter's result
547     *      contains an error message.
548     *
549     * Side effects:
550     *      If there is insufficient space in parsePtr to hold all the
551     *      information about the subexpression, then additional space is
552     *      malloc-ed.
553     *
554     *----------------------------------------------------------------------
555     */
556    
557    static int
558    ParseBitOrExpr(infoPtr)
559        ParseInfo *infoPtr;         /* Holds the parse state for the
560                                     * expression being parsed. */
561    {
562        Tcl_Parse *parsePtr = infoPtr->parsePtr;
563        int firstIndex, code;
564        char *srcStart, *operator;
565    
566        HERE("bitOrExpr", 4);
567        srcStart = infoPtr->start;
568        firstIndex = parsePtr->numTokens;
569        
570        code = ParseBitXorExpr(infoPtr);
571        if (code != TCL_OK) {
572            return code;
573        }
574        
575        while (infoPtr->lexeme == BIT_OR) {
576            operator = infoPtr->start;
577            code = GetLexeme(infoPtr); /* skip over the '|' */
578            if (code != TCL_OK) {
579                return code;
580            }
581    
582            code = ParseBitXorExpr(infoPtr);
583            if (code != TCL_OK) {
584                return code;
585            }
586            
587            /*
588             * Generate tokens for the BITOR subexpression and the '|' operator.
589             */
590    
591            PrependSubExprTokens(operator, 1, srcStart,
592                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
593        }
594        return TCL_OK;
595    }
596    
597    /*
598     *----------------------------------------------------------------------
599     *
600     * ParseBitXorExpr --
601     *
602     *      This procedure parses a Tcl bitwise exclusive or expression:
603     *      bitXorExpr ::= bitAndExpr {'^' bitAndExpr}
604     *
605     * Results:
606     *      The return value is TCL_OK on a successful parse and TCL_ERROR
607     *      on failure. If TCL_ERROR is returned, then the interpreter's result
608     *      contains an error message.
609     *
610     * Side effects:
611     *      If there is insufficient space in parsePtr to hold all the
612     *      information about the subexpression, then additional space is
613     *      malloc-ed.
614     *
615     *----------------------------------------------------------------------
616     */
617    
618    static int
619    ParseBitXorExpr(infoPtr)
620        ParseInfo *infoPtr;         /* Holds the parse state for the
621                                     * expression being parsed. */
622    {
623        Tcl_Parse *parsePtr = infoPtr->parsePtr;
624        int firstIndex, code;
625        char *srcStart, *operator;
626    
627        HERE("bitXorExpr", 5);
628        srcStart = infoPtr->start;
629        firstIndex = parsePtr->numTokens;
630        
631        code = ParseBitAndExpr(infoPtr);
632        if (code != TCL_OK) {
633            return code;
634        }
635        
636        while (infoPtr->lexeme == BIT_XOR) {
637            operator = infoPtr->start;
638            code = GetLexeme(infoPtr); /* skip over the '^' */
639            if (code != TCL_OK) {
640                return code;
641            }
642    
643            code = ParseBitAndExpr(infoPtr);
644            if (code != TCL_OK) {
645                return code;
646            }
647            
648            /*
649             * Generate tokens for the XOR subexpression and the '^' operator.
650             */
651    
652            PrependSubExprTokens(operator, 1, srcStart,
653                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
654        }
655        return TCL_OK;
656    }
657    
658    /*
659     *----------------------------------------------------------------------
660     *
661     * ParseBitAndExpr --
662     *
663     *      This procedure parses a Tcl bitwise and expression:
664     *      bitAndExpr ::= equalityExpr {'&' equalityExpr}
665     *
666     * Results:
667     *      The return value is TCL_OK on a successful parse and TCL_ERROR
668     *      on failure. If TCL_ERROR is returned, then the interpreter's result
669     *      contains an error message.
670     *
671     * Side effects:
672     *      If there is insufficient space in parsePtr to hold all the
673     *      information about the subexpression, then additional space is
674     *      malloc-ed.
675     *
676     *----------------------------------------------------------------------
677     */
678    
679    static int
680    ParseBitAndExpr(infoPtr)
681        ParseInfo *infoPtr;         /* Holds the parse state for the
682                                     * expression being parsed. */
683    {
684        Tcl_Parse *parsePtr = infoPtr->parsePtr;
685        int firstIndex, code;
686        char *srcStart, *operator;
687    
688        HERE("bitAndExpr", 6);
689        srcStart = infoPtr->start;
690        firstIndex = parsePtr->numTokens;
691        
692        code = ParseEqualityExpr(infoPtr);
693        if (code != TCL_OK) {
694            return code;
695        }
696        
697        while (infoPtr->lexeme == BIT_AND) {
698            operator = infoPtr->start;
699            code = GetLexeme(infoPtr); /* skip over the '&' */
700            if (code != TCL_OK) {
701                return code;
702            }
703            code = ParseEqualityExpr(infoPtr);
704            if (code != TCL_OK) {
705                return code;
706            }
707            
708            /*
709             * Generate tokens for the BITAND subexpression and '&' operator.
710             */
711    
712            PrependSubExprTokens(operator, 1, srcStart,
713                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
714        }
715        return TCL_OK;
716    }
717    
718    /*
719     *----------------------------------------------------------------------
720     *
721     * ParseEqualityExpr --
722     *
723     *      This procedure parses a Tcl equality (inequality) expression:
724     *      equalityExpr ::= relationalExpr {('==' | '!=') relationalExpr}
725     *
726     * Results:
727     *      The return value is TCL_OK on a successful parse and TCL_ERROR
728     *      on failure. If TCL_ERROR is returned, then the interpreter's result
729     *      contains an error message.
730     *
731     * Side effects:
732     *      If there is insufficient space in parsePtr to hold all the
733     *      information about the subexpression, then additional space is
734     *      malloc-ed.
735     *
736     *----------------------------------------------------------------------
737     */
738    
739    static int
740    ParseEqualityExpr(infoPtr)
741        ParseInfo *infoPtr;         /* Holds the parse state for the
742                                     * expression being parsed. */
743    {
744        Tcl_Parse *parsePtr = infoPtr->parsePtr;
745        int firstIndex, lexeme, code;
746        char *srcStart, *operator;
747    
748        HERE("equalityExpr", 7);
749        srcStart = infoPtr->start;
750        firstIndex = parsePtr->numTokens;
751        
752        code = ParseRelationalExpr(infoPtr);
753        if (code != TCL_OK) {
754            return code;
755        }
756    
757        lexeme = infoPtr->lexeme;
758        while ((lexeme == EQUAL) || (lexeme == NEQ)) {
759            operator = infoPtr->start;
760            code = GetLexeme(infoPtr); /* skip over == or != */
761            if (code != TCL_OK) {
762                return code;
763            }
764            code = ParseRelationalExpr(infoPtr);
765            if (code != TCL_OK) {
766                return code;
767            }
768    
769            /*
770             * Generate tokens for the subexpression and '==' or '!=' operator.
771             */
772    
773            PrependSubExprTokens(operator, 2, srcStart,
774                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
775            lexeme = infoPtr->lexeme;
776        }
777        return TCL_OK;
778    }
779    
780    /*
781     *----------------------------------------------------------------------
782     *
783     * ParseRelationalExpr --
784     *
785     *      This procedure parses a Tcl relational expression:
786     *      relationalExpr ::= shiftExpr {('<' | '>' | '<=' | '>=') shiftExpr}
787     *
788     * Results:
789     *      The return value is TCL_OK on a successful parse and TCL_ERROR
790     *      on failure. If TCL_ERROR is returned, then the interpreter's result
791     *      contains an error message.
792     *
793     * Side effects:
794     *      If there is insufficient space in parsePtr to hold all the
795     *      information about the subexpression, then additional space is
796     *      malloc-ed.
797     *
798     *----------------------------------------------------------------------
799     */
800    
801    static int
802    ParseRelationalExpr(infoPtr)
803        ParseInfo *infoPtr;         /* Holds the parse state for the
804                                     * expression being parsed. */
805    {
806        Tcl_Parse *parsePtr = infoPtr->parsePtr;
807        int firstIndex, lexeme, operatorSize, code;
808        char *srcStart, *operator;
809    
810        HERE("relationalExpr", 8);
811        srcStart = infoPtr->start;
812        firstIndex = parsePtr->numTokens;
813        
814        code = ParseShiftExpr(infoPtr);
815        if (code != TCL_OK) {
816            return code;
817        }
818    
819        lexeme = infoPtr->lexeme;
820        while ((lexeme == LESS) || (lexeme == GREATER) || (lexeme == LEQ)
821                || (lexeme == GEQ)) {
822            operator = infoPtr->start;
823            if ((lexeme == LEQ) || (lexeme == GEQ)) {
824                operatorSize = 2;
825            } else {
826                operatorSize = 1;
827            }
828            code = GetLexeme(infoPtr); /* skip over the operator */
829            if (code != TCL_OK) {
830                return code;
831            }
832            code = ParseShiftExpr(infoPtr);
833            if (code != TCL_OK) {
834                return code;
835            }
836    
837            /*
838             * Generate tokens for the subexpression and the operator.
839             */
840    
841            PrependSubExprTokens(operator, operatorSize, srcStart,
842                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
843            lexeme = infoPtr->lexeme;
844        }
845        return TCL_OK;
846    }
847    
848    /*
849     *----------------------------------------------------------------------
850     *
851     * ParseShiftExpr --
852     *
853     *      This procedure parses a Tcl shift expression:
854     *      shiftExpr ::= addExpr {('<<' | '>>') addExpr}
855     *
856     * Results:
857     *      The return value is TCL_OK on a successful parse and TCL_ERROR
858     *      on failure. If TCL_ERROR is returned, then the interpreter's result
859     *      contains an error message.
860     *
861     * Side effects:
862     *      If there is insufficient space in parsePtr to hold all the
863     *      information about the subexpression, then additional space is
864     *      malloc-ed.
865     *
866     *----------------------------------------------------------------------
867     */
868    
869    static int
870    ParseShiftExpr(infoPtr)
871        ParseInfo *infoPtr;         /* Holds the parse state for the
872                                     * expression being parsed. */
873    {
874        Tcl_Parse *parsePtr = infoPtr->parsePtr;
875        int firstIndex, lexeme, code;
876        char *srcStart, *operator;
877    
878        HERE("shiftExpr", 9);
879        srcStart = infoPtr->start;
880        firstIndex = parsePtr->numTokens;
881        
882        code = ParseAddExpr(infoPtr);
883        if (code != TCL_OK) {
884            return code;
885        }
886    
887        lexeme = infoPtr->lexeme;
888        while ((lexeme == LEFT_SHIFT) || (lexeme == RIGHT_SHIFT)) {
889            operator = infoPtr->start;
890            code = GetLexeme(infoPtr); /* skip over << or >> */
891            if (code != TCL_OK) {
892                return code;
893            }
894            code = ParseAddExpr(infoPtr);
895            if (code != TCL_OK) {
896                return code;
897            }
898    
899            /*
900             * Generate tokens for the subexpression and '<<' or '>>' operator.
901             */
902    
903            PrependSubExprTokens(operator, 2, srcStart,
904                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
905            lexeme = infoPtr->lexeme;
906        }
907        return TCL_OK;
908    }
909    
910    /*
911     *----------------------------------------------------------------------
912     *
913     * ParseAddExpr --
914     *
915     *      This procedure parses a Tcl addition expression:
916     *      addExpr ::= multiplyExpr {('+' | '-') multiplyExpr}
917     *
918     * Results:
919     *      The return value is TCL_OK on a successful parse and TCL_ERROR
920     *      on failure. If TCL_ERROR is returned, then the interpreter's result
921     *      contains an error message.
922     *
923     * Side effects:
924     *      If there is insufficient space in parsePtr to hold all the
925     *      information about the subexpression, then additional space is
926     *      malloc-ed.
927     *
928     *----------------------------------------------------------------------
929     */
930    
931    static int
932    ParseAddExpr(infoPtr)
933        ParseInfo *infoPtr;         /* Holds the parse state for the
934                                     * expression being parsed. */
935    {
936        Tcl_Parse *parsePtr = infoPtr->parsePtr;
937        int firstIndex, lexeme, code;
938        char *srcStart, *operator;
939    
940        HERE("addExpr", 10);
941        srcStart = infoPtr->start;
942        firstIndex = parsePtr->numTokens;
943        
944        code = ParseMultiplyExpr(infoPtr);
945        if (code != TCL_OK) {
946            return code;
947        }
948    
949        lexeme = infoPtr->lexeme;
950        while ((lexeme == PLUS) || (lexeme == MINUS)) {
951            operator = infoPtr->start;
952            code = GetLexeme(infoPtr); /* skip over + or - */
953            if (code != TCL_OK) {
954                return code;
955            }
956            code = ParseMultiplyExpr(infoPtr);
957            if (code != TCL_OK) {
958                return code;
959            }
960    
961            /*
962             * Generate tokens for the subexpression and '+' or '-' operator.
963             */
964    
965            PrependSubExprTokens(operator, 1, srcStart,
966                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
967            lexeme = infoPtr->lexeme;
968        }
969        return TCL_OK;
970    }
971    
972    /*
973     *----------------------------------------------------------------------
974     *
975     * ParseMultiplyExpr --
976     *
977     *      This procedure parses a Tcl multiply expression:
978     *      multiplyExpr ::= unaryExpr {('*' | '/' | '%') unaryExpr}
979     *
980     * Results:
981     *      The return value is TCL_OK on a successful parse and TCL_ERROR
982     *      on failure. If TCL_ERROR is returned, then the interpreter's result
983     *      contains an error message.
984     *
985     * Side effects:
986     *      If there is insufficient space in parsePtr to hold all the
987     *      information about the subexpression, then additional space is
988     *      malloc-ed.
989     *
990     *----------------------------------------------------------------------
991     */
992    
993    static int
994    ParseMultiplyExpr(infoPtr)
995        ParseInfo *infoPtr;         /* Holds the parse state for the
996                                     * expression being parsed. */
997    {
998        Tcl_Parse *parsePtr = infoPtr->parsePtr;
999        int firstIndex, lexeme, code;
1000        char *srcStart, *operator;
1001    
1002        HERE("multiplyExpr", 11);
1003        srcStart = infoPtr->start;
1004        firstIndex = parsePtr->numTokens;
1005        
1006        code = ParseUnaryExpr(infoPtr);
1007        if (code != TCL_OK) {
1008            return code;
1009        }
1010    
1011        lexeme = infoPtr->lexeme;
1012        while ((lexeme == MULT) || (lexeme == DIVIDE) || (lexeme == MOD)) {
1013            operator = infoPtr->start;
1014            code = GetLexeme(infoPtr); /* skip over * or / or % */
1015            if (code != TCL_OK) {
1016                return code;
1017            }
1018            code = ParseUnaryExpr(infoPtr);
1019            if (code != TCL_OK) {
1020                return code;
1021            }
1022    
1023            /*
1024             * Generate tokens for the subexpression and * or / or % operator.
1025             */
1026    
1027            PrependSubExprTokens(operator, 1, srcStart,
1028                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1029            lexeme = infoPtr->lexeme;
1030        }
1031        return TCL_OK;
1032    }
1033    
1034    /*
1035     *----------------------------------------------------------------------
1036     *
1037     * ParseUnaryExpr --
1038     *
1039     *      This procedure parses a Tcl unary expression:
1040     *      unaryExpr ::= ('+' | '-' | '~' | '!') unaryExpr | primaryExpr
1041     *
1042     * Results:
1043     *      The return value is TCL_OK on a successful parse and TCL_ERROR
1044     *      on failure. If TCL_ERROR is returned, then the interpreter's result
1045     *      contains an error message.
1046     *
1047     * Side effects:
1048     *      If there is insufficient space in parsePtr to hold all the
1049     *      information about the subexpression, then additional space is
1050     *      malloc-ed.
1051     *
1052     *----------------------------------------------------------------------
1053     */
1054    
1055    static int
1056    ParseUnaryExpr(infoPtr)
1057        ParseInfo *infoPtr;         /* Holds the parse state for the
1058                                     * expression being parsed. */
1059    {
1060        Tcl_Parse *parsePtr = infoPtr->parsePtr;
1061        int firstIndex, lexeme, code;
1062        char *srcStart, *operator;
1063    
1064        HERE("unaryExpr", 12);
1065        srcStart = infoPtr->start;
1066        firstIndex = parsePtr->numTokens;
1067        
1068        lexeme = infoPtr->lexeme;
1069        if ((lexeme == PLUS) || (lexeme == MINUS) || (lexeme == BIT_NOT)
1070                || (lexeme == NOT)) {
1071            operator = infoPtr->start;
1072            code = GetLexeme(infoPtr); /* skip over the unary operator */
1073            if (code != TCL_OK) {
1074                return code;
1075            }
1076            code = ParseUnaryExpr(infoPtr);
1077            if (code != TCL_OK) {
1078                return code;
1079            }
1080    
1081            /*
1082             * Generate tokens for the subexpression and the operator.
1083             */
1084    
1085            PrependSubExprTokens(operator, 1, srcStart,
1086                    (infoPtr->prevEnd - srcStart), firstIndex, infoPtr);
1087        } else {                    /* must be a primaryExpr */
1088            code = ParsePrimaryExpr(infoPtr);
1089            if (code != TCL_OK) {
1090                return code;
1091            }
1092        }
1093        return TCL_OK;
1094    }
1095    
1096    /*
1097     *----------------------------------------------------------------------
1098     *
1099     * ParsePrimaryExpr --
1100     *
1101     *      This procedure parses a Tcl primary expression:
1102     *      primaryExpr ::= literal | varReference | quotedString |
1103     *                      '[' command ']' | mathFuncCall | '(' condExpr ')'
1104     *
1105     * Results:
1106     *      The return value is TCL_OK on a successful parse and TCL_ERROR
1107     *      on failure. If TCL_ERROR is returned, then the interpreter's result
1108     *      contains an error message.
1109     *
1110     * Side effects:
1111     *      If there is insufficient space in parsePtr to hold all the
1112     *      information about the subexpression, then additional space is
1113     *      malloc-ed.
1114     *
1115     *----------------------------------------------------------------------
1116     */
1117    
1118    static int
1119    ParsePrimaryExpr(infoPtr)
1120        ParseInfo *infoPtr;         /* Holds the parse state for the
1121                                     * expression being parsed. */
1122    {
1123        Tcl_Parse *parsePtr = infoPtr->parsePtr;
1124        Tcl_Interp *interp = parsePtr->interp;
1125        Tcl_Token *tokenPtr, *exprTokenPtr;
1126        Tcl_Parse nested;
1127        char *dollarPtr, *stringStart, *termPtr, *src;
1128        int lexeme, exprIndex, firstIndex, numToMove, code;
1129    
1130        /*
1131         * We simply recurse on parenthesized subexpressions.
1132         */
1133    
1134        HERE("primaryExpr", 13);
1135        lexeme = infoPtr->lexeme;
1136        if (lexeme == OPEN_PAREN) {
1137            code = GetLexeme(infoPtr); /* skip over the '(' */
1138            if (code != TCL_OK) {
1139                return code;
1140            }
1141            code = ParseCondExpr(infoPtr);
1142            if (code != TCL_OK) {
1143                return code;
1144            }
1145            if (infoPtr->lexeme != CLOSE_PAREN) {
1146                goto syntaxError;
1147            }
1148            code = GetLexeme(infoPtr); /* skip over the ')' */
1149            if (code != TCL_OK) {
1150                return code;
1151            }
1152            return TCL_OK;
1153        }
1154    
1155        /*
1156         * Start a TCL_TOKEN_SUB_EXPR token for the primary.
1157         */
1158    
1159        if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1160            TclExpandTokenArray(parsePtr);
1161        }
1162        exprIndex = parsePtr->numTokens;
1163        exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1164        exprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1165        exprTokenPtr->start = infoPtr->start;
1166        parsePtr->numTokens++;
1167    
1168        /*
1169         * Process the primary then finish setting the fields of the
1170         * TCL_TOKEN_SUB_EXPR token. Note that we can't use the pointer now
1171         * stored in "exprTokenPtr" in the code below since the token array
1172         * might be reallocated.
1173         */
1174    
1175        firstIndex = parsePtr->numTokens;
1176        switch (lexeme) {
1177        case LITERAL:
1178            /*
1179             * Int or double number.
1180             */
1181            
1182            if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1183                TclExpandTokenArray(parsePtr);
1184            }
1185            tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1186            tokenPtr->type = TCL_TOKEN_TEXT;
1187            tokenPtr->start = infoPtr->start;
1188            tokenPtr->size = infoPtr->size;
1189            tokenPtr->numComponents = 0;
1190            parsePtr->numTokens++;
1191    
1192            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1193            exprTokenPtr->size = infoPtr->size;
1194            exprTokenPtr->numComponents = 1;
1195            break;
1196            
1197        case DOLLAR:
1198            /*
1199             * $var variable reference.
1200             */
1201            
1202            dollarPtr = (infoPtr->next - 1);
1203            code = Tcl_ParseVarName(interp, dollarPtr,
1204                    (infoPtr->lastChar - dollarPtr), parsePtr, 1);
1205            if (code != TCL_OK) {
1206                return code;
1207            }
1208            infoPtr->next = dollarPtr + parsePtr->tokenPtr[firstIndex].size;
1209    
1210            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1211            exprTokenPtr->size = parsePtr->tokenPtr[firstIndex].size;
1212            exprTokenPtr->numComponents =
1213                    (parsePtr->tokenPtr[firstIndex].numComponents + 1);
1214            break;
1215            
1216        case QUOTE:
1217            /*
1218             * '"' string '"'
1219             */
1220            
1221            stringStart = infoPtr->next;
1222            code = Tcl_ParseQuotedString(interp, infoPtr->start,
1223                    (infoPtr->lastChar - stringStart), parsePtr, 1, &termPtr);
1224            if (code != TCL_OK) {
1225                return code;
1226            }
1227            infoPtr->next = termPtr;
1228    
1229            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1230            exprTokenPtr->size = (termPtr - exprTokenPtr->start);
1231            exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1232    
1233            /*
1234             * If parsing the quoted string resulted in more than one token,
1235             * insert a TCL_TOKEN_WORD token before them. This indicates that
1236             * the quoted string represents a concatenation of multiple tokens.
1237             */
1238    
1239            if (exprTokenPtr->numComponents > 1) {
1240                if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1241                    TclExpandTokenArray(parsePtr);
1242                }
1243                tokenPtr = &parsePtr->tokenPtr[firstIndex];
1244                numToMove = (parsePtr->numTokens - firstIndex);
1245                memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1246                        (size_t) (numToMove * sizeof(Tcl_Token)));
1247                parsePtr->numTokens++;
1248    
1249                exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1250                exprTokenPtr->numComponents++;
1251    
1252                tokenPtr->type = TCL_TOKEN_WORD;
1253                tokenPtr->start = exprTokenPtr->start;
1254                tokenPtr->size = exprTokenPtr->size;
1255                tokenPtr->numComponents = (exprTokenPtr->numComponents - 1);
1256            }
1257            break;
1258            
1259        case OPEN_BRACKET:
1260            /*
1261             * '[' command {command} ']'
1262             */
1263    
1264            if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1265                TclExpandTokenArray(parsePtr);
1266            }
1267            tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1268            tokenPtr->type = TCL_TOKEN_COMMAND;
1269            tokenPtr->start = infoPtr->start;
1270            tokenPtr->numComponents = 0;
1271            parsePtr->numTokens++;
1272    
1273            /*
1274             * Call Tcl_ParseCommand repeatedly to parse the nested command(s)
1275             * to find their end, then throw away that parse information.
1276             */
1277            
1278            src = infoPtr->next;
1279            while (1) {
1280                if (Tcl_ParseCommand(interp, src, (parsePtr->end - src), 1,
1281                        &nested) != TCL_OK) {
1282                    parsePtr->term = nested.term;
1283                    parsePtr->errorType = nested.errorType;
1284                    parsePtr->incomplete = nested.incomplete;
1285                    return TCL_ERROR;
1286                }
1287                src = (nested.commandStart + nested.commandSize);
1288                if (nested.tokenPtr != nested.staticTokens) {
1289                    ckfree((char *) nested.tokenPtr);
1290                }
1291                if ((src[-1] == ']') && !nested.incomplete) {
1292                    break;
1293                }
1294                if (src == parsePtr->end) {
1295                    if (parsePtr->interp != NULL) {
1296                        Tcl_SetResult(interp, "missing close-bracket",
1297                                TCL_STATIC);
1298                    }
1299                    parsePtr->term = tokenPtr->start;
1300                    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
1301                    parsePtr->incomplete = 1;
1302                    return TCL_ERROR;
1303                }
1304            }
1305            tokenPtr->size = (src - tokenPtr->start);
1306            infoPtr->next = src;
1307    
1308            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1309            exprTokenPtr->size = (src - tokenPtr->start);
1310            exprTokenPtr->numComponents = 1;
1311            break;
1312    
1313        case OPEN_BRACE:
1314            /*
1315             * '{' string '}'
1316             */
1317    
1318            code = Tcl_ParseBraces(interp, infoPtr->start,
1319                    (infoPtr->lastChar - infoPtr->start), parsePtr, 1,
1320                    &termPtr);
1321            if (code != TCL_OK) {
1322                return code;
1323            }
1324            infoPtr->next = termPtr;
1325    
1326            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1327            exprTokenPtr->size = (termPtr - infoPtr->start);
1328            exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1329    
1330            /*
1331             * If parsing the braced string resulted in more than one token,
1332             * insert a TCL_TOKEN_WORD token before them. This indicates that
1333             * the braced string represents a concatenation of multiple tokens.
1334             */
1335    
1336            if (exprTokenPtr->numComponents > 1) {
1337                if (parsePtr->numTokens >= parsePtr->tokensAvailable) {
1338                    TclExpandTokenArray(parsePtr);
1339                }
1340                tokenPtr = &parsePtr->tokenPtr[firstIndex];
1341                numToMove = (parsePtr->numTokens - firstIndex);
1342                memmove((VOID *) (tokenPtr + 1), (VOID *) tokenPtr,
1343                        (size_t) (numToMove * sizeof(Tcl_Token)));
1344                parsePtr->numTokens++;
1345    
1346                exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1347                exprTokenPtr->numComponents++;
1348                
1349                tokenPtr->type = TCL_TOKEN_WORD;
1350                tokenPtr->start = exprTokenPtr->start;
1351                tokenPtr->size = exprTokenPtr->size;
1352                tokenPtr->numComponents = exprTokenPtr->numComponents-1;
1353            }
1354            break;
1355            
1356        case FUNC_NAME:
1357            /*
1358             * math_func '(' expr {',' expr} ')'
1359             */
1360            
1361            if (parsePtr->numTokens == parsePtr->tokensAvailable) {
1362                TclExpandTokenArray(parsePtr);
1363            }
1364            tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
1365            tokenPtr->type = TCL_TOKEN_OPERATOR;
1366            tokenPtr->start = infoPtr->start;
1367            tokenPtr->size = infoPtr->size;
1368            tokenPtr->numComponents = 0;
1369            parsePtr->numTokens++;
1370            
1371            code = GetLexeme(infoPtr); /* skip over function name */
1372            if (code != TCL_OK) {
1373                return code;
1374            }
1375            if (infoPtr->lexeme != OPEN_PAREN) {
1376                goto syntaxError;
1377            }
1378            code = GetLexeme(infoPtr); /* skip over '(' */
1379            if (code != TCL_OK) {
1380                return code;
1381            }
1382    
1383            while (infoPtr->lexeme != CLOSE_PAREN) {
1384                code = ParseCondExpr(infoPtr);
1385                if (code != TCL_OK) {
1386                    return code;
1387                }
1388                
1389                if (infoPtr->lexeme == COMMA) {
1390                    code = GetLexeme(infoPtr); /* skip over , */
1391                    if (code != TCL_OK) {
1392                        return code;
1393                    }
1394                } else if (infoPtr->lexeme != CLOSE_PAREN) {
1395                    goto syntaxError;
1396                }
1397            }
1398    
1399            exprTokenPtr = &parsePtr->tokenPtr[exprIndex];
1400            exprTokenPtr->size = (infoPtr->next - exprTokenPtr->start);
1401            exprTokenPtr->numComponents = parsePtr->numTokens - firstIndex;
1402            break;
1403            
1404        default:
1405            goto syntaxError;
1406        }
1407    
1408        /*
1409         * Advance to the next lexeme before returning.
1410         */
1411        
1412        code = GetLexeme(infoPtr);
1413        if (code != TCL_OK) {
1414            return code;
1415        }
1416        parsePtr->term = infoPtr->next;
1417        return TCL_OK;
1418    
1419        syntaxError:
1420        LogSyntaxError(infoPtr);
1421        return TCL_ERROR;
1422    }
1423    
1424    /*
1425     *----------------------------------------------------------------------
1426     *
1427     * GetLexeme --
1428     *
1429     *      Lexical scanner for Tcl expressions: scans a single operator or
1430     *      other syntactic element from an expression string.
1431     *
1432     * Results:
1433     *      TCL_OK is returned unless an error occurred. In that case a standard
1434     *      Tcl error code is returned and, if infoPtr->parsePtr->interp is
1435     *      non-NULL, the interpreter's result is set to hold an error
1436     *      message. TCL_ERROR is returned if an integer overflow, or a
1437     *      floating-point overflow or underflow occurred while reading in a
1438     *      number. If the lexical analysis is successful, infoPtr->lexeme
1439     *      refers to the next symbol in the expression string, and
1440     *      infoPtr->next is advanced past the lexeme. Also, if the lexeme is a
1441     *      LITERAL or FUNC_NAME, then infoPtr->start is set to the first
1442     *      character of the lexeme; otherwise it is set NULL.
1443     *
1444     * Side effects:
1445     *      If there is insufficient space in parsePtr to hold all the
1446     *      information about the subexpression, then additional space is
1447     *      malloc-ed..
1448     *
1449     *----------------------------------------------------------------------
1450     */
1451    
1452    static int
1453    GetLexeme(infoPtr)
1454        ParseInfo *infoPtr;         /* Holds state needed to parse the expr,
1455                                     * including the resulting lexeme. */
1456    {
1457        register char *src;         /* Points to current source char. */
1458        char *termPtr;              /* Points to char terminating a literal. */
1459        double doubleValue;         /* Value of a scanned double literal. */
1460        char c;
1461        int startsWithDigit, offset;
1462        Tcl_Parse *parsePtr = infoPtr->parsePtr;
1463        Tcl_Interp *interp = parsePtr->interp;
1464        Tcl_UniChar ch;
1465    
1466        /*
1467         * Record where the previous lexeme ended. Since we always read one
1468         * lexeme ahead during parsing, this helps us know the source length of
1469         * subexpression tokens.
1470         */
1471    
1472        infoPtr->prevEnd = infoPtr->next;
1473    
1474        /*
1475         * Scan over leading white space at the start of a lexeme. Note that a
1476         * backslash-newline is treated as a space.
1477         */
1478    
1479        src = infoPtr->next;
1480        c = *src;
1481        while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */
1482            if (c == '\\') {
1483                if (src[1] == '\n') {
1484                    src += 2;
1485                } else {
1486                    break;  /* no longer white space */
1487                }
1488            } else {
1489                src++;
1490            }
1491            c = *src;
1492        }
1493        parsePtr->term = src;
1494        if (src >= infoPtr->lastChar) {
1495            infoPtr->lexeme = END;
1496            infoPtr->next = src;
1497            return TCL_OK;
1498        }
1499    
1500        /*
1501         * Try to parse the lexeme first as an integer or floating-point
1502         * number. Don't check for a number if the first character c is
1503         * "+" or "-". If we did, we might treat a binary operator as unary
1504         * by mistake, which would eventually cause a syntax error.
1505         */
1506    
1507        if ((c != '+') && (c != '-')) {
1508            startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */
1509            if (startsWithDigit && TclLooksLikeInt(src, -1)) {
1510                errno = 0;
1511                (void) strtoul(src, &termPtr, 0);
1512                if (errno == ERANGE) {
1513                    if (interp != NULL) {
1514                        char *s = "integer value too large to represent";
1515                        Tcl_ResetResult(interp);
1516                        Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
1517                        Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
1518                                (char *) NULL);
1519                    }
1520                    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1521                    return TCL_ERROR;
1522                }
1523                if (termPtr != src) {
1524                    /*
1525                     * src was the start of a valid integer, but was it
1526                     * a bad octal?  Stopping at a digit would cause that.
1527                     */
1528                    if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */
1529                        /*
1530                         * We only want to report an error for the number,
1531                         * but we may have something like "08+1"
1532                         */
1533                        if (interp != NULL) {
1534                            while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */
1535                            Tcl_ResetResult(interp);
1536                            offset = termPtr - src;
1537                            c = src[offset];
1538                            src[offset] = 0;
1539                            Tcl_AppendResult(interp, "\"", src,
1540                                    "\" is an invalid octal number",
1541                                    (char *) NULL);
1542                            src[offset] = c;
1543                        }
1544                        parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1545                        return TCL_ERROR;
1546                    }
1547    
1548                    infoPtr->lexeme = LITERAL;
1549                    infoPtr->start = src;
1550                    infoPtr->size = (termPtr - src);
1551                    infoPtr->next = termPtr;
1552                    parsePtr->term = termPtr;
1553                    return TCL_OK;
1554                }
1555            } else if (startsWithDigit || (c == '.')
1556                    || (c == 'n') || (c == 'N')) {
1557                errno = 0;
1558                doubleValue = strtod(src, &termPtr);
1559                if (termPtr != src) {
1560                    if (errno != 0) {
1561                        if (interp != NULL) {
1562                            TclExprFloatError(interp, doubleValue);
1563                        }
1564                        parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
1565                        return TCL_ERROR;
1566                    }
1567                    
1568                    /*
1569                     * src was the start of a valid double.
1570                     */
1571                    
1572                    infoPtr->lexeme = LITERAL;
1573                    infoPtr->start = src;
1574                    infoPtr->size = (termPtr - src);
1575                    infoPtr->next = termPtr;
1576                    parsePtr->term = termPtr;
1577                    return TCL_OK;
1578                }
1579            }
1580        }
1581    
1582        /*
1583         * Not an integer or double literal. Initialize the lexeme's fields
1584         * assuming the common case of a single character lexeme.
1585         */
1586    
1587        infoPtr->start = src;
1588        infoPtr->size = 1;
1589        infoPtr->next = src+1;
1590        parsePtr->term = infoPtr->next;
1591        
1592        switch (*src) {
1593            case '[':
1594                infoPtr->lexeme = OPEN_BRACKET;
1595                return TCL_OK;
1596    
1597            case '{':
1598                infoPtr->lexeme = OPEN_BRACE;
1599                return TCL_OK;
1600    
1601            case '(':
1602                infoPtr->lexeme = OPEN_PAREN;
1603                return TCL_OK;
1604    
1605            case ')':
1606                infoPtr->lexeme = CLOSE_PAREN;
1607                return TCL_OK;
1608    
1609            case '$':
1610                infoPtr->lexeme = DOLLAR;
1611                return TCL_OK;
1612    
1613            case '\"':
1614                infoPtr->lexeme = QUOTE;
1615                return TCL_OK;
1616    
1617            case ',':
1618                infoPtr->lexeme = COMMA;
1619                return TCL_OK;
1620    
1621            case '*':
1622                infoPtr->lexeme = MULT;
1623                return TCL_OK;
1624    
1625            case '/':
1626                infoPtr->lexeme = DIVIDE;
1627                return TCL_OK;
1628    
1629            case '%':
1630                infoPtr->lexeme = MOD;
1631                return TCL_OK;
1632    
1633            case '+':
1634                infoPtr->lexeme = PLUS;
1635                return TCL_OK;
1636    
1637            case '-':
1638                infoPtr->lexeme = MINUS;
1639                return TCL_OK;
1640    
1641            case '?':
1642                infoPtr->lexeme = QUESTY;
1643                return TCL_OK;
1644    
1645            case ':':
1646                infoPtr->lexeme = COLON;
1647                return TCL_OK;
1648    
1649            case '<':
1650                switch (src[1]) {
1651                    case '<':
1652                        infoPtr->lexeme = LEFT_SHIFT;
1653                        infoPtr->size = 2;
1654                        infoPtr->next = src+2;
1655                        break;
1656                    case '=':
1657                        infoPtr->lexeme = LEQ;
1658                        infoPtr->size = 2;
1659                        infoPtr->next = src+2;
1660                        break;
1661                    default:
1662                        infoPtr->lexeme = LESS;
1663                        break;
1664                }
1665                parsePtr->term = infoPtr->next;
1666                return TCL_OK;
1667    
1668            case '>':
1669                switch (src[1]) {
1670                    case '>':
1671                        infoPtr->lexeme = RIGHT_SHIFT;
1672                        infoPtr->size = 2;
1673                        infoPtr->next = src+2;
1674                        break;
1675                    case '=':
1676                        infoPtr->lexeme = GEQ;
1677                        infoPtr->size = 2;
1678                        infoPtr->next = src+2;
1679                        break;
1680                    default:
1681                        infoPtr->lexeme = GREATER;
1682                        break;
1683                }
1684                parsePtr->term = infoPtr->next;
1685                return TCL_OK;
1686    
1687            case '=':
1688                if (src[1] == '=') {
1689                    infoPtr->lexeme = EQUAL;
1690                    infoPtr->size = 2;
1691                    infoPtr->next = src+2;
1692                } else {
1693                    infoPtr->lexeme = UNKNOWN;
1694                }
1695                parsePtr->term = infoPtr->next;
1696                return TCL_OK;
1697    
1698            case '!':
1699                if (src[1] == '=') {
1700                    infoPtr->lexeme = NEQ;
1701                    infoPtr->size = 2;
1702                    infoPtr->next = src+2;
1703                } else {
1704                    infoPtr->lexeme = NOT;
1705                }
1706                parsePtr->term = infoPtr->next;
1707                return TCL_OK;
1708    
1709            case '&':
1710                if (src[1] == '&') {
1711                    infoPtr->lexeme = AND;
1712                    infoPtr->size = 2;
1713                    infoPtr->next = src+2;
1714                } else {
1715                    infoPtr->lexeme = BIT_AND;
1716                }
1717                parsePtr->term = infoPtr->next;
1718                return TCL_OK;
1719    
1720            case '^':
1721                infoPtr->lexeme = BIT_XOR;
1722                return TCL_OK;
1723    
1724            case '|':
1725                if (src[1] == '|') {
1726                    infoPtr->lexeme = OR;
1727                    infoPtr->size = 2;
1728                    infoPtr->next = src+2;
1729                } else {
1730                    infoPtr->lexeme = BIT_OR;
1731                }
1732                parsePtr->term = infoPtr->next;
1733                return TCL_OK;
1734    
1735            case '~':
1736                infoPtr->lexeme = BIT_NOT;
1737                return TCL_OK;
1738    
1739            default:
1740                offset = Tcl_UtfToUniChar(src, &ch);
1741                c = UCHAR(ch);
1742                if (isalpha(UCHAR(c))) {    /* INTL: ISO only. */
1743                    infoPtr->lexeme = FUNC_NAME;
1744                    while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
1745                        src += offset;
1746                        offset = Tcl_UtfToUniChar(src, &ch);
1747                        c = UCHAR(ch);
1748                    }
1749                    infoPtr->size = (src - infoPtr->start);
1750                    infoPtr->next = src;
1751                    parsePtr->term = infoPtr->next;
1752                    return TCL_OK;
1753                }
1754                infoPtr->lexeme = UNKNOWN;
1755                return TCL_OK;
1756        }
1757    }
1758    
1759    /*
1760     *----------------------------------------------------------------------
1761     *
1762     * PrependSubExprTokens --
1763     *
1764     *      This procedure is called after the operands of an subexpression have
1765     *      been parsed. It generates two tokens: a TCL_TOKEN_SUB_EXPR token for
1766     *      the subexpression, and a TCL_TOKEN_OPERATOR token for its operator.
1767     *      These two tokens are inserted before the operand tokens.
1768     *
1769     * Results:
1770     *      None.
1771     *
1772     * Side effects:
1773     *      If there is insufficient space in parsePtr to hold the new tokens,
1774     *      additional space is malloc-ed.
1775     *
1776     *----------------------------------------------------------------------
1777     */
1778    
1779    static void
1780    PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
1781        char *op;                   /* Points to first byte of the operator
1782                                     * in the source script. */
1783        int opBytes;                /* Number of bytes in the operator. */
1784        char *src;                  /* Points to first byte of the subexpression
1785                                     * in the source script. */
1786        int srcBytes;               /* Number of bytes in subexpression's
1787                                     * source. */
1788        int firstIndex;             /* Index of first token already emitted for
1789                                     * operator's first (or only) operand. */
1790        ParseInfo *infoPtr;         /* Holds the parse state for the
1791                                     * expression being parsed. */
1792    {
1793        Tcl_Parse *parsePtr = infoPtr->parsePtr;
1794        Tcl_Token *tokenPtr, *firstTokenPtr;
1795        int numToMove;
1796    
1797        if ((parsePtr->numTokens + 1) >= parsePtr->tokensAvailable) {
1798            TclExpandTokenArray(parsePtr);
1799        }
1800        firstTokenPtr = &parsePtr->tokenPtr[firstIndex];
1801        tokenPtr = (firstTokenPtr + 2);
1802        numToMove = (parsePtr->numTokens - firstIndex);
1803        memmove((VOID *) tokenPtr, (VOID *) firstTokenPtr,
1804                (size_t) (numToMove * sizeof(Tcl_Token)));
1805        parsePtr->numTokens += 2;
1806        
1807        tokenPtr = firstTokenPtr;
1808        tokenPtr->type = TCL_TOKEN_SUB_EXPR;
1809        tokenPtr->start = src;
1810        tokenPtr->size = srcBytes;
1811        tokenPtr->numComponents = parsePtr->numTokens - (firstIndex + 1);
1812        
1813        tokenPtr++;
1814        tokenPtr->type = TCL_TOKEN_OPERATOR;
1815        tokenPtr->start = op;
1816        tokenPtr->size = opBytes;
1817        tokenPtr->numComponents = 0;
1818    }
1819    
1820    /*
1821     *----------------------------------------------------------------------
1822     *
1823     * LogSyntaxError --
1824     *
1825     *      This procedure is invoked after an error occurs when parsing an
1826     *      expression. It sets the interpreter result to an error message
1827     *      describing the error.
1828     *
1829     * Results:
1830     *      None.
1831     *
1832     * Side effects:
1833     *      Sets the interpreter result to an error message describing the
1834     *      expression that was being parsed when the error occurred.
1835     *
1836     *----------------------------------------------------------------------
1837     */
1838    
1839    static void
1840    LogSyntaxError(infoPtr)
1841        ParseInfo *infoPtr;         /* Holds the parse state for the
1842                                     * expression being parsed. */
1843    {
1844        int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
1845        char buffer[100];
1846    
1847        sprintf(buffer, "syntax error in expression \"%.*s\"",
1848                ((numBytes > 60)? 60 : numBytes), infoPtr->originalExpr);
1849        Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
1850                buffer, (char *) NULL);
1851        infoPtr->parsePtr->errorType = TCL_PARSE_SYNTAX;
1852        infoPtr->parsePtr->term = infoPtr->start;
1853    }
1854    
1855    /* End of tclparseexpr.c */
Legend:
Removed from v.29  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25