Planet

navi

home

PPS

about

screenshots

download

development

forum

Context Navigation

source: downloads/tcl8.5.2/generic/tclCompExpr.c @ 63

Last change on this file since 63 was 25, checked in by landauf, 17 years ago
added tcl to libs
File size: 80.2 KB

Line
1	/*
2	* tclCompExpr.c --
3	*
4	* This file contains the code to parse and compile Tcl expressions
5	* and implementations of the Tcl commands corresponding to expression
6	* operators, such as the command ::tcl::mathop::+ .
7	*
8	* Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
9	*
10	* See the file "license.terms" for information on usage and redistribution of
11	* this file, and for a DISCLAIMER OF ALL WARRANTIES.
12	*
13	* RCS: @(#) $Id: tclCompExpr.c,v 1.97 2008/02/28 20:40:24 dgp Exp $
14	*/
15
16	#include "tclInt.h"
17	#include "tclCompile.h" /* CompileEnv */
18
19	/*
20	* Expression parsing takes place in the routine ParseExpr(). It takes a
21	* string as input, parses that string, and generates a representation of
22	* the expression in the form of a tree of operators, a list of literals,
23	* a list of function names, and an array of Tcl_Token's within a Tcl_Parse
24	* struct. The tree is composed of OpNodes.
25	*/
26
27	typedef struct OpNode {
28	int left; /* "Pointer" to the left operand. */
29	int right; /* "Pointer" to the right operand. */
30	union {
31	int parent; /* "Pointer" to the parent operand. */
32	int prev; /* "Pointer" joining incomplete tree stack */
33	} p;
34	unsigned char lexeme; /* Code that identifies the operator. */
35	unsigned char precedence; /* Precedence of the operator */
36	unsigned char mark; /* Mark used to control traversal. */
37	unsigned char constant; /* Flag marking constant subexpressions. */
38	} OpNode;
39
40	/*
41	* The storage for the tree is dynamically allocated array of OpNodes. The
42	* array is grown as parsing needs dictate according to a scheme similar to
43	* Tcl's string growth algorithm, so that the resizing costs are O(N) and so
44	* that we use at least half the memory allocated as expressions get large.
45	*
46	* Each OpNode in the tree represents an operator in the expression, either
47	* unary or binary. When parsing is completed successfully, a binary operator
48	* OpNode will have its left and right fields filled with "pointers" to its
49	* left and right operands. A unary operator OpNode will have its right field
50	* filled with a pointer to its single operand. When an operand is a
51	* subexpression the "pointer" takes the form of the index -- a non-negative
52	* integer -- into the OpNode storage array where the root of that
53	* subexpression parse tree is found.
54	*
55	* Non-operator elements of the expression do not get stored in the OpNode
56	* tree. They are stored in the other structures according to their type.
57	* Literal values get appended to the literal list. Elements that denote
58	* forms of quoting or substitution known to the Tcl parser get stored as
59	* Tcl_Tokens. These non-operator elements of the expression are the
60	* leaves of the completed parse tree. When an operand of an OpNode is
61	* one of these leaf elements, the following negative integer codes are used
62	* to indicate which kind of elements it is.
63	*/
64
65	enum OperandTypes {
66	OT_LITERAL = -3, /* Operand is a literal in the literal list */
67	OT_TOKENS = -2, /* Operand is sequence of Tcl_Tokens */
68	OT_EMPTY = -1 /* "Operand" is an empty string. This is a
69	* special case used only to represent the
70	* EMPTY lexeme. See below. */
71	};
72
73	/*
74	* Readable macros to test whether a "pointer" value points to an operator.
75	* They operate on the "non-negative integer -> operator; negative integer ->
76	* a non-operator OperandType" distinction.
77	*/
78
79	#define IsOperator(l) ((l) >= 0)
80	#define NotOperator(l) ((l) < 0)
81
82	/*
83	* Note that it is sufficient to store in the tree just the type of leaf
84	* operand, without any explicit pointer to which leaf. This is true because
85	* the traversals of the completed tree we perform are known to visit
86	* the leaves in the same order as the original parse.
87	*
88	* In a completed parse tree, those OpNodes that are themselves (roots of
89	* subexpression trees that are) operands of some operator store in their
90	* p.parent field a "pointer" to the OpNode of that operator. The p.parent
91	* field permits a traversal of the tree within a * non-recursive routine
92	* (ConvertTreeToTokens() and CompileExprTree()). This means that even
93	* expression trees of great depth pose no risk of blowing the C stack.
94	*
95	* While the parse tree is being constructed, the same memory space is used
96	* to hold the p.prev field which chains together a stack of incomplete
97	* trees awaiting their right operands.
98	*
99	* The lexeme field is filled in with the lexeme of the operator that is
100	* returned by the ParseLexeme() routine. Only lexemes for unary and
101	* binary operators get stored in an OpNode. Other lexmes get different
102	* treatement.
103	*
104	* The precedence field provides a place to store the precedence of the
105	* operator, so it need not be looked up again and again.
106	*
107	* The mark field is use to control the traversal of the tree, so
108	* that it can be done non-recursively. The mark values are:
109	*/
110
111	enum Marks {
112	MARK_LEFT, /* Next step of traversal is to visit left subtree */
113	MARK_RIGHT, /* Next step of traversal is to visit right subtree */
114	MARK_PARENT /* Next step of traversal is to return to parent */
115	};
116
117	/*
118	* The constant field is a boolean flag marking which subexpressions are
119	* completely known at compile time, and are eligible for computing then
120	* rather than waiting until run time.
121	*/
122
123	/*
124	* Each lexeme belongs to one of four categories, which determine
125	* its place in the parse tree. We use the two high bits of the
126	* (unsigned char) value to store a NODE_TYPE code.
127	*/
128
129	#define NODE_TYPE 0xC0
130
131	/*
132	* The four category values are LEAF, UNARY, and BINARY, explained below,
133	* and "uncategorized", which is used either temporarily, until context
134	* determines which of the other three categories is correct, or for
135	* lexemes like INVALID, which aren't really lexemes at all, but indicators
136	* of a parsing error. Note that the codes must be distinct to distinguish
137	* categories, but need not take the form of a bit array.
138	*/
139
140	#define BINARY 0x40 /* This lexeme is a binary operator. An
141	* OpNode representing it should go into the
142	* parse tree, and two operands should be
143	* parsed for it in the expression. */
144	#define UNARY 0x80 /* This lexeme is a unary operator. An OpNode
145	* representing it should go into the parse
146	* tree, and one operand should be parsed for
147	* it in the expression. */
148	#define LEAF 0xC0 /* This lexeme is a leaf operand in the parse
149	* tree. No OpNode will be placed in the tree
150	* for it. Either a literal value will be
151	* appended to the list of literals in this
152	* expression, or appropriate Tcl_Tokens will
153	* be appended in a Tcl_Parse struct to
154	* represent those leaves that require some
155	* form of substitution.
156	*/
157
158	/* Uncategorized lexemes */
159
160	#define PLUS 1 /* Ambiguous. Resolves to UNARY_PLUS or
161	* BINARY_PLUS according to context. */
162	#define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or
163	* BINARY_MINUS according to context. */
164	#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to
165	* FUNCTION or a parse error according to
166	* context and value. */
167	#define INCOMPLETE 4 /* A parse error. Used only when the single
168	* "=" is encountered. */
169	#define INVALID 5 /* A parse error. Used when any punctuation
170	* appears that's not a supported operator. */
171
172	/* Leaf lexemes */
173
174	#define NUMBER ( LEAF \| 1) /* For literal numbers */
175	#define SCRIPT ( LEAF \| 2) /* Script substitution; [foo] */
176	#define BOOLEAN ( LEAF \| BAREWORD) /* For literal booleans */
177	#define BRACED ( LEAF \| 4) /* Braced string; {foo bar} */
178	#define VARIABLE ( LEAF \| 5) /* Variable substitution; $x */
179	#define QUOTED ( LEAF \| 6) /* Quoted string; "foo $bar [soom]" */
180	#define EMPTY ( LEAF \| 7) /* Used only for an empty argument
181	* list to a function. Represents
182	* the empty string within parens in
183	* the expression: rand() */
184
185	/* Unary operator lexemes */
186
187	#define UNARY_PLUS ( UNARY \| PLUS)
188	#define UNARY_MINUS ( UNARY \| MINUS)
189	#define FUNCTION ( UNARY \| BAREWORD) /* This is a bit of "creative
190	* interpretation" on the part of the
191	* parser. A function call is parsed
192	* into the parse tree according to
193	* the perspective that the function
194	* name is a unary operator and its
195	* argument list, enclosed in parens,
196	* is its operand. The additional
197	* requirements not implied generally
198	* by treatment as a unary operator --
199	* for example, the requirement that
200	* the operand be enclosed in parens --
201	* are hard coded in the relevant
202	* portions of ParseExpr(). We trade
203	* off the need to include such
204	* exceptional handling in the code
205	* against the need we would otherwise
206	* have for more lexeme categories. */
207	#define START ( UNARY \| 4) /* This lexeme isn't parsed from the
208	* expression text at all. It
209	* represents the start of the
210	* expression and sits at the root of
211	* the parse tree where it serves as
212	* the start/end point of traversals. */
213	#define OPEN_PAREN ( UNARY \| 5) /* Another bit of creative
214	* interpretation, where we treat "("
215	* as a unary operator with the
216	* sub-expression between it and its
217	* matching ")" as its operand. See
218	* CLOSE_PAREN below. */
219	#define NOT ( UNARY \| 6)
220	#define BIT_NOT ( UNARY \| 7)
221
222	/* Binary operator lexemes */
223
224	#define BINARY_PLUS ( BINARY \| PLUS)
225	#define BINARY_MINUS ( BINARY \| MINUS)
226	#define COMMA ( BINARY \| 3) /* The "," operator is a low precedence
227	* binary operator that separates the
228	* arguments in a function call. The
229	* additional constraint that this
230	* operator can only legally appear
231	* at the right places within a
232	* function call argument list are
233	* hard coded within ParseExpr(). */
234	#define MULT ( BINARY \| 4)
235	#define DIVIDE ( BINARY \| 5)
236	#define MOD ( BINARY \| 6)
237	#define LESS ( BINARY \| 7)
238	#define GREATER ( BINARY \| 8)
239	#define BIT_AND ( BINARY \| 9)
240	#define BIT_XOR ( BINARY \| 10)
241	#define BIT_OR ( BINARY \| 11)
242	#define QUESTION ( BINARY \| 12) /* These two lexemes make up the */
243	#define COLON ( BINARY \| 13) /* ternary conditional operator,
244	* $x ? $y : $z . We treat them as
245	* two binary operators to avoid
246	* another lexeme category, and
247	* code the additional constraints
248	* directly in ParseExpr(). For
249	* instance, the right operand of
250	* a "?" operator must be a ":"
251	* operator. */
252	#define LEFT_SHIFT ( BINARY \| 14)
253	#define RIGHT_SHIFT ( BINARY \| 15)
254	#define LEQ ( BINARY \| 16)
255	#define GEQ ( BINARY \| 17)
256	#define EQUAL ( BINARY \| 18)
257	#define NEQ ( BINARY \| 19)
258	#define AND ( BINARY \| 20)
259	#define OR ( BINARY \| 21)
260	#define STREQ ( BINARY \| 22)
261	#define STRNEQ ( BINARY \| 23)
262	#define EXPON ( BINARY \| 24) /* Unlike the other binary operators,
263	* EXPON is right associative and this
264	* distinction is coded directly in
265	* ParseExpr(). */
266	#define IN_LIST ( BINARY \| 25)
267	#define NOT_IN_LIST ( BINARY \| 26)
268	#define CLOSE_PAREN ( BINARY \| 27) /* By categorizing the CLOSE_PAREN
269	* lexeme as a BINARY operator, the
270	* normal parsing rules for binary
271	* operators assure that a close paren
272	* will not directly follow another
273	* operator, and the machinery already
274	* in place to connect operands to
275	* operators according to precedence
276	* performs most of the work of
277	* matching open and close parens for
278	* us. In the end though, a close
279	* paren is not really a binary
280	* operator, and some special coding
281	* in ParseExpr() make sure we never
282	* put an actual CLOSE_PAREN node
283	* in the parse tree. The
284	* sub-expression between parens
285	* becomes the single argument of
286	* the matching OPEN_PAREN unary
287	* operator. */
288	#define END ( BINARY \| 28) /* This lexeme represents the end of
289	* the string being parsed. Treating
290	* it as a binary operator follows the
291	* same logic as the CLOSE_PAREN lexeme
292	* and END pairs with START, in the
293	* same way that CLOSE_PAREN pairs with
294	* OPEN_PAREN. */
295	/*
296	* When ParseExpr() builds the parse tree it must choose which operands to
297	* connect to which operators. This is done according to operator precedence.
298	* The greater an operator's precedence the greater claim it has to link to
299	* an available operand. The Precedence enumeration lists the precedence
300	* values used by Tcl expression operators, from lowest to highest claim.
301	* Each precedence level is commented with the operators that hold that
302	* precedence.
303	*/
304
305	enum Precedence {
306	PREC_END = 1, /* END */
307	PREC_START, /* START */
308	PREC_CLOSE_PAREN, /* ")" */
309	PREC_OPEN_PAREN, /* "(" */
310	PREC_COMMA, /* "," */
311	PREC_CONDITIONAL, /* "?", ":" */
312	PREC_OR, /* "\|\|" */
313	PREC_AND, /* "&&" */
314	PREC_BIT_OR, /* "\|" */
315	PREC_BIT_XOR, /* "^" */
316	PREC_BIT_AND, /* "&" */
317	PREC_EQUAL, /* "==", "!=", "eq", "ne", "in", "ni" */
318	PREC_COMPARE, /* "<", ">", "<=", ">=" */
319	PREC_SHIFT, /* "<<", ">>" */
320	PREC_ADD, /* "+", "-" */
321	PREC_MULT, /* "", "/", "%" /
322	PREC_EXPON, /* "*" /
323	PREC_UNARY /* "+", "-", FUNCTION, "!", "~" */
324	};
325
326	/*
327	* Here the same information contained in the comments above is stored
328	* in inverted form, so that given a lexeme, one can quickly look up
329	* its precedence value.
330	*/
331
332	static const unsigned char prec[] = {
333	/* Non-operator lexemes */
334	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
335	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
336	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
337	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
338	0,
339	/* Binary operator lexemes */
340	PREC_ADD, /* BINARY_PLUS */
341	PREC_ADD, /* BINARY_MINUS */
342	PREC_COMMA, /* COMMA */
343	PREC_MULT, /* MULT */
344	PREC_MULT, /* DIVIDE */
345	PREC_MULT, /* MOD */
346	PREC_COMPARE, /* LESS */
347	PREC_COMPARE, /* GREATER */
348	PREC_BIT_AND, /* BIT_AND */
349	PREC_BIT_XOR, /* BIT_XOR */
350	PREC_BIT_OR, /* BIT_OR */
351	PREC_CONDITIONAL, /* QUESTION */
352	PREC_CONDITIONAL, /* COLON */
353	PREC_SHIFT, /* LEFT_SHIFT */
354	PREC_SHIFT, /* RIGHT_SHIFT */
355	PREC_COMPARE, /* LEQ */
356	PREC_COMPARE, /* GEQ */
357	PREC_EQUAL, /* EQUAL */
358	PREC_EQUAL, /* NEQ */
359	PREC_AND, /* AND */
360	PREC_OR, /* OR */
361	PREC_EQUAL, /* STREQ */
362	PREC_EQUAL, /* STRNEQ */
363	PREC_EXPON, /* EXPON */
364	PREC_EQUAL, /* IN_LIST */
365	PREC_EQUAL, /* NOT_IN_LIST */
366	PREC_CLOSE_PAREN, /* CLOSE_PAREN */
367	PREC_END, /* END */
368	/* Expansion room for more binary operators */
369	0, 0, 0,
370	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
371	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
372	0,
373	/* Unary operator lexemes */
374	PREC_UNARY, /* UNARY_PLUS */
375	PREC_UNARY, /* UNARY_MINUS */
376	PREC_UNARY, /* FUNCTION */
377	PREC_START, /* START */
378	PREC_OPEN_PAREN, /* OPEN_PAREN */
379	PREC_UNARY, /* NOT*/
380	PREC_UNARY, /* BIT_NOT*/
381	};
382
383	/*
384	* A table mapping lexemes to bytecode instructions, used by CompileExprTree().
385	*/
386
387	static const unsigned char instruction[] = {
388	/* Non-operator lexemes */
389	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
390	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
391	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
392	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
393	0,
394	/* Binary operator lexemes */
395	INST_ADD, /* BINARY_PLUS */
396	INST_SUB, /* BINARY_MINUS */
397	0, /* COMMA */
398	INST_MULT, /* MULT */
399	INST_DIV, /* DIVIDE */
400	INST_MOD, /* MOD */
401	INST_LT, /* LESS */
402	INST_GT, /* GREATER */
403	INST_BITAND, /* BIT_AND */
404	INST_BITXOR, /* BIT_XOR */
405	INST_BITOR, /* BIT_OR */
406	0, /* QUESTION */
407	0, /* COLON */
408	INST_LSHIFT, /* LEFT_SHIFT */
409	INST_RSHIFT, /* RIGHT_SHIFT */
410	INST_LE, /* LEQ */
411	INST_GE, /* GEQ */
412	INST_EQ, /* EQUAL */
413	INST_NEQ, /* NEQ */
414	0, /* AND */
415	0, /* OR */
416	INST_STR_EQ, /* STREQ */
417	INST_STR_NEQ, /* STRNEQ */
418	INST_EXPON, /* EXPON */
419	INST_LIST_IN, /* IN_LIST */
420	INST_LIST_NOT_IN, /* NOT_IN_LIST */
421	0, /* CLOSE_PAREN */
422	0, /* END */
423	/* Expansion room for more binary operators */
424	0, 0, 0,
425	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
426	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
427	0,
428	/* Unary operator lexemes */
429	INST_UPLUS, /* UNARY_PLUS */
430	INST_UMINUS, /* UNARY_MINUS */
431	0, /* FUNCTION */
432	0, /* START */
433	0, /* OPEN_PAREN */
434	INST_LNOT, /* NOT*/
435	INST_BITNOT, /* BIT_NOT*/
436	};
437
438	/*
439	* A table mapping a byte value to the corresponding lexeme for use by
440	* ParseLexeme().
441	*/
442
443	static unsigned char Lexeme[] = {
444	INVALID /* NUL /, INVALID / SOH */,
445	INVALID /* STX /, INVALID / ETX */,
446	INVALID /* EOT /, INVALID / ENQ */,
447	INVALID /* ACK /, INVALID / BEL */,
448	INVALID /* BS /, INVALID / HT */,
449	INVALID /* LF /, INVALID / VT */,
450	INVALID /* FF /, INVALID / CR */,
451	INVALID /* SO /, INVALID / SI */,
452	INVALID /* DLE /, INVALID / DC1 */,
453	INVALID /* DC2 /, INVALID / DC3 */,
454	INVALID /* DC4 /, INVALID / NAK */,
455	INVALID /* SYN /, INVALID / ETB */,
456	INVALID /* CAN /, INVALID / EM */,
457	INVALID /* SUB /, INVALID / ESC */,
458	INVALID /* FS /, INVALID / GS */,
459	INVALID /* RS /, INVALID / US */,
460	INVALID /* SPACE /, 0 / ! or != */,
461	QUOTED /* " /, INVALID / # */,
462	VARIABLE /* $ /, MOD / % */,
463	0 /* & or && /, INVALID / ' */,
464	OPEN_PAREN /* ( /, CLOSE_PAREN / ) */,
465	0 /* * or ** /, PLUS / + */,
466	COMMA /* , /, MINUS / - */,
467	0 /* . /, DIVIDE / / */,
468	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */
469	COLON /* : /, INVALID / ; */,
470	0 /* < or << or <= */,
471	0 /* == or INVALID */,
472	0 /* > or >> or >= */,
473	QUESTION /* ? /, INVALID / @ */,
474	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* A-M */
475	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* N-Z */
476	SCRIPT /* [ /, INVALID / \ */,
477	INVALID /* ] /, BIT_XOR / ^ */,
478	INVALID /* _ /, INVALID / ` */,
479	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* a-m */
480	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* n-z */
481	BRACED /* { /, 0 / \| or \|\| */,
482	INVALID /* } /, BIT_NOT / ~ */,
483	INVALID /* DEL */
484	};
485
486	/*
487	* The JumpList struct is used to create a stack of data needed for the
488	* TclEmitForwardJump() and TclFixupForwardJump() calls that are performed
489	* when compiling the short-circuiting operators QUESTION/COLON, AND, and OR.
490	* Keeping a stack permits the CompileExprTree() routine to be non-recursive.
491	*/
492
493	typedef struct JumpList {
494	JumpFixup jump; /* Pass this argument to matching calls of
495	* TclEmitForwardJump() and
496	* TclFixupForwardJump(). */
497	int depth; /* Remember the currStackDepth of the
498	* CompileEnv here. */
499	int offset; /* Data used to compute jump lengths to pass
500	* to TclFixupForwardJump() */
501	int convert; /* Temporary storage used to compute whether
502	* numeric conversion will be needed following
503	* the operator we're compiling. */
504	struct JumpList next; / Point to next item on the stack */
505	} JumpList;
506
507	/*
508	* Declarations for local functions to this file:
509	*/
510
511	static void CompileExprTree(Tcl_Interp interp, OpNode nodes,
512	int index, Tcl_Obj const *litObjvPtr,
513	Tcl_Obj const funcObjv, Tcl_Token *tokenPtr,
514	CompileEnv *envPtr, int optimize);
515	static void ConvertTreeToTokens(const char *start, int numBytes,
516	OpNode nodes, Tcl_Token tokenPtr,
517	Tcl_Parse *parsePtr);
518	static int ExecConstantExprTree(Tcl_Interp interp, OpNode nodes,
519	int index, Tcl_Obj * const **litObjvPtr);
520	static int ParseExpr(Tcl_Interp interp, const char start,
521	int numBytes, OpNode **opTreePtr,
522	Tcl_Obj litList, Tcl_Obj funcList,
523	Tcl_Parse *parsePtr, int parseOnly);
524	static int ParseLexeme(const char *start, int numBytes,
525	unsigned char lexemePtr, Tcl_Obj *literalPtr);
526
527
528	/*
529	*----------------------------------------------------------------------
530	*
531	* ParseExpr --
532	*
533	* Given a string, the numBytes bytes starting at start, this function
534	* parses it as a Tcl expression and constructs a tree representing
535	* the structure of the expression. The caller must pass in empty
536	* lists as the funcList and litList arguments. The elements of the
537	* parsed expression are returned to the caller as that tree, a list of
538	* literal values, a list of function names, and in Tcl_Tokens
539	* added to a Tcl_Parse struct passed in by the caller.
540	*
541	* Results:
542	* If the string is successfully parsed as a valid Tcl expression, TCL_OK
543	* is returned, and data about the expression structure is written to
544	* the last four arguments. If the string cannot be parsed as a valid
545	* Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, an
546	* error message is written to interp.
547	*
548	* Side effects:
549	* Memory will be allocated. If TCL_OK is returned, the caller must
550	* clean up the returned data structures. The (OpNode *) value written
551	* to opTreePtr should be passed to ckfree() and the parsePtr argument
552	* should be passed to Tcl_FreeParse(). The elements appended to the
553	* litList and funcList will automatically be freed whenever the
554	* refcount on those lists indicates they can be freed.
555	*
556	*----------------------------------------------------------------------
557	*/
558
559	static int
560	ParseExpr(
561	Tcl_Interp interp, / Used for error reporting. */
562	const char start, / Start of source string to parse. */
563	int numBytes, /* Number of bytes in string. */
564	OpNode *opTreePtr, / Points to space where a pointer to the
565	* allocated OpNode tree should go. */
566	Tcl_Obj litList, / List to append literals to. */
567	Tcl_Obj funcList, / List to append function names to. */
568	Tcl_Parse parsePtr, / Structure to fill with tokens representing
569	* those operands that require run time
570	* substitutions. */
571	int parseOnly) /* A boolean indicating whether the caller's
572	* aim is just a parse, or whether it will go
573	* on to compile the expression. Different
574	* optimizations are appropriate for the
575	* two scenarios. */
576	{
577	OpNode nodes = NULL; / Pointer to the OpNode storage array where
578	* we build the parse tree. */
579	int nodesAvailable = 64; /* Initial size of the storage array. This
580	* value establishes a minimum tree memory cost
581	* of only about 1 kibyte, and is large enough
582	* for most expressions to parse with no need
583	* for array growth and reallocation. */
584	int nodesUsed = 0; /* Number of OpNodes filled. */
585	int scanned = 0; /* Capture number of byte scanned by
586	* parsing routines. */
587	int lastParsed; /* Stores info about what the lexeme parsed
588	* the previous pass through the parsing loop
589	* was. If it was an operator, lastParsed is
590	* the index of the OpNode for that operator.
591	* If it was not an operator, lastParsed holds
592	* an OperandTypes value encoding what we
593	* need to know about it. */
594	int incomplete; /* Index of the most recent incomplete tree
595	* in the OpNode array. Heads a stack of
596	* incomplete trees linked by p.prev. */
597	int complete = OT_EMPTY; /* "Index" of the complete tree (that is, a
598	* complete subexpression) determined at the
599	* moment. OT_EMPTY is a nonsense value
600	* used only to silence compiler warnings.
601	* During a parse, complete will always hold
602	* an index or an OperandTypes value pointing
603	* to an actual leaf at the time the complete
604	* tree is needed. */
605
606	/* These variables control generation of the error message. */
607	Tcl_Obj msg = NULL; / The error message. */
608	Tcl_Obj post = NULL; / In a few cases, an additional postscript
609	* for the error message, supplying more
610	* information after the error msg and
611	* location have been reported. */
612	const char mark = "_@_"; / In the portion of the complete error message
613	* where the error location is reported, this
614	* "mark" substring is inserted into the
615	* string being parsed to aid in pinpointing
616	* the location of the syntax error in the
617	* expression. */
618	int insertMark = 0; /* A boolean controlling whether the "mark"
619	* should be inserted. */
620	const int limit = 25; /* Portions of the error message are
621	* constructed out of substrings of the
622	* original expression. In order to keep the
623	* error message readable, we impose this limit
624	* on the substring size we extract. */
625
626	TclParseInit(interp, start, numBytes, parsePtr);
627
628	nodes = (OpNode ) attemptckalloc(nodesAvailable sizeof(OpNode));
629	if (nodes == NULL) {
630	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
631	goto error;
632	}
633
634	/* Initialize the parse tree with the special "START" node. */
635	nodes->lexeme = START;
636	nodes->precedence = prec[START];
637	nodes->mark = MARK_RIGHT;
638	nodes->constant = 1;
639	incomplete = lastParsed = nodesUsed;
640	nodesUsed++;
641
642	/*
643	* Main parsing loop parses one lexeme per iteration. We exit the
644	* loop only when there's a syntax error with a "goto error" which
645	* takes us to the error handling code following the loop, or when
646	* we've successfully completed the parse and we return to the caller.
647	*/
648
649	while (1) {
650	OpNode nodePtr; / Points to the OpNode we may fill this
651	* pass through the loop. */
652	unsigned char lexeme; /* The lexeme we parse this iteration. */
653	Tcl_Obj literal; / Filled by the ParseLexeme() call when
654	* a literal is parsed that has a Tcl_Obj
655	* rep worth preserving. */
656	const char *lastStart = start - scanned;
657	/* Compute where the lexeme parsed the
658	* previous pass through the loop began.
659	* This is helpful for detecting invalid
660	* octals and providing more complete error
661	* messages. */
662
663	/*
664	* Each pass through this loop adds up to one more OpNode. Allocate
665	* space for one if required.
666	*/
667
668	if (nodesUsed >= nodesAvailable) {
669	int size = nodesUsed * 2;
670	OpNode *newPtr;
671
672	do {
673	newPtr = (OpNode ) attemptckrealloc((char ) nodes,
674	(unsigned int) size * sizeof(OpNode));
675	} while ((newPtr == NULL)
676	&& ((size -= (size - nodesUsed) / 2) > nodesUsed));
677	if (newPtr == NULL) {
678	TclNewLiteralStringObj(msg,
679	"not enough memory to parse expression");
680	goto error;
681	}
682	nodesAvailable = size;
683	nodes = newPtr;
684	}
685	nodePtr = nodes + nodesUsed;
686
687	/* Skip white space between lexemes. */
688	scanned = TclParseAllWhiteSpace(start, numBytes);
689	start += scanned;
690	numBytes -= scanned;
691
692	scanned = ParseLexeme(start, numBytes, &lexeme, &literal);
693
694	/* Use context to categorize the lexemes that are ambiguous. */
695	if ((NODE_TYPE & lexeme) == 0) {
696	switch (lexeme) {
697	case INVALID:
698	msg = Tcl_ObjPrintf(
699	"invalid character \"%.*s\"", scanned, start);
700	goto error;
701	case INCOMPLETE:
702	msg = Tcl_ObjPrintf(
703	"incomplete operator \"%.*s\"", scanned, start);
704	goto error;
705	case BAREWORD:
706
707	/*
708	* Most barewords in an expression are a syntax error.
709	* The exceptions are that when a bareword is followed by
710	* an open paren, it might be a function call, and when the
711	* bareword is a legal literal boolean value, we accept that
712	* as well.
713	*/
714
715	if (start[scanned+TclParseAllWhiteSpace(
716	start+scanned, numBytes-scanned)] == '(') {
717	lexeme = FUNCTION;
718
719	/*
720	* When we compile the expression we'll need the function
721	* name, and there's no place in the parse tree to store
722	* it, so we keep a separate list of all the function
723	* names we've parsed in the order we found them.
724	*/
725
726	Tcl_ListObjAppendElement(NULL, funcList, literal);
727	} else {
728	int b;
729	if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
730	lexeme = BOOLEAN;
731	} else {
732	Tcl_DecrRefCount(literal);
733	msg = Tcl_ObjPrintf(
734	"invalid bareword \"%.*s%s\"",
735	(scanned < limit) ? scanned : limit - 3, start,
736	(scanned < limit) ? "" : "...");
737	post = Tcl_ObjPrintf(
738	"should be \"$%.s%s\" or \"{%.s%s}\"",
739	(scanned < limit) ? scanned : limit - 3,
740	start, (scanned < limit) ? "" : "...",
741	(scanned < limit) ? scanned : limit - 3,
742	start, (scanned < limit) ? "" : "...");
743	Tcl_AppendPrintfToObj(post,
744	" or \"%.*s%s(...)\" or ...",
745	(scanned < limit) ? scanned : limit - 3,
746	start, (scanned < limit) ? "" : "...");
747	if (NotOperator(lastParsed)) {
748	if ((lastStart[0] == '0')
749	&& ((lastStart[1] == 'o')
750	\|\| (lastStart[1] == 'O'))
751	&& (lastStart[2] >= '0')
752	&& (lastStart[2] <= '9')) {
753	const char *end = lastStart + 2;
754	Tcl_Obj* copy;
755	while (isdigit(*end)) {
756	end++;
757	}
758	copy = Tcl_NewStringObj(lastStart,
759	end - lastStart);
760	if (TclCheckBadOctal(NULL,
761	Tcl_GetString(copy))) {
762	Tcl_AppendToObj(post,
763	"(invalid octal number?)", -1);
764	}
765	Tcl_DecrRefCount(copy);
766	}
767	scanned = 0;
768	insertMark = 1;
769	parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
770	}
771	goto error;
772	}
773	}
774	break;
775	case PLUS:
776	case MINUS:
777	if (IsOperator(lastParsed)) {
778
779	/*
780	* A "+" or "-" coming just after another operator
781	* must be interpreted as a unary operator.
782	*/
783
784	lexeme \|= UNARY;
785	} else {
786	lexeme \|= BINARY;
787	}
788	}
789	} /* Uncategorized lexemes */
790
791	/* Handle lexeme based on its category. */
792	switch (NODE_TYPE & lexeme) {
793
794	/*
795	* Each LEAF results in either a literal getting appended to the
796	* litList, or a sequence of Tcl_Tokens representing a Tcl word
797	* getting appended to the parsePtr->tokens. No OpNode is filled
798	* for this lexeme.
799	*/
800
801	case LEAF: {
802	Tcl_Token *tokenPtr;
803	const char *end = start;
804	int wordIndex;
805	int code = TCL_OK;
806
807	/*
808	* A leaf operand appearing just after something that's not an
809	* operator is a syntax error.
810	*/
811
812	if (NotOperator(lastParsed)) {
813	msg = Tcl_ObjPrintf("missing operator at %s", mark);
814	if (lastStart[0] == '0') {
815	Tcl_Obj *copy = Tcl_NewStringObj(lastStart,
816	start + scanned - lastStart);
817	if (TclCheckBadOctal(NULL, Tcl_GetString(copy))) {
818	TclNewLiteralStringObj(post,
819	"looks like invalid octal number");
820	}
821	Tcl_DecrRefCount(copy);
822	}
823	scanned = 0;
824	insertMark = 1;
825	parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
826
827	/* Free any literal to avoid a memleak. */
828	if ((lexeme == NUMBER) \|\| (lexeme == BOOLEAN)) {
829	Tcl_DecrRefCount(literal);
830	}
831	goto error;
832	}
833
834	switch (lexeme) {
835	case NUMBER:
836	case BOOLEAN:
837	/*
838	* TODO: Consider using a dict or hash to collapse all
839	* duplicate literals into a single representative value.
840	* (Like what is done with [split $s {}]).
841	* Pro: ~75% memory saving on expressions like
842	* {1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
843	* to "pointer" cost only)
844	* Con: Cost of the dict store/retrieve on every literal
845	* in every expression when expressions like the above
846	* tend to be uncommon.
847	* The memory savings is temporary; Compiling to bytecode
848	* will collapse things as literals are registered
849	* anyway, so the savings applies only to the time
850	* between parsing and compiling. Possibly important
851	* due to high-water mark nature of memory allocation.
852	*/
853	Tcl_ListObjAppendElement(NULL, litList, literal);
854	complete = lastParsed = OT_LITERAL;
855	start += scanned;
856	numBytes -= scanned;
857	continue;
858
859	default:
860	break;
861	}
862
863	/*
864	* Remaining LEAF cases may involve filling Tcl_Tokens, so
865	* make room for at least 2 more tokens.
866	*/
867
868	TclGrowParseTokenArray(parsePtr, 2);
869	wordIndex = parsePtr->numTokens;
870	tokenPtr = parsePtr->tokenPtr + wordIndex;
871	tokenPtr->type = TCL_TOKEN_WORD;
872	tokenPtr->start = start;
873	parsePtr->numTokens++;
874
875	switch (lexeme) {
876	case QUOTED:
877	code = Tcl_ParseQuotedString(NULL, start, numBytes,
878	parsePtr, 1, &end);
879	scanned = end - start;
880	break;
881
882	case BRACED:
883	code = Tcl_ParseBraces(NULL, start, numBytes,
884	parsePtr, 1, &end);
885	scanned = end - start;
886	break;
887
888	case VARIABLE:
889	code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1);
890
891	/*
892	* Handle the quirk that Tcl_ParseVarName reports a successful
893	* parse even when it gets only a "$" with no variable name.
894	*/
895
896	tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
897	if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
898	TclNewLiteralStringObj(msg, "invalid character \"$\"");
899	goto error;
900	}
901	scanned = tokenPtr->size;
902	break;
903
904	case SCRIPT: {
905	Tcl_Parse *nestedPtr =
906	(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
907
908	tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
909	tokenPtr->type = TCL_TOKEN_COMMAND;
910	tokenPtr->start = start;
911	tokenPtr->numComponents = 0;
912
913	end = start + numBytes;
914	start++;
915	while (1) {
916	code = Tcl_ParseCommand(interp, start, (end - start), 1,
917	nestedPtr);
918	if (code != TCL_OK) {
919	parsePtr->term = nestedPtr->term;
920	parsePtr->errorType = nestedPtr->errorType;
921	parsePtr->incomplete = nestedPtr->incomplete;
922	break;
923	}
924	start = (nestedPtr->commandStart + nestedPtr->commandSize);
925	Tcl_FreeParse(nestedPtr);
926	if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
927	&& !(nestedPtr->incomplete)) {
928	break;
929	}
930
931	if (start == end) {
932	TclNewLiteralStringObj(msg, "missing close-bracket");
933	parsePtr->term = tokenPtr->start;
934	parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
935	parsePtr->incomplete = 1;
936	code = TCL_ERROR;
937	break;
938	}
939	}
940	TclStackFree(interp, nestedPtr);
941	end = start;
942	start = tokenPtr->start;
943	scanned = end - start;
944	tokenPtr->size = scanned;
945	parsePtr->numTokens++;
946	break;
947	}
948	}
949	if (code != TCL_OK) {
950
951	/*
952	* Here we handle all the syntax errors generated by
953	* the Tcl_Token generating parsing routines called in the
954	* switch just above. If the value of parsePtr->incomplete
955	* is 1, then the error was an unbalanced '[', '(', '{',
956	* or '"' and parsePtr->term is pointing to that unbalanced
957	* character. If the value of parsePtr->incomplete is 0,
958	* then the error is one of lacking whitespace following a
959	* quoted word, for example: expr {[an error {foo}bar]},
960	* and parsePtr->term points to where the whitespace is
961	* missing. We reset our values of start and scanned so that
962	* when our error message is constructed, the location of
963	* the syntax error is sure to appear in it, even if the
964	* quoted expression is truncated.
965	*/
966
967	start = parsePtr->term;
968	scanned = parsePtr->incomplete;
969	goto error;
970	}
971
972	tokenPtr = parsePtr->tokenPtr + wordIndex;
973	tokenPtr->size = scanned;
974	tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1;
975	if (!parseOnly && ((lexeme == QUOTED) \|\| (lexeme == BRACED))) {
976
977	/*
978	* When this expression is destined to be compiled, and a
979	* braced or quoted word within an expression is known at
980	* compile time (no runtime substitutions in it), we can
981	* store it as a literal rather than in its tokenized form.
982	* This is an advantage since the compiled bytecode is going
983	* to need the argument in Tcl_Obj form eventually, so it's
984	* just as well to get there now. Another advantage is that
985	* with this conversion, larger constant expressions might
986	* be grown and optimized.
987	*
988	* On the contrary, if the end goal of this parse is to
989	* fill a Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
990	* wasteful to convert to a literal only to convert back again
991	* later.
992	*/
993
994	literal = Tcl_NewObj();
995	if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
996	Tcl_ListObjAppendElement(NULL, litList, literal);
997	complete = lastParsed = OT_LITERAL;
998	parsePtr->numTokens = wordIndex;
999	break;
1000	}
1001	Tcl_DecrRefCount(literal);
1002	}
1003	complete = lastParsed = OT_TOKENS;
1004	break;
1005	} /* case LEAF */
1006
1007	case UNARY:
1008
1009	/*
1010	* A unary operator appearing just after something that's not an
1011	* operator is a syntax error -- something trying to be the left
1012	* operand of an operator that doesn't take one.
1013	*/
1014
1015	if (NotOperator(lastParsed)) {
1016	msg = Tcl_ObjPrintf("missing operator at %s", mark);
1017	scanned = 0;
1018	insertMark = 1;
1019	goto error;
1020	}
1021
1022	/* Create an OpNode for the unary operator */
1023	nodePtr->lexeme = lexeme;
1024	nodePtr->precedence = prec[lexeme];
1025	nodePtr->mark = MARK_RIGHT;
1026
1027	/*
1028	* A FUNCTION cannot be a constant expression, because Tcl allows
1029	* functions to return variable results with the same arguments;
1030	* for example, rand(). Other unary operators can root a constant
1031	* expression, so long as the argument is a constant expression.
1032	*/
1033
1034	nodePtr->constant = (lexeme != FUNCTION);
1035
1036	/*
1037	* This unary operator is a new incomplete tree, so push it
1038	* onto our stack of incomplete trees. Also remember it as
1039	* the last lexeme we parsed.
1040	*/
1041
1042	nodePtr->p.prev = incomplete;
1043	incomplete = lastParsed = nodesUsed;
1044	nodesUsed++;
1045	break;
1046
1047	case BINARY: {
1048	OpNode *incompletePtr;
1049	unsigned char precedence = prec[lexeme];
1050
1051	/*
1052	* A binary operator appearing just after another operator is a
1053	* syntax error -- one of the two operators is missing an operand.
1054	*/
1055
1056	if (IsOperator(lastParsed)) {
1057	if ((lexeme == CLOSE_PAREN)
1058	&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
1059	if (nodePtr[-2].lexeme == FUNCTION) {
1060
1061	/*
1062	* Normally, "()" is a syntax error, but as a special
1063	* case accept it as an argument list for a function.
1064	* Treat this as a special LEAF lexeme, and restart
1065	* the parsing loop with zero characters scanned.
1066	* We'll parse the ")" again the next time through,
1067	* but with the OT_EMPTY leaf as the subexpression
1068	* between the parens.
1069	*/
1070
1071	scanned = 0;
1072	complete = lastParsed = OT_EMPTY;
1073	break;
1074	}
1075	msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
1076	scanned = 0;
1077	insertMark = 1;
1078	goto error;
1079	}
1080
1081	if (nodePtr[-1].precedence > precedence) {
1082	if (nodePtr[-1].lexeme == OPEN_PAREN) {
1083	TclNewLiteralStringObj(msg, "unbalanced open paren");
1084	parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
1085	} else if (nodePtr[-1].lexeme == COMMA) {
1086	msg = Tcl_ObjPrintf(
1087	"missing function argument at %s", mark);
1088	scanned = 0;
1089	insertMark = 1;
1090	} else if (nodePtr[-1].lexeme == START) {
1091	TclNewLiteralStringObj(msg, "empty expression");
1092	}
1093	} else {
1094	if (lexeme == CLOSE_PAREN) {
1095	TclNewLiteralStringObj(msg, "unbalanced close paren");
1096	} else if ((lexeme == COMMA)
1097	&& (nodePtr[-1].lexeme == OPEN_PAREN)
1098	&& (nodePtr[-2].lexeme == FUNCTION)) {
1099	msg = Tcl_ObjPrintf(
1100	"missing function argument at %s", mark);
1101	scanned = 0;
1102	insertMark = 1;
1103	}
1104	}
1105	if (msg == NULL) {
1106	msg = Tcl_ObjPrintf("missing operand at %s", mark);
1107	scanned = 0;
1108	insertMark = 1;
1109	}
1110	goto error;
1111	}
1112
1113	/*
1114	* Here is where the tree comes together. At this point, we
1115	* have a stack of incomplete trees corresponding to
1116	* substrings that are incomplete expressions, followed by
1117	* a complete tree corresponding to a substring that is itself
1118	* a complete expression, followed by the binary operator we have
1119	* just parsed. The incomplete trees can each be completed by
1120	* adding a right operand.
1121	*
1122	* To illustrate with an example, when we parse the expression
1123	* "1+2*3-4" and we reach this point having just parsed the "-"
1124	* operator, we have these incomplete trees: START, "1+", and
1125	* "2*". Next we have the complete subexpression "3". Last is
1126	* the "-" we've just parsed.
1127	*
1128	* The next step is to join our complete tree to an operator.
1129	* The choice is governed by the precedence and associativity
1130	* of the competing operators. If we connect it as the right
1131	* operand of our most recent incomplete tree, we get a new
1132	* complete tree, and we can repeat the process. The while
1133	* loop following repeats this until precedence indicates it
1134	* is time to join the complete tree as the left operand of
1135	* the just parsed binary operator.
1136	*
1137	* Continuing the example, the first pass through the loop
1138	* will join "3" to "2"; the next pass will join "23" to
1139	* "1+". Then we'll exit the loop and join "1+2*3" to "-".
1140	* When we return to parse another lexeme, our stack of
1141	* incomplete trees is START and "1+2*3-".
1142	*/
1143
1144	while (1) {
1145	incompletePtr = nodes + incomplete;
1146
1147	if (incompletePtr->precedence < precedence) {
1148	break;
1149	}
1150
1151	if (incompletePtr->precedence == precedence) {
1152
1153	/* Right association rules for exponentiation. */
1154	if (lexeme == EXPON) {
1155	break;
1156	}
1157
1158	/*
1159	* Special association rules for the conditional operators.
1160	* The "?" and ":" operators have equal precedence, but
1161	* must be linked up in sensible pairs.
1162	*/
1163
1164	if ((incompletePtr->lexeme == QUESTION)
1165	&& (NotOperator(complete)
1166	\|\| (nodes[complete].lexeme != COLON))) {
1167	break;
1168	}
1169	if ((incompletePtr->lexeme == COLON)
1170	&& (lexeme == QUESTION)) {
1171	break;
1172	}
1173	}
1174
1175	/* Some special syntax checks... */
1176
1177	/* Parens must balance */
1178	if ((incompletePtr->lexeme == OPEN_PAREN)
1179	&& (lexeme != CLOSE_PAREN)) {
1180	TclNewLiteralStringObj(msg, "unbalanced open paren");
1181	parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
1182	goto error;
1183	}
1184
1185	/* Right operand of "?" must be ":" */
1186	if ((incompletePtr->lexeme == QUESTION)
1187	&& (NotOperator(complete)
1188	\|\| (nodes[complete].lexeme != COLON))) {
1189	msg = Tcl_ObjPrintf(
1190	"missing operator \":\" at %s", mark);
1191	scanned = 0;
1192	insertMark = 1;
1193	goto error;
1194	}
1195
1196	/* Operator ":" may only be right operand of "?" */
1197	if (IsOperator(complete)
1198	&& (nodes[complete].lexeme == COLON)
1199	&& (incompletePtr->lexeme != QUESTION)) {
1200	TclNewLiteralStringObj(msg,
1201	"unexpected operator \":\" "
1202	"without preceding \"?\"");
1203	goto error;
1204	}
1205
1206	/*
1207	* Attach complete tree as right operand of most recent
1208	* incomplete tree.
1209	*/
1210
1211	incompletePtr->right = complete;
1212	if (IsOperator(complete)) {
1213	nodes[complete].p.parent = incomplete;
1214	incompletePtr->constant = incompletePtr->constant
1215	&& nodes[complete].constant;
1216	} else {
1217	incompletePtr->constant = incompletePtr->constant
1218	&& (complete == OT_LITERAL);
1219	}
1220
1221	/*
1222	* The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each
1223	* make up a single operator. Force them to agree whether they
1224	* have a constant expression.
1225	*/
1226
1227	if ((incompletePtr->lexeme == QUESTION)
1228	\|\| (incompletePtr->lexeme == FUNCTION)) {
1229	nodes[complete].constant = incompletePtr->constant;
1230	}
1231
1232	if (incompletePtr->lexeme == START) {
1233
1234	/*
1235	* Completing the START tree indicates we're done.
1236	* Transfer the parse tree to the caller and return.
1237	*/
1238
1239	*opTreePtr = nodes;
1240	return TCL_OK;
1241	}
1242
1243	/*
1244	* With a right operand attached, last incomplete tree has
1245	* become the complete tree. Pop it from the incomplete
1246	* tree stack.
1247	*/
1248
1249	complete = incomplete;
1250	incomplete = incompletePtr->p.prev;
1251
1252	/* CLOSE_PAREN can only close one OPEN_PAREN. */
1253	if (incompletePtr->lexeme == OPEN_PAREN) {
1254	break;
1255	}
1256	}
1257
1258	/* More syntax checks... */
1259
1260	/* Parens must balance. */
1261	if (lexeme == CLOSE_PAREN) {
1262	if (incompletePtr->lexeme != OPEN_PAREN) {
1263	TclNewLiteralStringObj(msg, "unbalanced close paren");
1264	goto error;
1265	}
1266	}
1267
1268	/* Commas must appear only in function argument lists. */
1269	if (lexeme == COMMA) {
1270	if ((incompletePtr->lexeme != OPEN_PAREN)
1271	\|\| (incompletePtr[-1].lexeme != FUNCTION)) {
1272	TclNewLiteralStringObj(msg,
1273	"unexpected \",\" outside function argument list");
1274	goto error;
1275	}
1276	}
1277
1278	/* Operator ":" may only be right operand of "?" */
1279	if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
1280	TclNewLiteralStringObj(msg,
1281	"unexpected operator \":\" without preceding \"?\"");
1282	goto error;
1283	}
1284
1285	/* Create no node for a CLOSE_PAREN lexeme. */
1286	if (lexeme == CLOSE_PAREN) {
1287	break;
1288	}
1289
1290	/* Link complete tree as left operand of new node. */
1291	nodePtr->lexeme = lexeme;
1292	nodePtr->precedence = precedence;
1293	nodePtr->mark = MARK_LEFT;
1294	nodePtr->left = complete;
1295
1296	/*
1297	* The COMMA operator cannot be optimized, since the function
1298	* needs all of its arguments, and optimization would reduce
1299	* the number. Other binary operators root constant expressions
1300	* when both arguments are constant expressions.
1301	*/
1302
1303	nodePtr->constant = (lexeme != COMMA);
1304
1305	if (IsOperator(complete)) {
1306	nodes[complete].p.parent = nodesUsed;
1307	nodePtr->constant = nodePtr->constant
1308	&& nodes[complete].constant;
1309	} else {
1310	nodePtr->constant = nodePtr->constant
1311	&& (complete == OT_LITERAL);
1312	}
1313
1314	/*
1315	* With a left operand attached and a right operand missing,
1316	* the just-parsed binary operator is root of a new incomplete
1317	* tree. Push it onto the stack of incomplete trees.
1318	*/
1319
1320	nodePtr->p.prev = incomplete;
1321	incomplete = lastParsed = nodesUsed;
1322	nodesUsed++;
1323	break;
1324	} /* case BINARY */
1325	} /* lexeme handler */
1326
1327	/* Advance past the just-parsed lexeme */
1328	start += scanned;
1329	numBytes -= scanned;
1330	} /* main parsing loop */
1331
1332	error:
1333
1334	/*
1335	* We only get here if there's been an error.
1336	* Any errors that didn't get a suitable parsePtr->errorType,
1337	* get recorded as syntax errors.
1338	*/
1339
1340	if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
1341	parsePtr->errorType = TCL_PARSE_SYNTAX;
1342	}
1343
1344	/* Free any partial parse tree we've built. */
1345	if (nodes != NULL) {
1346	ckfree((char*) nodes);
1347	}
1348
1349	if (interp == NULL) {
1350
1351	/* Nowhere to report an error message, so just free it */
1352	if (msg) {
1353	Tcl_DecrRefCount(msg);
1354	}
1355	} else {
1356
1357	/*
1358	* Construct the complete error message. Start with the simple
1359	* error message, pulled from the interp result if necessary...
1360	*/
1361
1362	if (msg == NULL) {
1363	msg = Tcl_GetObjResult(interp);
1364	}
1365
1366	/*
1367	* Add a detailed quote from the bad expression, displaying and
1368	* sometimes marking the precise location of the syntax error.
1369	*/
1370
1371	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.s%.s%s%s%.*s%s\"",
1372	((start - limit) < parsePtr->string) ? "" : "...",
1373	((start - limit) < parsePtr->string)
1374	? (start - parsePtr->string) : limit - 3,
1375	((start - limit) < parsePtr->string)
1376	? parsePtr->string : start - limit + 3,
1377	(scanned < limit) ? scanned : limit - 3, start,
1378	(scanned < limit) ? "" : "...", insertMark ? mark : "",
1379	(start + scanned + limit > parsePtr->end)
1380	? parsePtr->end - (start + scanned) : limit-3,
1381	start + scanned,
1382	(start + scanned + limit > parsePtr->end) ? "" : "...");
1383
1384	/* Next, append any postscript message. */
1385	if (post != NULL) {
1386	Tcl_AppendToObj(msg, ";\n", -1);
1387	Tcl_AppendObjToObj(msg, post);
1388	Tcl_DecrRefCount(post);
1389	}
1390	Tcl_SetObjResult(interp, msg);
1391
1392	/* Finally, place context information in the errorInfo. */
1393	numBytes = parsePtr->end - parsePtr->string;
1394	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
1395	"\n (parsing expression \"%.*s%s\")",
1396	(numBytes < limit) ? numBytes : limit - 3,
1397	parsePtr->string, (numBytes < limit) ? "" : "..."));
1398	}
1399
1400	return TCL_ERROR;
1401	}
1402
1403	/*
1404	*----------------------------------------------------------------------
1405	*
1406	* ConvertTreeToTokens --
1407	*
1408	* Given a string, the numBytes bytes starting at start, and an OpNode
1409	* tree and Tcl_Token array created by passing that same string to
1410	* ParseExpr(), this function writes into *parsePtr the sequence of
1411	* Tcl_Tokens needed so to satisfy the historical interface provided
1412	* by Tcl_ParseExpr(). Note that this routine exists only for the sake
1413	* of the public Tcl_ParseExpr() routine. It is not used by Tcl itself
1414	* at all.
1415	*
1416	* Results:
1417	* None.
1418	*
1419	* Side effects:
1420	* The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
1421	* parsed expression.
1422	*
1423	*----------------------------------------------------------------------
1424	*/
1425
1426	static void
1427	ConvertTreeToTokens(
1428	const char *start,
1429	int numBytes,
1430	OpNode *nodes,
1431	Tcl_Token *tokenPtr,
1432	Tcl_Parse *parsePtr)
1433	{
1434	int subExprTokenIdx = 0;
1435	OpNode *nodePtr = nodes;
1436	int next = nodePtr->right;
1437
1438	while (1) {
1439	Tcl_Token *subExprTokenPtr;
1440	int scanned, parentIdx;
1441	unsigned char lexeme;
1442
1443	/*
1444	* Advance the mark so the next exit from this node won't retrace
1445	* steps over ground already covered.
1446	*/
1447
1448	nodePtr->mark++;
1449
1450	/* Handle next child node or leaf */
1451	switch (next) {
1452	case OT_EMPTY:
1453
1454	/* No tokens and no characters for the OT_EMPTY leaf. */
1455	break;
1456
1457	case OT_LITERAL:
1458
1459	/* Skip any white space that comes before the literal */
1460	scanned = TclParseAllWhiteSpace(start, numBytes);
1461	start +=scanned;
1462	numBytes -= scanned;
1463
1464	/* Reparse the literal to get pointers into source string */
1465	scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
1466
1467	TclGrowParseTokenArray(parsePtr, 2);
1468	subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
1469	subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1470	subExprTokenPtr->start = start;
1471	subExprTokenPtr->size = scanned;
1472	subExprTokenPtr->numComponents = 1;
1473	subExprTokenPtr[1].type = TCL_TOKEN_TEXT;
1474	subExprTokenPtr[1].start = start;
1475	subExprTokenPtr[1].size = scanned;
1476	subExprTokenPtr[1].numComponents = 0;
1477
1478	parsePtr->numTokens += 2;
1479	start +=scanned;
1480	numBytes -= scanned;
1481	break;
1482
1483	case OT_TOKENS: {
1484
1485	/*
1486	* tokenPtr points to a token sequence that came from parsing
1487	* a Tcl word. A Tcl word is made up of a sequence of one or
1488	* more elements. When the word is only a single element, it's
1489	* been the historical practice to replace the TCL_TOKEN_WORD
1490	* token directly with a TCL_TOKEN_SUB_EXPR token. However,
1491	* when the word has multiple elements, a TCL_TOKEN_WORD token
1492	* is kept as a grouping device so that TCL_TOKEN_SUB_EXPR
1493	* always has only one element. Wise or not, these are the
1494	* rules the Tcl expr parser has followed, and for the sake
1495	* of those few callers of Tcl_ParseExpr() we do not change
1496	* them now. Internally, we can do better.
1497	*/
1498
1499	int toCopy = tokenPtr->numComponents + 1;
1500
1501	if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {
1502
1503	/*
1504	* Single element word. Copy tokens and convert the leading
1505	* token to TCL_TOKEN_SUB_EXPR.
1506	*/
1507
1508	TclGrowParseTokenArray(parsePtr, toCopy);
1509	subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
1510	memcpy(subExprTokenPtr, tokenPtr,
1511	(size_t) toCopy * sizeof(Tcl_Token));
1512	subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1513	parsePtr->numTokens += toCopy;
1514	} else {
1515
1516	/*
1517	* Multiple element word. Create a TCL_TOKEN_SUB_EXPR
1518	* token to lead, with fields initialized from the leading
1519	* token, then copy entire set of word tokens.
1520	*/
1521
1522	TclGrowParseTokenArray(parsePtr, toCopy+1);
1523	subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
1524	subExprTokenPtr = tokenPtr;
1525	subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1526	subExprTokenPtr->numComponents++;
1527	subExprTokenPtr++;
1528	memcpy(subExprTokenPtr, tokenPtr,
1529	(size_t) toCopy * sizeof(Tcl_Token));
1530	parsePtr->numTokens += toCopy + 1;
1531	}
1532
1533	scanned = tokenPtr->start + tokenPtr->size - start;
1534	start +=scanned;
1535	numBytes -= scanned;
1536	tokenPtr += toCopy;
1537	break;
1538	}
1539
1540	default:
1541
1542	/* Advance to the child node, which is an operator. */
1543	nodePtr = nodes + next;
1544
1545	/* Skip any white space that comes before the subexpression */
1546	scanned = TclParseAllWhiteSpace(start, numBytes);
1547	start +=scanned;
1548	numBytes -= scanned;
1549
1550	/* Generate tokens for the operator / subexpression... */
1551	switch (nodePtr->lexeme) {
1552	case OPEN_PAREN:
1553	case COMMA:
1554	case COLON:
1555
1556	/*
1557	* Historical practice has been to have no Tcl_Tokens for
1558	* these operators.
1559	*/
1560
1561	break;
1562
1563	default: {
1564
1565	/*
1566	* Remember the index of the last subexpression we were
1567	* working on -- that of our parent. We'll stack it later.
1568	*/
1569
1570	parentIdx = subExprTokenIdx;
1571
1572	/*
1573	* Verify space for the two leading Tcl_Tokens representing
1574	* the subexpression rooted by this operator. The first
1575	* Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second
1576	* of type TCL_TOKEN_OPERATOR.
1577	*/
1578
1579	TclGrowParseTokenArray(parsePtr, 2);
1580	subExprTokenIdx = parsePtr->numTokens;
1581	subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
1582	parsePtr->numTokens += 2;
1583	subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
1584	subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR;
1585
1586	/*
1587	* Our current position scanning the string is the starting
1588	* point for this subexpression.
1589	*/
1590
1591	subExprTokenPtr->start = start;
1592
1593	/*
1594	* Eventually, we know that the numComponents field of the
1595	* Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means
1596	* we can make other use of this field for now to track the
1597	* stack of subexpressions we have pending.
1598	*/
1599
1600	subExprTokenPtr[1].numComponents = parentIdx;
1601	break;
1602	}
1603	}
1604	break;
1605	}
1606
1607	/* Determine which way to exit the node on this pass. */
1608	router:
1609	switch (nodePtr->mark) {
1610	case MARK_LEFT:
1611	next = nodePtr->left;
1612	break;
1613
1614	case MARK_RIGHT:
1615	next = nodePtr->right;
1616
1617	/* Skip any white space that comes before the operator */
1618	scanned = TclParseAllWhiteSpace(start, numBytes);
1619	start +=scanned;
1620	numBytes -= scanned;
1621
1622	/*
1623	* Here we scan from the string the operator corresponding to
1624	* nodePtr->lexeme.
1625	*/
1626
1627	scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
1628
1629	switch(nodePtr->lexeme) {
1630	case OPEN_PAREN:
1631	case COMMA:
1632	case COLON:
1633
1634	/* No tokens for these lexemes -> nothing to do. */
1635	break;
1636
1637	default:
1638
1639	/*
1640	* Record in the TCL_TOKEN_OPERATOR token the pointers into
1641	* the string marking where the operator is.
1642	*/
1643
1644	subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
1645	subExprTokenPtr[1].start = start;
1646	subExprTokenPtr[1].size = scanned;
1647	break;
1648	}
1649
1650	start +=scanned;
1651	numBytes -= scanned;
1652	break;
1653
1654	case MARK_PARENT:
1655	switch (nodePtr->lexeme) {
1656	case START:
1657
1658	/* When we get back to the START node, we're done. */
1659	return;
1660
1661	case COMMA:
1662	case COLON:
1663
1664	/* No tokens for these lexemes -> nothing to do. */
1665	break;
1666
1667	case OPEN_PAREN:
1668
1669	/* Skip past matching close paren. */
1670	scanned = TclParseAllWhiteSpace(start, numBytes);
1671	start +=scanned;
1672	numBytes -= scanned;
1673	scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
1674	start +=scanned;
1675	numBytes -= scanned;
1676	break;
1677
1678	default: {
1679
1680	/*
1681	* Before we leave this node/operator/subexpression for the
1682	* last time, finish up its tokens....
1683	*
1684	* Our current position scanning the string is where the
1685	* substring for the subexpression ends.
1686	*/
1687
1688	subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
1689	subExprTokenPtr->size = start - subExprTokenPtr->start;
1690
1691	/*
1692	* All the Tcl_Tokens allocated and filled belong to
1693	* this subexpresion. The first token is the leading
1694	* TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
1695	* are its components.
1696	*/
1697
1698	subExprTokenPtr->numComponents =
1699	(parsePtr->numTokens - subExprTokenIdx) - 1;
1700
1701	/*
1702	* Finally, as we return up the tree to our parent, pop the
1703	* parent subexpression off our subexpression stack, and
1704	* fill in the zero numComponents for the operator Tcl_Token.
1705	*/
1706
1707	parentIdx = subExprTokenPtr[1].numComponents;
1708	subExprTokenPtr[1].numComponents = 0;
1709	subExprTokenIdx = parentIdx;
1710	break;
1711	}
1712	}
1713
1714	/* Since we're returning to parent, skip child handling code. */
1715	nodePtr = nodes + nodePtr->p.parent;
1716	goto router;
1717	}
1718	}
1719	}
1720
1721	/*
1722	*----------------------------------------------------------------------
1723	*
1724	* Tcl_ParseExpr --
1725	*
1726	* Given a string, the numBytes bytes starting at start, this function
1727	* parses it as a Tcl expression and stores information about the
1728	* structure of the expression in the Tcl_Parse struct indicated by the
1729	* caller.
1730	*
1731	* Results:
1732	* If the string is successfully parsed as a valid Tcl expression, TCL_OK
1733	* is returned, and data about the expression structure is written to
1734	* *parsePtr. If the string cannot be parsed as a valid Tcl expression,
1735	* TCL_ERROR is returned, and if interp is non-NULL, an error message is
1736	* written to interp.
1737	*
1738	* Side effects:
1739	* If there is insufficient space in parsePtr to hold all the information
1740	* about the expression, then additional space is malloc-ed. If the
1741	* function returns TCL_OK then the caller must eventually invoke
1742	* Tcl_FreeParse to release any additional space that was allocated.
1743	*
1744	*----------------------------------------------------------------------
1745	*/
1746
1747	int
1748	Tcl_ParseExpr(
1749	Tcl_Interp interp, / Used for error reporting. */
1750	const char start, / Start of source string to parse. */
1751	int numBytes, /* Number of bytes in string. If < 0, the
1752	* string consists of all bytes up to the
1753	* first null character. */
1754	Tcl_Parse parsePtr) / Structure to fill with information about
1755	* the parsed expression; any previous
1756	* information in the structure is ignored. */
1757	{
1758	int code;
1759	OpNode opTree = NULL; / Will point to the tree of operators */
1760	Tcl_Obj litList = Tcl_NewObj(); / List to hold the literals */
1761	Tcl_Obj funcList = Tcl_NewObj(); / List to hold the functon names*/
1762	Tcl_Parse *exprParsePtr =
1763	(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
1764	/* Holds the Tcl_Tokens of substitutions */
1765
1766	if (numBytes < 0) {
1767	numBytes = (start ? strlen(start) : 0);
1768	}
1769
1770	code = ParseExpr(interp, start, numBytes, &opTree, litList,
1771	funcList, exprParsePtr, 1 /* parseOnly */);
1772	Tcl_DecrRefCount(funcList);
1773	Tcl_DecrRefCount(litList);
1774
1775	TclParseInit(interp, start, numBytes, parsePtr);
1776	if (code == TCL_OK) {
1777	ConvertTreeToTokens(start, numBytes,
1778	opTree, exprParsePtr->tokenPtr, parsePtr);
1779	} else {
1780	parsePtr->term = exprParsePtr->term;
1781	parsePtr->errorType = exprParsePtr->errorType;
1782	}
1783
1784	Tcl_FreeParse(exprParsePtr);
1785	TclStackFree(interp, exprParsePtr);
1786	ckfree((char *) opTree);
1787	return code;
1788	}
1789
1790	/*
1791	*----------------------------------------------------------------------
1792	*
1793	* ParseLexeme --
1794	*
1795	* Parse a single lexeme from the start of a string, scanning no more
1796	* than numBytes bytes.
1797	*
1798	* Results:
1799	* Returns the number of bytes scanned to produce the lexeme.
1800	*
1801	* Side effects:
1802	* Code identifying lexeme parsed is writen to *lexemePtr.
1803	*
1804	*----------------------------------------------------------------------
1805	*/
1806
1807	static int
1808	ParseLexeme(
1809	const char start, / Start of lexeme to parse. */
1810	int numBytes, /* Number of bytes in string. */
1811	unsigned char lexemePtr, / Write code of parsed lexeme to this
1812	* storage. */
1813	Tcl_Obj *literalPtr) / Write corresponding literal value to this
1814	storage, if non-NULL. */
1815	{
1816	const char *end;
1817	int scanned;
1818	Tcl_UniChar ch;
1819	Tcl_Obj *literal = NULL;
1820	unsigned char byte;
1821
1822	if (numBytes == 0) {
1823	*lexemePtr = END;
1824	return 0;
1825	}
1826	byte = (unsigned char)(*start);
1827	if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
1828	*lexemePtr = Lexeme[byte];
1829	return 1;
1830	}
1831	switch (byte) {
1832	case '*':
1833	if ((numBytes > 1) && (start[1] == '*')) {
1834	*lexemePtr = EXPON;
1835	return 2;
1836	}
1837	*lexemePtr = MULT;
1838	return 1;
1839
1840	case '=':
1841	if ((numBytes > 1) && (start[1] == '=')) {
1842	*lexemePtr = EQUAL;
1843	return 2;
1844	}
1845	*lexemePtr = INCOMPLETE;
1846	return 1;
1847
1848	case '!':
1849	if ((numBytes > 1) && (start[1] == '=')) {
1850	*lexemePtr = NEQ;
1851	return 2;
1852	}
1853	*lexemePtr = NOT;
1854	return 1;
1855
1856	case '&':
1857	if ((numBytes > 1) && (start[1] == '&')) {
1858	*lexemePtr = AND;
1859	return 2;
1860	}
1861	*lexemePtr = BIT_AND;
1862	return 1;
1863
1864	case '\|':
1865	if ((numBytes > 1) && (start[1] == '\|')) {
1866	*lexemePtr = OR;
1867	return 2;
1868	}
1869	*lexemePtr = BIT_OR;
1870	return 1;
1871
1872	case '<':
1873	if (numBytes > 1) {
1874	switch (start[1]) {
1875	case '<':
1876	*lexemePtr = LEFT_SHIFT;
1877	return 2;
1878	case '=':
1879	*lexemePtr = LEQ;
1880	return 2;
1881	}
1882	}
1883	*lexemePtr = LESS;
1884	return 1;
1885
1886	case '>':
1887	if (numBytes > 1) {
1888	switch (start[1]) {
1889	case '>':
1890	*lexemePtr = RIGHT_SHIFT;
1891	return 2;
1892	case '=':
1893	*lexemePtr = GEQ;
1894	return 2;
1895	}
1896	}
1897	*lexemePtr = GREATER;
1898	return 1;
1899
1900	case 'i':
1901	if ((numBytes > 1) && (start[1] == 'n')
1902	&& ((numBytes == 2) \|\| !isalpha(UCHAR(start[2])))) {
1903
1904	/*
1905	* Must make this check so we can tell the difference between
1906	* the "in" operator and the "int" function name and the
1907	* "infinity" numeric value.
1908	*/
1909
1910	*lexemePtr = IN_LIST;
1911	return 2;
1912	}
1913	break;
1914
1915	case 'e':
1916	if ((numBytes > 1) && (start[1] == 'q')
1917	&& ((numBytes == 2) \|\| !isalpha(UCHAR(start[2])))) {
1918	*lexemePtr = STREQ;
1919	return 2;
1920	}
1921	break;
1922
1923	case 'n':
1924	if ((numBytes > 1) && ((numBytes == 2) \|\| !isalpha(UCHAR(start[2])))) {
1925	switch (start[1]) {
1926	case 'e':
1927	*lexemePtr = STRNEQ;
1928	return 2;
1929	case 'i':
1930	*lexemePtr = NOT_IN_LIST;
1931	return 2;
1932	}
1933	}
1934	}
1935
1936	literal = Tcl_NewObj();
1937	if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
1938	TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
1939	TclInitStringRep(literal, start, end-start);
1940	*lexemePtr = NUMBER;
1941	if (literalPtr) {
1942	*literalPtr = literal;
1943	} else {
1944	Tcl_DecrRefCount(literal);
1945	}
1946	return (end-start);
1947	}
1948
1949	if (Tcl_UtfCharComplete(start, numBytes)) {
1950	scanned = Tcl_UtfToUniChar(start, &ch);
1951	} else {
1952	char utfBytes[TCL_UTF_MAX];
1953	memcpy(utfBytes, start, (size_t) numBytes);
1954	utfBytes[numBytes] = '\0';
1955	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
1956	}
1957	if (!isalpha(UCHAR(ch))) {
1958	*lexemePtr = INVALID;
1959	Tcl_DecrRefCount(literal);
1960	return scanned;
1961	}
1962	end = start;
1963	while (isalnum(UCHAR(ch)) \|\| (UCHAR(ch) == '_')) {
1964	end += scanned;
1965	numBytes -= scanned;
1966	if (Tcl_UtfCharComplete(end, numBytes)) {
1967	scanned = Tcl_UtfToUniChar(end, &ch);
1968	} else {
1969	char utfBytes[TCL_UTF_MAX];
1970	memcpy(utfBytes, end, (size_t) numBytes);
1971	utfBytes[numBytes] = '\0';
1972	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
1973	}
1974	}
1975	*lexemePtr = BAREWORD;
1976	if (literalPtr) {
1977	Tcl_SetStringObj(literal, start, (int) (end-start));
1978	*literalPtr = literal;
1979	} else {
1980	Tcl_DecrRefCount(literal);
1981	}
1982	return (end-start);
1983	}
1984
1985	/*
1986	*----------------------------------------------------------------------
1987	*
1988	* TclCompileExpr --
1989	*
1990	* This procedure compiles a string containing a Tcl expression into Tcl
1991	* bytecodes.
1992	*
1993	* Results:
1994	* None.
1995	*
1996	* Side effects:
1997	* Adds instructions to envPtr to evaluate the expression at runtime.
1998	*
1999	*----------------------------------------------------------------------
2000	*/
2001
2002	void
2003	TclCompileExpr(
2004	Tcl_Interp interp, / Used for error reporting. */
2005	const char script, / The source script to compile. */
2006	int numBytes, /* Number of bytes in script. */
2007	CompileEnv envPtr, / Holds resulting instructions. */
2008	int optimize) /* 0 for one-off expressions */
2009	{
2010	OpNode opTree = NULL; / Will point to the tree of operators */
2011	Tcl_Obj litList = Tcl_NewObj(); / List to hold the literals */
2012	Tcl_Obj funcList = Tcl_NewObj(); / List to hold the functon names*/
2013	Tcl_Parse *parsePtr =
2014	(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
2015	/* Holds the Tcl_Tokens of substitutions */
2016
2017	int code = ParseExpr(interp, script, numBytes, &opTree, litList,
2018	funcList, parsePtr, 0 /* parseOnly */);
2019
2020	if (code == TCL_OK) {
2021
2022	/* Valid parse; compile the tree. */
2023	int objc;
2024	Tcl_Obj const litObjv;
2025	Tcl_Obj **funcObjv;
2026
2027	/* TIP #280 : Track Lines within the expression */
2028	TclAdvanceLines(&envPtr->line, script,
2029	script + TclParseAllWhiteSpace(script, numBytes));
2030
2031	TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
2032	TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
2033	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
2034	parsePtr->tokenPtr, envPtr, optimize);
2035	} else {
2036	TclCompileSyntaxError(interp, envPtr);
2037	}
2038
2039	Tcl_FreeParse(parsePtr);
2040	TclStackFree(interp, parsePtr);
2041	Tcl_DecrRefCount(funcList);
2042	Tcl_DecrRefCount(litList);
2043	ckfree((char *) opTree);
2044	}
2045
2046	/*
2047	*----------------------------------------------------------------------
2048	*
2049	* ExecConstantExprTree --
2050	* Compiles and executes bytecode for the subexpression tree at index
2051	* in the nodes array. This subexpression must be constant, made up
2052	* of only constant operators (not functions) and literals.
2053	*
2054	* Results:
2055	* A standard Tcl return code and result left in interp.
2056	*
2057	* Side effects:
2058	* Consumes subtree of nodes rooted at index. Advances the pointer
2059	* *litObjvPtr.
2060	*
2061	*----------------------------------------------------------------------
2062	*/
2063
2064	static int
2065	ExecConstantExprTree(
2066	Tcl_Interp *interp,
2067	OpNode *nodes,
2068	int index,
2069	Tcl_Obj const *litObjvPtr)
2070	{
2071	CompileEnv *envPtr;
2072	ByteCode *byteCodePtr;
2073	int code;
2074	Tcl_Obj *byteCodeObj = Tcl_NewObj();
2075
2076	/*
2077	* Note we are compiling an expression with literal arguments. This means
2078	* there can be no [info frame] calls when we execute the resulting
2079	* bytecode, so there's no need to tend to TIP 280 issues.
2080	*/
2081
2082	envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv));
2083	TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
2084	CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
2085	0 /* optimize */);
2086	TclEmitOpcode(INST_DONE, envPtr);
2087	Tcl_IncrRefCount(byteCodeObj);
2088	TclInitByteCodeObj(byteCodeObj, envPtr);
2089	TclFreeCompileEnv(envPtr);
2090	TclStackFree(interp, envPtr);
2091	byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
2092	code = TclExecuteByteCode(interp, byteCodePtr);
2093	Tcl_DecrRefCount(byteCodeObj);
2094	return code;
2095	}
2096
2097	/*
2098	*----------------------------------------------------------------------
2099	*
2100	* CompileExprTree --
2101	* Compiles and writes to envPtr instructions for the subexpression
2102	* tree at index in the nodes array. (*litObjvPtr) must point to the
2103	* proper location in a corresponding literals list. Likewise, when
2104	* non-NULL, funcObjv and tokenPtr must point into matching arrays of
2105	* function names and Tcl_Token's derived from earlier call to
2106	* ParseExpr(). When optimize is true, any constant subexpressions
2107	* will be precomputed.
2108	*
2109	* Results:
2110	* None.
2111	*
2112	* Side effects:
2113	* Adds instructions to envPtr to evaluate the expression at runtime.
2114	* Consumes subtree of nodes rooted at index. Advances the pointer
2115	* *litObjvPtr.
2116	*
2117	*----------------------------------------------------------------------
2118	*/
2119
2120	static void
2121	CompileExprTree(
2122	Tcl_Interp *interp,
2123	OpNode *nodes,
2124	int index,
2125	Tcl_Obj const *litObjvPtr,
2126	Tcl_Obj const funcObjv,
2127	Tcl_Token *tokenPtr,
2128	CompileEnv *envPtr,
2129	int optimize)
2130	{
2131	OpNode *nodePtr = nodes + index;
2132	OpNode *rootPtr = nodePtr;
2133	int numWords = 0;
2134	JumpList *jumpPtr = NULL;
2135	int convert = 1;
2136
2137	while (1) {
2138	int next;
2139	JumpList freePtr, newJump;
2140
2141	if (nodePtr->mark == MARK_LEFT) {
2142	next = nodePtr->left;
2143
2144	switch (nodePtr->lexeme) {
2145	case QUESTION:
2146	newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
2147	newJump->next = jumpPtr;
2148	jumpPtr = newJump;
2149	newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
2150	newJump->next = jumpPtr;
2151	jumpPtr = newJump;
2152	jumpPtr->depth = envPtr->currStackDepth;
2153	convert = 1;
2154	break;
2155	case AND:
2156	case OR:
2157	newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
2158	newJump->next = jumpPtr;
2159	jumpPtr = newJump;
2160	newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
2161	newJump->next = jumpPtr;
2162	jumpPtr = newJump;
2163	newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
2164	newJump->next = jumpPtr;
2165	jumpPtr = newJump;
2166	jumpPtr->depth = envPtr->currStackDepth;
2167	break;
2168	}
2169	} else if (nodePtr->mark == MARK_RIGHT) {
2170	next = nodePtr->right;
2171
2172	switch (nodePtr->lexeme) {
2173	case FUNCTION: {
2174	Tcl_DString cmdName;
2175	const char *p;
2176	int length;
2177
2178	Tcl_DStringInit(&cmdName);
2179	Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
2180	p = TclGetStringFromObj(*funcObjv, &length);
2181	funcObjv++;
2182	Tcl_DStringAppend(&cmdName, p, length);
2183	TclEmitPush(TclRegisterNewNSLiteral(envPtr,
2184	Tcl_DStringValue(&cmdName),
2185	Tcl_DStringLength(&cmdName)), envPtr);
2186	Tcl_DStringFree(&cmdName);
2187
2188	/*
2189	* Start a count of the number of words in this function
2190	* command invocation. In case there's already a count
2191	* in progress (nested functions), save it in our unused
2192	* "left" field for restoring later.
2193	*/
2194
2195	nodePtr->left = numWords;
2196	numWords = 2; /* Command plus one argument */
2197	break;
2198	}
2199	case QUESTION:
2200	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
2201	break;
2202	case COLON:
2203	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
2204	&(jumpPtr->next->jump));
2205	envPtr->currStackDepth = jumpPtr->depth;
2206	jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
2207	jumpPtr->convert = convert;
2208	convert = 1;
2209	break;
2210	case AND:
2211	TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
2212	break;
2213	case OR:
2214	TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
2215	break;
2216	}
2217	} else {
2218	switch (nodePtr->lexeme) {
2219	case START:
2220	case QUESTION:
2221	if (convert && (nodePtr == rootPtr)) {
2222	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
2223	}
2224	break;
2225	case OPEN_PAREN:
2226
2227	/* do nothing */
2228	break;
2229	case FUNCTION:
2230
2231	/*
2232	* Use the numWords count we've kept to invoke the
2233	* function command with the correct number of arguments.
2234	*/
2235
2236	if (numWords < 255) {
2237	TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
2238	} else {
2239	TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
2240	}
2241
2242	/* Restore any saved numWords value. */
2243	numWords = nodePtr->left;
2244	convert = 1;
2245	break;
2246	case COMMA:
2247
2248	/* Each comma implies another function argument. */
2249	numWords++;
2250	break;
2251	case COLON:
2252	if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
2253	(envPtr->codeNext - envPtr->codeStart)
2254	- jumpPtr->next->jump.codeOffset, 127)) {
2255	jumpPtr->offset += 3;
2256	}
2257	TclFixupForwardJump(envPtr, &(jumpPtr->jump),
2258	jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
2259	convert \|= jumpPtr->convert;
2260	envPtr->currStackDepth = jumpPtr->depth + 1;
2261	freePtr = jumpPtr;
2262	jumpPtr = jumpPtr->next;
2263	TclStackFree(interp, freePtr);
2264	freePtr = jumpPtr;
2265	jumpPtr = jumpPtr->next;
2266	TclStackFree(interp, freePtr);
2267	break;
2268	case AND:
2269	case OR:
2270	TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
2271	? TCL_FALSE_JUMP : TCL_TRUE_JUMP,
2272	&(jumpPtr->next->jump));
2273	TclEmitPush(TclRegisterNewLiteral(envPtr,
2274	(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
2275	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
2276	&(jumpPtr->next->next->jump));
2277	TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
2278	if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
2279	jumpPtr->next->next->jump.codeOffset += 3;
2280	}
2281	TclEmitPush(TclRegisterNewLiteral(envPtr,
2282	(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
2283	TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
2284	127);
2285	convert = 0;
2286	envPtr->currStackDepth = jumpPtr->depth + 1;
2287	freePtr = jumpPtr;
2288	jumpPtr = jumpPtr->next;
2289	TclStackFree(interp, freePtr);
2290	freePtr = jumpPtr;
2291	jumpPtr = jumpPtr->next;
2292	TclStackFree(interp, freePtr);
2293	freePtr = jumpPtr;
2294	jumpPtr = jumpPtr->next;
2295	TclStackFree(interp, freePtr);
2296	break;
2297	default:
2298	TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
2299	convert = 0;
2300	break;
2301	}
2302	if (nodePtr == rootPtr) {
2303
2304	/* We're done */
2305	return;
2306	}
2307	nodePtr = nodes + nodePtr->p.parent;
2308	continue;
2309	}
2310
2311	nodePtr->mark++;
2312	switch (next) {
2313	case OT_EMPTY:
2314	numWords = 1; /* No arguments, so just the command */
2315	break;
2316	case OT_LITERAL: {
2317	Tcl_Obj const litObjv = *litObjvPtr;
2318	Tcl_Obj literal = litObjv;
2319
2320	if (optimize) {
2321	int length, index;
2322	const char *bytes = TclGetStringFromObj(literal, &length);
2323	LiteralEntry *lePtr;
2324	Tcl_Obj *objPtr;
2325
2326	index = TclRegisterNewLiteral(envPtr, bytes, length);
2327	lePtr = envPtr->literalArrayPtr + index;
2328	objPtr = lePtr->objPtr;
2329	if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
2330	/*
2331	* Would like to do this:
2332	*
2333	* lePtr->objPtr = literal;
2334	* Tcl_IncrRefCount(literal);
2335	* Tcl_DecrRefCount(objPtr);
2336	*
2337	* However, the design of the "global" and "local"
2338	* LiteralTable does not permit the value of lePtr->objPtr
2339	* to change. So rather than replace lePtr->objPtr, we
2340	* do surgery to transfer our desired intrep into it.
2341	*
2342	*/
2343	objPtr->typePtr = literal->typePtr;
2344	objPtr->internalRep = literal->internalRep;
2345	literal->typePtr = NULL;
2346	}
2347	TclEmitPush(index, envPtr);
2348	} else {
2349	/*
2350	* When optimize==0, we know the expression is a one-off
2351	* and there's nothing to be gained from sharing literals
2352	* when they won't live long, and the copies we have already
2353	* have an appropriate intrep. In this case, skip literal
2354	* registration that would enable sharing, and use the routine
2355	* that preserves intreps.
2356	*/
2357	TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
2358	}
2359	(*litObjvPtr)++;
2360	break;
2361	}
2362	case OT_TOKENS:
2363	TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
2364	envPtr);
2365	tokenPtr += tokenPtr->numComponents + 1;
2366	break;
2367	default:
2368	if (optimize && nodes[next].constant) {
2369	Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);
2370	if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
2371	== TCL_OK) {
2372	TclEmitPush(TclAddLiteralObj(envPtr,
2373	Tcl_GetObjResult(interp), NULL), envPtr);
2374	} else {
2375	TclCompileSyntaxError(interp, envPtr);
2376	}
2377	Tcl_RestoreInterpState(interp, save);
2378	convert = 0;
2379	} else {
2380	nodePtr = nodes + next;
2381	}
2382	}
2383	}
2384	}
2385
2386	/*
2387	*----------------------------------------------------------------------
2388	*
2389	* TclSingleOpCmd --
2390	* Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
2391	* in the ::tcl::mathop namespace. These commands have no
2392	* extension to arbitrary arguments; they accept only exactly one
2393	* or exactly two arguments as suitable for the operator.
2394	*
2395	* Results:
2396	* A standard Tcl return code and result left in interp.
2397	*
2398	* Side effects:
2399	* None.
2400	*
2401	*----------------------------------------------------------------------
2402	*/
2403
2404	int
2405	TclSingleOpCmd(
2406	ClientData clientData,
2407	Tcl_Interp *interp,
2408	int objc,
2409	Tcl_Obj *const objv[])
2410	{
2411	TclOpCmdClientData occdPtr = (TclOpCmdClientData )clientData;
2412	unsigned char lexeme;
2413	OpNode nodes[2];
2414	Tcl_Obj const litObjv = objv + 1;
2415
2416	if (objc != 1+occdPtr->i.numArgs) {
2417	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
2418	return TCL_ERROR;
2419	}
2420
2421	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
2422	nodes[0].lexeme = START;
2423	nodes[0].mark = MARK_RIGHT;
2424	nodes[0].right = 1;
2425	nodes[1].lexeme = lexeme;
2426	if (objc == 2) {
2427	nodes[1].mark = MARK_RIGHT;
2428	} else {
2429	nodes[1].mark = MARK_LEFT;
2430	nodes[1].left = OT_LITERAL;
2431	}
2432	nodes[1].right = OT_LITERAL;
2433	nodes[1].p.parent = 0;
2434
2435	return ExecConstantExprTree(interp, nodes, 0, &litObjv);
2436	}
2437
2438	/*
2439	*----------------------------------------------------------------------
2440	*
2441	* TclSortingOpCmd --
2442	* Implements the commands: <, <=, >, >=, ==, eq
2443	* in the ::tcl::mathop namespace. These commands are defined for
2444	* arbitrary number of arguments by computing the AND of the base
2445	* operator applied to all neighbor argument pairs.
2446	*
2447	* Results:
2448	* A standard Tcl return code and result left in interp.
2449	*
2450	* Side effects:
2451	* None.
2452	*
2453	*----------------------------------------------------------------------
2454	*/
2455
2456	int
2457	TclSortingOpCmd(
2458	ClientData clientData,
2459	Tcl_Interp *interp,
2460	int objc,
2461	Tcl_Obj *const objv[])
2462	{
2463	int code = TCL_OK;
2464
2465	if (objc < 3) {
2466	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
2467	} else {
2468	TclOpCmdClientData occdPtr = (TclOpCmdClientData )clientData;
2469	Tcl_Obj litObjv = (Tcl_Obj ) TclStackAlloc(interp,
2470	2(objc-2)sizeof(Tcl_Obj *));
2471	OpNode nodes = (OpNode ) TclStackAlloc(interp,
2472	2(objc-2)sizeof(OpNode));
2473	unsigned char lexeme;
2474	int i, lastAnd = 1;
2475	Tcl_Obj const litObjPtrPtr = litObjv;
2476
2477	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
2478
2479	litObjv[0] = objv[1];
2480	nodes[0].lexeme = START;
2481	nodes[0].mark = MARK_RIGHT;
2482	for (i=2; i<objc-1; i++) {
2483	litObjv[2*(i-1)-1] = objv[i];
2484	nodes[2*(i-1)-1].lexeme = lexeme;
2485	nodes[2*(i-1)-1].mark = MARK_LEFT;
2486	nodes[2*(i-1)-1].left = OT_LITERAL;
2487	nodes[2*(i-1)-1].right = OT_LITERAL;
2488
2489	litObjv[2*(i-1)] = objv[i];
2490	nodes[2*(i-1)].lexeme = AND;
2491	nodes[2*(i-1)].mark = MARK_LEFT;
2492	nodes[2*(i-1)].left = lastAnd;
2493	nodes[lastAnd].p.parent = 2*(i-1);
2494
2495	nodes[2(i-1)].right = 2(i-1)+1;
2496	nodes[2(i-1)+1].p.parent= 2(i-1);
2497
2498	lastAnd = 2*(i-1);
2499	}
2500	litObjv[2*(objc-2)-1] = objv[objc-1];
2501
2502	nodes[2*(objc-2)-1].lexeme = lexeme;
2503	nodes[2*(objc-2)-1].mark = MARK_LEFT;
2504	nodes[2*(objc-2)-1].left = OT_LITERAL;
2505	nodes[2*(objc-2)-1].right = OT_LITERAL;
2506
2507	nodes[0].right = lastAnd;
2508	nodes[lastAnd].p.parent = 0;
2509
2510	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
2511
2512	TclStackFree(interp, nodes);
2513	TclStackFree(interp, litObjv);
2514	}
2515	return code;
2516	}
2517
2518	/*
2519	*----------------------------------------------------------------------
2520	*
2521	* TclVariadicOpCmd --
2522	* Implements the commands: +, , &, \|, ^, *
2523	* in the ::tcl::mathop namespace. These commands are defined for
2524	* arbitrary number of arguments by repeatedly applying the base
2525	* operator with suitable associative rules. When fewer than two
2526	* arguments are provided, suitable identity values are returned.
2527	*
2528	* Results:
2529	* A standard Tcl return code and result left in interp.
2530	*
2531	* Side effects:
2532	* None.
2533	*
2534	*----------------------------------------------------------------------
2535	*/
2536
2537	int
2538	TclVariadicOpCmd(
2539	ClientData clientData,
2540	Tcl_Interp *interp,
2541	int objc,
2542	Tcl_Obj *const objv[])
2543	{
2544	TclOpCmdClientData occdPtr = (TclOpCmdClientData )clientData;
2545	unsigned char lexeme;
2546	int code;
2547
2548	if (objc < 2) {
2549	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
2550	return TCL_OK;
2551	}
2552
2553	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
2554	lexeme \|= BINARY;
2555
2556	if (objc == 2) {
2557	Tcl_Obj *litObjv[2];
2558	OpNode nodes[2];
2559	int decrMe = 0;
2560	Tcl_Obj const litObjPtrPtr = litObjv;
2561
2562	if (lexeme == EXPON) {
2563	litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
2564	Tcl_IncrRefCount(litObjv[1]);
2565	decrMe = 1;
2566	litObjv[0] = objv[1];
2567	nodes[0].lexeme = START;
2568	nodes[0].mark = MARK_RIGHT;
2569	nodes[0].right = 1;
2570	nodes[1].lexeme = lexeme;
2571	nodes[1].mark = MARK_LEFT;
2572	nodes[1].left = OT_LITERAL;
2573	nodes[1].right = OT_LITERAL;
2574	nodes[1].p.parent = 0;
2575	} else {
2576	if (lexeme == DIVIDE) {
2577	litObjv[0] = Tcl_NewDoubleObj(1.0);
2578	} else {
2579	litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
2580	}
2581	Tcl_IncrRefCount(litObjv[0]);
2582	litObjv[1] = objv[1];
2583	nodes[0].lexeme = START;
2584	nodes[0].mark = MARK_RIGHT;
2585	nodes[0].right = 1;
2586	nodes[1].lexeme = lexeme;
2587	nodes[1].mark = MARK_LEFT;
2588	nodes[1].left = OT_LITERAL;
2589	nodes[1].right = OT_LITERAL;
2590	nodes[1].p.parent = 0;
2591	}
2592
2593	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
2594
2595	Tcl_DecrRefCount(litObjv[decrMe]);
2596	return code;
2597	} else {
2598	Tcl_Obj const litObjv = objv + 1;
2599	OpNode nodes = (OpNode ) TclStackAlloc(interp,
2600	(objc-1)*sizeof(OpNode));
2601	int i, lastOp = OT_LITERAL;
2602
2603	nodes[0].lexeme = START;
2604	nodes[0].mark = MARK_RIGHT;
2605	if (lexeme == EXPON) {
2606	for (i=objc-2; i>0; i-- ) {
2607	nodes[i].lexeme = lexeme;
2608	nodes[i].mark = MARK_LEFT;
2609	nodes[i].left = OT_LITERAL;
2610	nodes[i].right = lastOp;
2611	if (lastOp >= 0) {
2612	nodes[lastOp].p.parent = i;
2613	}
2614	lastOp = i;
2615	}
2616	} else {
2617	for (i=1; i<objc-1; i++ ) {
2618	nodes[i].lexeme = lexeme;
2619	nodes[i].mark = MARK_LEFT;
2620	nodes[i].left = lastOp;
2621	if (lastOp >= 0) {
2622	nodes[lastOp].p.parent = i;
2623	}
2624	nodes[i].right = OT_LITERAL;
2625	lastOp = i;
2626	}
2627	}
2628	nodes[0].right = lastOp;
2629	nodes[lastOp].p.parent = 0;
2630
2631	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
2632
2633	TclStackFree(interp, nodes);
2634
2635	return code;
2636	}
2637	}
2638
2639	/*
2640	*----------------------------------------------------------------------
2641	*
2642	* TclNoIdentOpCmd --
2643	* Implements the commands: -, /
2644	* in the ::tcl::mathop namespace. These commands are defined for
2645	* arbitrary non-zero number of arguments by repeatedly applying
2646	* the base operator with suitable associative rules. When no
2647	* arguments are provided, an error is raised.
2648	*
2649	* Results:
2650	* A standard Tcl return code and result left in interp.
2651	*
2652	* Side effects:
2653	* None.
2654	*
2655	*----------------------------------------------------------------------
2656	*/
2657
2658	int
2659	TclNoIdentOpCmd(
2660	ClientData clientData,
2661	Tcl_Interp *interp,
2662	int objc,
2663	Tcl_Obj *const objv[])
2664	{
2665	TclOpCmdClientData occdPtr = (TclOpCmdClientData )clientData;
2666	if (objc < 2) {
2667	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
2668	return TCL_ERROR;
2669	}
2670	return TclVariadicOpCmd(clientData, interp, objc, objv);
2671	}
2672	/*
2673	* Local Variables:
2674	* mode: c
2675	* c-basic-offset: 4
2676	* fill-column: 78
2677	* End:
2678	*/

Note: See TracBrowser for help on using the repository browser.

Download in other formats: