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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25