/[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

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

Legend:
Removed from v.64  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25