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

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclcompexpr.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 67 - (show annotations) (download)
Mon Oct 31 00:57:34 2016 UTC (6 years, 3 months ago) by dashley
File MIME type: text/plain
File size: 32854 byte(s)
Header and footer cleanup.
1 /* $Header$ */
2 /*
3 * tclCompExpr.c --
4 *
5 * This file contains the code to compile Tcl expressions.
6 *
7 * Copyright (c) 1997 Sun Microsystems, Inc.
8 *
9 * See the file "license.terms" for information on usage and redistribution
10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11 *
12 * RCS: @(#) $Id: tclcompexpr.c,v 1.1.1.1 2001/06/13 04:35:43 dtashley Exp $
13 */
14
15 #include "tclInt.h"
16 #include "tclCompile.h"
17
18 /*
19 * The stuff below is a bit of a hack so that this file can be used in
20 * environments that include no UNIX, i.e. no errno: just arrange to use
21 * the errno from tclExecute.c here.
22 */
23
24 #ifndef TCL_GENERIC_ONLY
25 #include "tclPort.h"
26 #else
27 #define NO_ERRNO_H
28 #endif
29
30 #ifdef NO_ERRNO_H
31 extern int errno; /* Use errno from tclExecute.c. */
32 #define ERANGE 34
33 #endif
34
35 /*
36 * Boolean variable that controls whether expression compilation tracing
37 * is enabled.
38 */
39
40 #ifdef TCL_COMPILE_DEBUG
41 static int traceExprComp = 0;
42 #endif /* TCL_COMPILE_DEBUG */
43
44 /*
45 * The ExprInfo structure describes the state of compiling an expression.
46 * A pointer to an ExprInfo record is passed among the routines in
47 * this module.
48 */
49
50 typedef struct ExprInfo {
51 Tcl_Interp *interp; /* Used for error reporting. */
52 Tcl_Parse *parsePtr; /* Structure filled with information about
53 * the parsed expression. */
54 char *expr; /* The expression that was originally passed
55 * to TclCompileExpr. */
56 char *lastChar; /* Points just after last byte of expr. */
57 int hasOperators; /* Set 1 if the expr has operators; 0 if
58 * expr is only a primary. If 1 after
59 * compiling an expr, a tryCvtToNumeric
60 * instruction is emitted to convert the
61 * primary to a number if possible. */
62 int exprIsJustVarRef; /* Set 1 if the expr consists of just a
63 * variable reference as in the expression
64 * of "if $b then...". Otherwise 0. If 1 the
65 * expr is compiled out-of-line in order to
66 * implement expr's 2 level substitution
67 * semantics properly. */
68 int exprIsComparison; /* Set 1 if the top-level operator in the
69 * expr is a comparison. Otherwise 0. If 1,
70 * because the operands might be strings,
71 * the expr is compiled out-of-line in order
72 * to implement expr's 2 level substitution
73 * semantics properly. */
74 } ExprInfo;
75
76 /*
77 * Definitions of numeric codes representing each expression operator.
78 * The order of these must match the entries in the operatorTable below.
79 * Also the codes for the relational operators (OP_LESS, OP_GREATER,
80 * OP_LE, OP_GE, OP_EQ, and OP_NE) must be consecutive and in that order.
81 * Note that OP_PLUS and OP_MINUS represent both unary and binary operators.
82 */
83
84 #define OP_MULT 0
85 #define OP_DIVIDE 1
86 #define OP_MOD 2
87 #define OP_PLUS 3
88 #define OP_MINUS 4
89 #define OP_LSHIFT 5
90 #define OP_RSHIFT 6
91 #define OP_LESS 7
92 #define OP_GREATER 8
93 #define OP_LE 9
94 #define OP_GE 10
95 #define OP_EQ 11
96 #define OP_NEQ 12
97 #define OP_BITAND 13
98 #define OP_BITXOR 14
99 #define OP_BITOR 15
100 #define OP_LAND 16
101 #define OP_LOR 17
102 #define OP_QUESTY 18
103 #define OP_LNOT 19
104 #define OP_BITNOT 20
105
106 /*
107 * Table describing the expression operators. Entries in this table must
108 * correspond to the definitions of numeric codes for operators just above.
109 */
110
111 static int opTableInitialized = 0; /* 0 means not yet initialized. */
112
113 TCL_DECLARE_MUTEX(opMutex)
114
115 typedef struct OperatorDesc {
116 char *name; /* Name of the operator. */
117 int numOperands; /* Number of operands. 0 if the operator
118 * requires special handling. */
119 int instruction; /* Instruction opcode for the operator.
120 * Ignored if numOperands is 0. */
121 } OperatorDesc;
122
123 OperatorDesc operatorTable[] = {
124 {"*", 2, INST_MULT},
125 {"/", 2, INST_DIV},
126 {"%", 2, INST_MOD},
127 {"+", 0},
128 {"-", 0},
129 {"<<", 2, INST_LSHIFT},
130 {">>", 2, INST_RSHIFT},
131 {"<", 2, INST_LT},
132 {">", 2, INST_GT},
133 {"<=", 2, INST_LE},
134 {">=", 2, INST_GE},
135 {"==", 2, INST_EQ},
136 {"!=", 2, INST_NEQ},
137 {"&", 2, INST_BITAND},
138 {"^", 2, INST_BITXOR},
139 {"|", 2, INST_BITOR},
140 {"&&", 0},
141 {"||", 0},
142 {"?", 0},
143 {"!", 1, INST_LNOT},
144 {"~", 1, INST_BITNOT},
145 {NULL}
146 };
147
148 /*
149 * Hashtable used to map the names of expression operators to the index
150 * of their OperatorDesc description.
151 */
152
153 static Tcl_HashTable opHashTable;
154
155 /*
156 * Declarations for local procedures to this file:
157 */
158
159 static int CompileCondExpr _ANSI_ARGS_((
160 Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
161 CompileEnv *envPtr, Tcl_Token **endPtrPtr));
162 static int CompileLandOrLorExpr _ANSI_ARGS_((
163 Tcl_Token *exprTokenPtr, int opIndex,
164 ExprInfo *infoPtr, CompileEnv *envPtr,
165 Tcl_Token **endPtrPtr));
166 static int CompileMathFuncCall _ANSI_ARGS_((
167 Tcl_Token *exprTokenPtr, char *funcName,
168 ExprInfo *infoPtr, CompileEnv *envPtr,
169 Tcl_Token **endPtrPtr));
170 static int CompileSubExpr _ANSI_ARGS_((
171 Tcl_Token *exprTokenPtr, ExprInfo *infoPtr,
172 CompileEnv *envPtr));
173 static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
174
175 /*
176 * Macro used to debug the execution of the expression compiler.
177 */
178
179 #ifdef TCL_COMPILE_DEBUG
180 #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength) \
181 if (traceExprComp) { \
182 fprintf(stderr, "CompileSubExpr: \"%.*s\", token \"%.*s\"\n", \
183 (exprLength), (exprBytes), (tokenLength), (tokenBytes)); \
184 }
185 #else
186 #define TRACE(exprBytes, exprLength, tokenBytes, tokenLength)
187 #endif /* TCL_COMPILE_DEBUG */
188
189 /*
190 *----------------------------------------------------------------------
191 *
192 * TclCompileExpr --
193 *
194 * This procedure compiles a string containing a Tcl expression into
195 * Tcl bytecodes. This procedure is the top-level interface to the
196 * the expression compilation module, and is used by such public
197 * procedures as Tcl_ExprString, Tcl_ExprStringObj, Tcl_ExprLong,
198 * Tcl_ExprDouble, Tcl_ExprBoolean, and Tcl_ExprBooleanObj.
199 *
200 * Results:
201 * The return value is TCL_OK on a successful compilation and TCL_ERROR
202 * on failure. If TCL_ERROR is returned, then the interpreter's result
203 * contains an error message.
204 *
205 * envPtr->maxStackDepth is updated with the maximum number of stack
206 * elements needed to execute the expression.
207 *
208 * envPtr->exprIsJustVarRef is set 1 if the expression consisted of
209 * a single variable reference as in the expression of "if $b then...".
210 * Otherwise it is set 0. This is used to implement Tcl's two level
211 * expression substitution semantics properly.
212 *
213 * envPtr->exprIsComparison is set 1 if the top-level operator in the
214 * expr is a comparison. Otherwise it is set 0. If 1, because the
215 * operands might be strings, the expr is compiled out-of-line in order
216 * to implement expr's 2 level substitution semantics properly.
217 *
218 * Side effects:
219 * Adds instructions to envPtr to evaluate the expression at runtime.
220 *
221 *----------------------------------------------------------------------
222 */
223
224 int
225 TclCompileExpr(interp, script, numBytes, envPtr)
226 Tcl_Interp *interp; /* Used for error reporting. */
227 char *script; /* The source script to compile. */
228 int numBytes; /* Number of bytes in script. If < 0, the
229 * string consists of all bytes up to the
230 * first null character. */
231 CompileEnv *envPtr; /* Holds resulting instructions. */
232 {
233 ExprInfo info;
234 Tcl_Parse parse;
235 Tcl_HashEntry *hPtr;
236 int maxDepth, new, i, code;
237
238 /*
239 * If this is the first time we've been called, initialize the table
240 * of expression operators.
241 */
242
243 if (numBytes < 0) {
244 numBytes = (script? strlen(script) : 0);
245 }
246 if (!opTableInitialized) {
247 Tcl_MutexLock(&opMutex);
248 if (!opTableInitialized) {
249 Tcl_InitHashTable(&opHashTable, TCL_STRING_KEYS);
250 for (i = 0; operatorTable[i].name != NULL; i++) {
251 hPtr = Tcl_CreateHashEntry(&opHashTable,
252 operatorTable[i].name, &new);
253 if (new) {
254 Tcl_SetHashValue(hPtr, (ClientData) i);
255 }
256 }
257 opTableInitialized = 1;
258 }
259 Tcl_MutexUnlock(&opMutex);
260 }
261
262 /*
263 * Initialize the structure containing information abvout this
264 * expression compilation.
265 */
266
267 info.interp = interp;
268 info.parsePtr = &parse;
269 info.expr = script;
270 info.lastChar = (script + numBytes);
271 info.hasOperators = 0;
272 info.exprIsJustVarRef = 1; /* will be set 0 if anything else is seen */
273 info.exprIsComparison = 0;
274
275 /*
276 * Parse the expression then compile it.
277 */
278
279 maxDepth = 0;
280 code = Tcl_ParseExpr(interp, script, numBytes, &parse);
281 if (code != TCL_OK) {
282 goto done;
283 }
284
285 code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
286 if (code != TCL_OK) {
287 Tcl_FreeParse(&parse);
288 goto done;
289 }
290 maxDepth = envPtr->maxStackDepth;
291
292 if (!info.hasOperators) {
293 /*
294 * Attempt to convert the primary's object to an int or double.
295 * This is done in order to support Tcl's policy of interpreting
296 * operands if at all possible as first integers, else
297 * floating-point numbers.
298 */
299
300 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
301 }
302 Tcl_FreeParse(&parse);
303
304 done:
305 envPtr->maxStackDepth = maxDepth;
306 envPtr->exprIsJustVarRef = info.exprIsJustVarRef;
307 envPtr->exprIsComparison = info.exprIsComparison;
308 return code;
309 }
310
311 /*
312 *----------------------------------------------------------------------
313 *
314 * TclFinalizeCompilation --
315 *
316 * Clean up the compilation environment so it can later be
317 * properly reinitialized. This procedure is called by
318 * TclFinalizeCompExecEnv() in tclObj.c, which in turn is called
319 * by Tcl_Finalize().
320 *
321 * Results:
322 * None.
323 *
324 * Side effects:
325 * Cleans up the compilation environment. At the moment, just the
326 * table of expression operators is freed.
327 *
328 *----------------------------------------------------------------------
329 */
330
331 void
332 TclFinalizeCompilation()
333 {
334 Tcl_MutexLock(&opMutex);
335 if (opTableInitialized) {
336 Tcl_DeleteHashTable(&opHashTable);
337 opTableInitialized = 0;
338 }
339 Tcl_MutexUnlock(&opMutex);
340 }
341
342 /*
343 *----------------------------------------------------------------------
344 *
345 * CompileSubExpr --
346 *
347 * Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
348 * subexpression, this procedure emits instructions to evaluate the
349 * subexpression at runtime.
350 *
351 * Results:
352 * The return value is TCL_OK on a successful compilation and TCL_ERROR
353 * on failure. If TCL_ERROR is returned, then the interpreter's result
354 * contains an error message.
355 *
356 * envPtr->maxStackDepth is updated with the maximum number of stack
357 * elements needed to execute the subexpression.
358 *
359 * envPtr->exprIsJustVarRef is set 1 if the subexpression consisted of
360 * a single variable reference as in the expression of "if $b then...".
361 * Otherwise it is set 0. This is used to implement Tcl's two level
362 * expression substitution semantics properly.
363 *
364 * envPtr->exprIsComparison is set 1 if the top-level operator in the
365 * subexpression is a comparison. Otherwise it is set 0. If 1, because
366 * the operands might be strings, the expr is compiled out-of-line in
367 * order to implement expr's 2 level substitution semantics properly.
368 *
369 * Side effects:
370 * Adds instructions to envPtr to evaluate the subexpression.
371 *
372 *----------------------------------------------------------------------
373 */
374
375 static int
376 CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
377 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
378 * to compile. */
379 ExprInfo *infoPtr; /* Describes the compilation state for the
380 * expression being compiled. */
381 CompileEnv *envPtr; /* Holds resulting instructions. */
382 {
383 Tcl_Interp *interp = infoPtr->interp;
384 Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
385 OperatorDesc *opDescPtr;
386 Tcl_HashEntry *hPtr;
387 char *operator;
388 char savedChar;
389 int maxDepth, objIndex, opIndex, length, code;
390 char buffer[TCL_UTF_MAX];
391
392 if (exprTokenPtr->type != TCL_TOKEN_SUB_EXPR) {
393 panic("CompileSubExpr: token type %d not TCL_TOKEN_SUB_EXPR\n",
394 exprTokenPtr->type);
395 }
396 maxDepth = 0;
397 code = TCL_OK;
398
399 /*
400 * Switch on the type of the first token after the subexpression token.
401 * After processing it, advance tokenPtr to point just after the
402 * subexpression's last token.
403 */
404
405 tokenPtr = exprTokenPtr+1;
406 TRACE(exprTokenPtr->start, exprTokenPtr->size,
407 tokenPtr->start, tokenPtr->size);
408 switch (tokenPtr->type) {
409 case TCL_TOKEN_WORD:
410 code = TclCompileTokens(interp, tokenPtr+1,
411 tokenPtr->numComponents, envPtr);
412 if (code != TCL_OK) {
413 goto done;
414 }
415 maxDepth = envPtr->maxStackDepth;
416 tokenPtr += (tokenPtr->numComponents + 1);
417 infoPtr->exprIsJustVarRef = 0;
418 break;
419
420 case TCL_TOKEN_TEXT:
421 if (tokenPtr->size > 0) {
422 objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
423 tokenPtr->size, /*onHeap*/ 0);
424 } else {
425 objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
426 }
427 TclEmitPush(objIndex, envPtr);
428 maxDepth = 1;
429 tokenPtr += 1;
430 infoPtr->exprIsJustVarRef = 0;
431 break;
432
433 case TCL_TOKEN_BS:
434 length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
435 buffer);
436 if (length > 0) {
437 objIndex = TclRegisterLiteral(envPtr, buffer, length,
438 /*onHeap*/ 0);
439 } else {
440 objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
441 }
442 TclEmitPush(objIndex, envPtr);
443 maxDepth = 1;
444 tokenPtr += 1;
445 infoPtr->exprIsJustVarRef = 0;
446 break;
447
448 case TCL_TOKEN_COMMAND:
449 code = TclCompileScript(interp, tokenPtr->start+1,
450 tokenPtr->size-2, /*nested*/ 1, envPtr);
451 if (code != TCL_OK) {
452 goto done;
453 }
454 maxDepth = envPtr->maxStackDepth;
455 tokenPtr += 1;
456 infoPtr->exprIsJustVarRef = 0;
457 break;
458
459 case TCL_TOKEN_VARIABLE:
460 code = TclCompileTokens(interp, tokenPtr, 1, envPtr);
461 if (code != TCL_OK) {
462 goto done;
463 }
464 maxDepth = envPtr->maxStackDepth;
465 tokenPtr += (tokenPtr->numComponents + 1);
466 break;
467
468 case TCL_TOKEN_SUB_EXPR:
469 infoPtr->exprIsComparison = 0;
470 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
471 if (code != TCL_OK) {
472 goto done;
473 }
474 maxDepth = envPtr->maxStackDepth;
475 tokenPtr += (tokenPtr->numComponents + 1);
476 break;
477
478 case TCL_TOKEN_OPERATOR:
479 /*
480 * Look up the operator. Temporarily overwrite the character
481 * just after the end of the operator with a 0 byte. If the
482 * operator isn't found, treat it as a math function.
483 */
484
485 /*
486 * TODO: Note that the string is modified in place. This is unsafe
487 * and will break if any of the routines called while the string is
488 * modified have side effects that depend on the original string
489 * being unmodified (e.g. adding an entry to the literal table).
490 */
491
492 operator = tokenPtr->start;
493 savedChar = operator[tokenPtr->size];
494 operator[tokenPtr->size] = 0;
495 hPtr = Tcl_FindHashEntry(&opHashTable, operator);
496 if (hPtr == NULL) {
497 code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
498 envPtr, &endPtr);
499 operator[tokenPtr->size] = (char) savedChar;
500 if (code != TCL_OK) {
501 goto done;
502 }
503 maxDepth = envPtr->maxStackDepth;
504 tokenPtr = endPtr;
505 infoPtr->exprIsJustVarRef = 0;
506 infoPtr->exprIsComparison = 0;
507 break;
508 }
509 operator[tokenPtr->size] = (char) savedChar;
510 opIndex = (int) Tcl_GetHashValue(hPtr);
511 opDescPtr = &(operatorTable[opIndex]);
512
513 /*
514 * If the operator is "normal", compile it using information
515 * from the operator table.
516 */
517
518 if (opDescPtr->numOperands > 0) {
519 tokenPtr++;
520 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
521 if (code != TCL_OK) {
522 goto done;
523 }
524 maxDepth = envPtr->maxStackDepth;
525 tokenPtr += (tokenPtr->numComponents + 1);
526
527 if (opDescPtr->numOperands == 2) {
528 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
529 if (code != TCL_OK) {
530 goto done;
531 }
532 maxDepth = TclMax((envPtr->maxStackDepth + 1),
533 maxDepth);
534 tokenPtr += (tokenPtr->numComponents + 1);
535 }
536 TclEmitOpcode(opDescPtr->instruction, envPtr);
537 infoPtr->hasOperators = 1;
538 infoPtr->exprIsJustVarRef = 0;
539 infoPtr->exprIsComparison =
540 ((opIndex >= OP_LESS) && (opIndex <= OP_NEQ));
541 break;
542 }
543
544 /*
545 * The operator requires special treatment, and is either
546 * "+" or "-", or one of "&&", "||" or "?".
547 */
548
549 switch (opIndex) {
550 case OP_PLUS:
551 case OP_MINUS:
552 tokenPtr++;
553 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
554 if (code != TCL_OK) {
555 goto done;
556 }
557 maxDepth = envPtr->maxStackDepth;
558 tokenPtr += (tokenPtr->numComponents + 1);
559
560 /*
561 * Check whether the "+" or "-" is unary.
562 */
563
564 afterSubexprPtr = exprTokenPtr
565 + exprTokenPtr->numComponents+1;
566 if (tokenPtr == afterSubexprPtr) {
567 TclEmitOpcode(((opIndex==OP_PLUS)?
568 INST_UPLUS : INST_UMINUS),
569 envPtr);
570 break;
571 }
572
573 /*
574 * The "+" or "-" is binary.
575 */
576
577 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
578 if (code != TCL_OK) {
579 goto done;
580 }
581 maxDepth = TclMax((envPtr->maxStackDepth + 1),
582 maxDepth);
583 tokenPtr += (tokenPtr->numComponents + 1);
584 TclEmitOpcode(((opIndex==OP_PLUS)? INST_ADD : INST_SUB),
585 envPtr);
586 break;
587
588 case OP_LAND:
589 case OP_LOR:
590 code = CompileLandOrLorExpr(exprTokenPtr, opIndex,
591 infoPtr, envPtr, &endPtr);
592 if (code != TCL_OK) {
593 goto done;
594 }
595 maxDepth = envPtr->maxStackDepth;
596 tokenPtr = endPtr;
597 break;
598
599 case OP_QUESTY:
600 code = CompileCondExpr(exprTokenPtr, infoPtr,
601 envPtr, &endPtr);
602 if (code != TCL_OK) {
603 goto done;
604 }
605 maxDepth = envPtr->maxStackDepth;
606 tokenPtr = endPtr;
607 break;
608
609 default:
610 panic("CompileSubExpr: unexpected operator %d requiring special treatment\n",
611 opIndex);
612 } /* end switch on operator requiring special treatment */
613 infoPtr->hasOperators = 1;
614 infoPtr->exprIsJustVarRef = 0;
615 infoPtr->exprIsComparison = 0;
616 break;
617
618 default:
619 panic("CompileSubExpr: unexpected token type %d\n",
620 tokenPtr->type);
621 }
622
623 /*
624 * Verify that the subexpression token had the required number of
625 * subtokens: that we've advanced tokenPtr just beyond the
626 * subexpression's last token. For example, a "*" subexpression must
627 * contain the tokens for exactly two operands.
628 */
629
630 if (tokenPtr != (exprTokenPtr + exprTokenPtr->numComponents+1)) {
631 LogSyntaxError(infoPtr);
632 code = TCL_ERROR;
633 }
634
635 done:
636 envPtr->maxStackDepth = maxDepth;
637 return code;
638 }
639
640 /*
641 *----------------------------------------------------------------------
642 *
643 * CompileLandOrLorExpr --
644 *
645 * This procedure compiles a Tcl logical and ("&&") or logical or
646 * ("||") subexpression.
647 *
648 * Results:
649 * The return value is TCL_OK on a successful compilation and TCL_ERROR
650 * on failure. If TCL_OK is returned, a pointer to the token just after
651 * the last one in the subexpression is stored at the address in
652 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
653 * contains an error message.
654 *
655 * envPtr->maxStackDepth is updated with the maximum number of stack
656 * elements needed to execute the expression.
657 *
658 * Side effects:
659 * Adds instructions to envPtr to evaluate the expression at runtime.
660 *
661 *----------------------------------------------------------------------
662 */
663
664 static int
665 CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
666 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
667 * containing the "&&" or "||" operator. */
668 int opIndex; /* A code describing the expression
669 * operator: either OP_LAND or OP_LOR. */
670 ExprInfo *infoPtr; /* Describes the compilation state for the
671 * expression being compiled. */
672 CompileEnv *envPtr; /* Holds resulting instructions. */
673 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
674 * just after the last token in the
675 * subexpression is stored here. */
676 {
677 JumpFixup shortCircuitFixup; /* Used to fix up the short circuit jump
678 * after the first subexpression. */
679 JumpFixup lhsTrueFixup, lhsEndFixup;
680 /* Used to fix up jumps used to convert the
681 * first operand to 0 or 1. */
682 Tcl_Token *tokenPtr;
683 int dist, maxDepth, code;
684
685 /*
686 * Emit code for the first operand.
687 */
688
689 maxDepth = 0;
690 tokenPtr = exprTokenPtr+2;
691 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
692 if (code != TCL_OK) {
693 goto done;
694 }
695 maxDepth = envPtr->maxStackDepth;
696 tokenPtr += (tokenPtr->numComponents + 1);
697
698 /*
699 * Convert the first operand to the result that Tcl requires:
700 * "0" or "1". Eventually we'll use a new instruction for this.
701 */
702
703 TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
704 TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
705 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
706 dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
707 if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
708 badDist:
709 panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
710 }
711 TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
712 dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
713 if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
714 goto badDist;
715 }
716
717 /*
718 * Emit the "short circuit" jump around the rest of the expression.
719 * Duplicate the "0" or "1" on top of the stack first to keep the
720 * jump from consuming it.
721 */
722
723 TclEmitOpcode(INST_DUP, envPtr);
724 TclEmitForwardJump(envPtr,
725 ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
726 &shortCircuitFixup);
727
728 /*
729 * Emit code for the second operand.
730 */
731
732 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
733 if (code != TCL_OK) {
734 goto done;
735 }
736 maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
737 tokenPtr += (tokenPtr->numComponents + 1);
738
739 /*
740 * Emit a "logical and" or "logical or" instruction. This does not try
741 * to "short- circuit" the evaluation of both operands, but instead
742 * ensures that we either have a "1" or a "0" result.
743 */
744
745 TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
746
747 /*
748 * Now that we know the target of the forward jump, update it with the
749 * correct distance.
750 */
751
752 dist = (envPtr->codeNext - envPtr->codeStart)
753 - shortCircuitFixup.codeOffset;
754 TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
755 *endPtrPtr = tokenPtr;
756
757 done:
758 envPtr->maxStackDepth = maxDepth;
759 return code;
760 }
761
762 /*
763 *----------------------------------------------------------------------
764 *
765 * CompileCondExpr --
766 *
767 * This procedure compiles a Tcl conditional expression:
768 * condExpr ::= lorExpr ['?' condExpr ':' condExpr]
769 *
770 * Results:
771 * The return value is TCL_OK on a successful compilation and TCL_ERROR
772 * on failure. If TCL_OK is returned, a pointer to the token just after
773 * the last one in the subexpression is stored at the address in
774 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
775 * contains an error message.
776 *
777 * envPtr->maxStackDepth is updated with the maximum number of stack
778 * elements needed to execute the expression.
779 *
780 * Side effects:
781 * Adds instructions to envPtr to evaluate the expression at runtime.
782 *
783 *----------------------------------------------------------------------
784 */
785
786 static int
787 CompileCondExpr(exprTokenPtr, infoPtr, envPtr, endPtrPtr)
788 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
789 * containing the "?" operator. */
790 ExprInfo *infoPtr; /* Describes the compilation state for the
791 * expression being compiled. */
792 CompileEnv *envPtr; /* Holds resulting instructions. */
793 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
794 * just after the last token in the
795 * subexpression is stored here. */
796 {
797 JumpFixup jumpAroundThenFixup, jumpAroundElseFixup;
798 /* Used to update or replace one-byte jumps
799 * around the then and else expressions when
800 * their target PCs are determined. */
801 Tcl_Token *tokenPtr;
802 int elseCodeOffset, dist, maxDepth, code;
803
804 /*
805 * Emit code for the test.
806 */
807
808 maxDepth = 0;
809 tokenPtr = exprTokenPtr+2;
810 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
811 if (code != TCL_OK) {
812 goto done;
813 }
814 maxDepth = envPtr->maxStackDepth;
815 tokenPtr += (tokenPtr->numComponents + 1);
816
817 /*
818 * Emit the jump to the "else" expression if the test was false.
819 */
820
821 TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
822
823 /*
824 * Compile the "then" expression. Note that if a subexpression is only
825 * a primary, we need to try to convert it to numeric. We do this to
826 * support Tcl's policy of interpreting operands if at all possible as
827 * first integers, else floating-point numbers.
828 */
829
830 infoPtr->hasOperators = 0;
831 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
832 if (code != TCL_OK) {
833 goto done;
834 }
835 maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
836 tokenPtr += (tokenPtr->numComponents + 1);
837 if (!infoPtr->hasOperators) {
838 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
839 }
840
841 /*
842 * Emit an unconditional jump around the "else" condExpr.
843 */
844
845 TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
846 &jumpAroundElseFixup);
847
848 /*
849 * Compile the "else" expression.
850 */
851
852 elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
853 infoPtr->hasOperators = 0;
854 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
855 if (code != TCL_OK) {
856 goto done;
857 }
858 maxDepth = TclMax(envPtr->maxStackDepth, maxDepth);
859 tokenPtr += (tokenPtr->numComponents + 1);
860 if (!infoPtr->hasOperators) {
861 TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
862 }
863
864 /*
865 * Fix up the second jump around the "else" expression.
866 */
867
868 dist = (envPtr->codeNext - envPtr->codeStart)
869 - jumpAroundElseFixup.codeOffset;
870 if (TclFixupForwardJump(envPtr, &jumpAroundElseFixup, dist, 127)) {
871 /*
872 * Update the else expression's starting code offset since it
873 * moved down 3 bytes too.
874 */
875
876 elseCodeOffset += 3;
877 }
878
879 /*
880 * Fix up the first jump to the "else" expression if the test was false.
881 */
882
883 dist = (elseCodeOffset - jumpAroundThenFixup.codeOffset);
884 TclFixupForwardJump(envPtr, &jumpAroundThenFixup, dist, 127);
885 *endPtrPtr = tokenPtr;
886
887 done:
888 envPtr->maxStackDepth = maxDepth;
889 return code;
890 }
891
892 /*
893 *----------------------------------------------------------------------
894 *
895 * CompileMathFuncCall --
896 *
897 * This procedure compiles a call on a math function in an expression:
898 * mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
899 *
900 * Results:
901 * The return value is TCL_OK on a successful compilation and TCL_ERROR
902 * on failure. If TCL_OK is returned, a pointer to the token just after
903 * the last one in the subexpression is stored at the address in
904 * endPtrPtr. If TCL_ERROR is returned, then the interpreter's result
905 * contains an error message.
906 *
907 * envPtr->maxStackDepth is updated with the maximum number of stack
908 * elements needed to execute the function.
909 *
910 * Side effects:
911 * Adds instructions to envPtr to evaluate the math function at
912 * runtime.
913 *
914 *----------------------------------------------------------------------
915 */
916
917 static int
918 CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
919 Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
920 * containing the math function call. */
921 char *funcName; /* Name of the math function. */
922 ExprInfo *infoPtr; /* Describes the compilation state for the
923 * expression being compiled. */
924 CompileEnv *envPtr; /* Holds resulting instructions. */
925 Tcl_Token **endPtrPtr; /* If successful, a pointer to the token
926 * just after the last token in the
927 * subexpression is stored here. */
928 {
929 Tcl_Interp *interp = infoPtr->interp;
930 Interp *iPtr = (Interp *) interp;
931 MathFunc *mathFuncPtr;
932 Tcl_HashEntry *hPtr;
933 Tcl_Token *tokenPtr, *afterSubexprPtr;
934 int maxDepth, code, i;
935
936 /*
937 * Look up the MathFunc record for the function.
938 */
939
940 code = TCL_OK;
941 maxDepth = 0;
942 hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, funcName);
943 if (hPtr == NULL) {
944 Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
945 "unknown math function \"", funcName, "\"", (char *) NULL);
946 code = TCL_ERROR;
947 goto done;
948 }
949 mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
950
951 /*
952 * If not a builtin function, push an object with the function's name.
953 */
954
955 if (mathFuncPtr->builtinFuncIndex < 0) {
956 TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
957 envPtr);
958 maxDepth = 1;
959 }
960
961 /*
962 * Compile any arguments for the function.
963 */
964
965 tokenPtr = exprTokenPtr+2;
966 afterSubexprPtr = exprTokenPtr + (exprTokenPtr->numComponents + 1);
967 if (mathFuncPtr->numArgs > 0) {
968 for (i = 0; i < mathFuncPtr->numArgs; i++) {
969 if (tokenPtr == afterSubexprPtr) {
970 Tcl_ResetResult(interp);
971 Tcl_AppendToObj(Tcl_GetObjResult(interp),
972 "too few arguments for math function", -1);
973 code = TCL_ERROR;
974 goto done;
975 }
976 infoPtr->exprIsComparison = 0;
977 code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
978 if (code != TCL_OK) {
979 goto done;
980 }
981 tokenPtr += (tokenPtr->numComponents + 1);
982 maxDepth++;
983 }
984 if (tokenPtr != afterSubexprPtr) {
985 Tcl_ResetResult(interp);
986 Tcl_AppendToObj(Tcl_GetObjResult(interp),
987 "too many arguments for math function", -1);
988 code = TCL_ERROR;
989 goto done;
990 }
991 } else if (tokenPtr != afterSubexprPtr) {
992 Tcl_ResetResult(interp);
993 Tcl_AppendToObj(Tcl_GetObjResult(interp),
994 "too many arguments for math function", -1);
995 code = TCL_ERROR;
996 goto done;
997 }
998
999 /*
1000 * Compile the call on the math function. Note that the "objc" argument
1001 * count for non-builtin functions is incremented by 1 to include the
1002 * function name itself.
1003 */
1004
1005 if (mathFuncPtr->builtinFuncIndex >= 0) { /* a builtin function */
1006 TclEmitInstInt1(INST_CALL_BUILTIN_FUNC1,
1007 mathFuncPtr->builtinFuncIndex, envPtr);
1008 } else {
1009 TclEmitInstInt1(INST_CALL_FUNC1, (mathFuncPtr->numArgs+1), envPtr);
1010 }
1011 *endPtrPtr = afterSubexprPtr;
1012
1013 done:
1014 envPtr->maxStackDepth = maxDepth;
1015 return code;
1016 }
1017
1018 /*
1019 *----------------------------------------------------------------------
1020 *
1021 * LogSyntaxError --
1022 *
1023 * This procedure is invoked after an error occurs when compiling an
1024 * expression. It sets the interpreter result to an error message
1025 * describing the error.
1026 *
1027 * Results:
1028 * None.
1029 *
1030 * Side effects:
1031 * Sets the interpreter result to an error message describing the
1032 * expression that was being compiled when the error occurred.
1033 *
1034 *----------------------------------------------------------------------
1035 */
1036
1037 static void
1038 LogSyntaxError(infoPtr)
1039 ExprInfo *infoPtr; /* Describes the compilation state for the
1040 * expression being compiled. */
1041 {
1042 int numBytes = (infoPtr->lastChar - infoPtr->expr);
1043 char buffer[100];
1044
1045 sprintf(buffer, "syntax error in expression \"%.*s\"",
1046 ((numBytes > 60)? 60 : numBytes), infoPtr->expr);
1047 Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
1048 buffer, (char *) NULL);
1049 }
1050
1051 /* End of tclcompexpr.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25