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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (hide annotations) (download)
Sat Nov 5 11:07:06 2016 UTC (7 years, 7 months ago) by dashley
File MIME type: text/plain
File size: 31803 byte(s)
Set EOL properties appropriately to facilitate simultaneous Linux and Windows development.
1 dashley 71 /* $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:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25