Line data Source code
1 : /*
2 : * (c) Thomas Pornin 1999 - 2002
3 : *
4 : * Redistribution and use in source and binary forms, with or without
5 : * modification, are permitted provided that the following conditions
6 : * are met:
7 : * 1. Redistributions of source code must retain the above copyright
8 : * notice, this list of conditions and the following disclaimer.
9 : * 2. Redistributions in binary form must reproduce the above copyright
10 : * notice, this list of conditions and the following disclaimer in the
11 : * documentation and/or other materials provided with the distribution.
12 : * 4. The name of the authors may not be used to endorse or promote
13 : * products derived from this software without specific prior written
14 : * permission.
15 : *
16 : * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
17 : * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
18 : * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
19 : * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
20 : * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
21 : * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
22 : * OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
23 : * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 : * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
25 : * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
26 : * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 : *
28 : */
29 :
30 : #include "tune.h"
31 : #include <stdio.h>
32 : #include <string.h>
33 : #include <setjmp.h>
34 : #include <limits.h>
35 : #include "ucppi.h"
36 : #include "mem.h"
37 :
38 : JMP_BUF eval_exception;
39 : long eval_line;
40 : static int emit_eval_warnings;
41 :
42 : /*
43 : * If you want to hardcode a conversion table, define a static array
44 : * of 256 int, and make transient_characters point to it.
45 : */
46 : int *transient_characters = 0;
47 :
48 : #define OCTAL(x) ((x) >= '0' && (x) <= '7')
49 : #define DECIM(x) ((x) >= '0' && (x) <= '9')
50 : #define HEXAD(x) (DECIM(x) \
51 : || (x) == 'a' || (x) == 'b' || (x) == 'c' \
52 : || (x) == 'd' || (x) == 'e' || (x) == 'f' \
53 : || (x) == 'A' || (x) == 'B' || (x) == 'C' \
54 : || (x) == 'D' || (x) == 'E' || (x) == 'F')
55 : #define OVAL(x) ((int)((x) - '0'))
56 : #define DVAL(x) ((int)((x) - '0'))
57 : #define HVAL(x) (DECIM(x) ? DVAL(x) \
58 : : (x) == 'a' || (x) == 'A' ? 10 \
59 : : (x) == 'b' || (x) == 'B' ? 11 \
60 : : (x) == 'c' || (x) == 'C' ? 12 \
61 : : (x) == 'd' || (x) == 'D' ? 13 \
62 : : (x) == 'e' || (x) == 'E' ? 14 : 15)
63 :
64 : #define ARITH_TYPENAME big
65 : #define ARITH_FUNCTION_HEADER static inline
66 :
67 : #define ARITH_ERROR(type) z_error(type)
68 : static void z_error(int type);
69 :
70 : #ifdef ARITHMETIC_CHECKS
71 : #define ARITH_WARNING(type) z_warn(type)
72 : static void z_warn(int type);
73 : #endif
74 :
75 : #include "arith.c"
76 :
77 0 : static void z_error(int type)
78 : {
79 0 : switch (type) {
80 : case ARITH_EXCEP_SLASH_D:
81 0 : error(eval_line, "division by 0");
82 0 : break;
83 : case ARITH_EXCEP_SLASH_O:
84 0 : error(eval_line, "overflow on division");
85 0 : break;
86 : case ARITH_EXCEP_PCT_D:
87 0 : error(eval_line, "division by 0 on modulus operator");
88 0 : break;
89 : case ARITH_EXCEP_CONST_O:
90 0 : error(eval_line, "constant too large for destination type");
91 0 : break;
92 : #ifdef AUDIT
93 : default:
94 : ouch("erroneous integer error: %d", type);
95 : #endif
96 : }
97 0 : throw(eval_exception);
98 : }
99 :
100 : #ifdef ARITHMETIC_CHECKS
101 0 : static void z_warn(int type)
102 : {
103 0 : switch (type) {
104 : case ARITH_EXCEP_CONV_O:
105 0 : warning(eval_line, "overflow on integer conversion");
106 0 : break;
107 : case ARITH_EXCEP_NEG_O:
108 0 : warning(eval_line, "overflow on unary minus");
109 0 : break;
110 : case ARITH_EXCEP_NOT_T:
111 0 : warning(eval_line,
112 : "bitwise inversion yields trap representation");
113 0 : break;
114 : case ARITH_EXCEP_PLUS_O:
115 0 : warning(eval_line, "overflow on addition");
116 0 : break;
117 : case ARITH_EXCEP_PLUS_U:
118 0 : warning(eval_line, "underflow on addition");
119 0 : break;
120 : case ARITH_EXCEP_MINUS_O:
121 0 : warning(eval_line, "overflow on subtraction");
122 0 : break;
123 : case ARITH_EXCEP_MINUS_U:
124 0 : warning(eval_line, "underflow on subtraction");
125 0 : break;
126 : case ARITH_EXCEP_AND_T:
127 0 : warning(eval_line,
128 : "bitwise AND yields trap representation");
129 0 : break;
130 : case ARITH_EXCEP_XOR_T:
131 0 : warning(eval_line,
132 : "bitwise XOR yields trap representation");
133 0 : break;
134 : case ARITH_EXCEP_OR_T:
135 0 : warning(eval_line,
136 : "bitwise OR yields trap representation");
137 0 : break;
138 : case ARITH_EXCEP_LSH_W:
139 0 : warning(eval_line, "left shift count greater than "
140 : "or equal to type width");
141 0 : break;
142 : case ARITH_EXCEP_LSH_C:
143 0 : warning(eval_line, "left shift count negative");
144 0 : break;
145 : case ARITH_EXCEP_LSH_O:
146 0 : warning(eval_line, "overflow on left shift");
147 0 : break;
148 : case ARITH_EXCEP_RSH_W:
149 0 : warning(eval_line, "right shift count greater than "
150 : "or equal to type width");
151 0 : break;
152 : case ARITH_EXCEP_RSH_C:
153 0 : warning(eval_line, "right shift count negative");
154 0 : break;
155 : case ARITH_EXCEP_RSH_N:
156 0 : warning(eval_line, "right shift of negative value");
157 0 : break;
158 : case ARITH_EXCEP_STAR_O:
159 0 : warning(eval_line, "overflow on multiplication");
160 0 : break;
161 : case ARITH_EXCEP_STAR_U:
162 0 : warning(eval_line, "underflow on multiplication");
163 0 : break;
164 : #ifdef AUDIT
165 : default:
166 : ouch("erroneous integer warning: %d", type);
167 : #endif
168 : }
169 0 : }
170 : #endif
171 :
172 : typedef struct {
173 : int sign;
174 : union {
175 : u_big uv;
176 : s_big sv;
177 : } u;
178 : } ppval;
179 :
180 0 : static int boolval(ppval x)
181 : {
182 0 : return x.sign ? big_s_lval(x.u.sv) : big_u_lval(x.u.uv);
183 : }
184 :
185 : #if !defined(WCHAR_SIGNEDNESS)
186 : # if CHAR_MIN == 0
187 : # define WCHAR_SIGNEDNESS 0
188 : # else
189 : # define WCHAR_SIGNEDNESS 1
190 : # endif
191 : #endif
192 :
193 : /*
194 : * Check the suffix, return 1 if it is signed, 0 otherwise. 1 is
195 : * returned for a void suffix. Legal suffixes are:
196 : * unsigned: u U ul uL Ul UL lu Lu lU LU ull uLL Ull ULL llu LLu llU LLU
197 : * signed: l L ll LL
198 : */
199 0 : static int pp_suffix(char *d, char *refc)
200 : {
201 0 : if (!*d) return 1;
202 0 : if (*d == 'u' || *d == 'U') {
203 0 : if (!*(++ d)) return 0;
204 0 : if (*d == 'l' || *d == 'L') {
205 0 : char *e = d + 1;
206 :
207 0 : if (*e && *e != *d) goto suffix_error;
208 0 : if (!*e || !*(e + 1)) return 0;
209 0 : goto suffix_error;
210 : }
211 0 : goto suffix_error;
212 : }
213 0 : if (*d == 'l' || *d == 'L') {
214 0 : if (!*(++ d)) return 1;
215 0 : if (*d == *(d - 1)) {
216 0 : d ++;
217 0 : if (!*d) return 1;
218 : }
219 0 : if (*d == 'u' || *d == 'U') {
220 0 : d ++;
221 0 : if (!*d) return 0;
222 : }
223 0 : goto suffix_error;
224 : }
225 : suffix_error:
226 0 : error(eval_line, "invalid integer constant '%s'", refc);
227 0 : throw(eval_exception);
228 : return 666;
229 : }
230 :
231 0 : static unsigned long pp_char(char *c, char *refc)
232 : {
233 0 : unsigned long r = 0;
234 :
235 0 : c ++;
236 0 : if (*c == '\\') {
237 : int i;
238 :
239 0 : c ++;
240 0 : switch (*c) {
241 0 : case 'n': r = '\n'; c ++; break;
242 0 : case 't': r = '\t'; c ++; break;
243 0 : case 'v': r = '\v'; c ++; break;
244 0 : case 'b': r = '\b'; c ++; break;
245 0 : case 'r': r = '\r'; c ++; break;
246 0 : case 'f': r = '\f'; c ++; break;
247 0 : case 'a': r = '\a'; c ++; break;
248 0 : case '\\': r = '\\'; c ++; break;
249 0 : case '\?': r = '\?'; c ++; break;
250 0 : case '\'': r = '\''; c ++; break;
251 0 : case '\"': r = '\"'; c ++; break;
252 : case 'u':
253 0 : for (i = 0, c ++; i < 4 && HEXAD(*c); i ++, c ++) {
254 0 : r = (r * 16) + HVAL(*c);
255 : }
256 0 : if (i != 4) {
257 0 : error(eval_line, "malformed UCN in %s", refc);
258 0 : throw(eval_exception);
259 : }
260 0 : break;
261 : case 'U':
262 0 : for (i = 0, c ++; i < 8 && HEXAD(*c); i ++, c ++) {
263 0 : r = (r * 16) + HVAL(*c);
264 : }
265 0 : if (i != 8) {
266 0 : error(eval_line, "malformed UCN in %s", refc);
267 0 : throw(eval_exception);
268 : }
269 0 : break;
270 : case 'x':
271 0 : for (c ++; HEXAD(*c); c ++) r = (r * 16) + HVAL(*c);
272 0 : break;
273 : default:
274 0 : if (OCTAL(*c)) {
275 0 : r = OVAL(*(c ++));
276 0 : if (OCTAL(*c)) r = (r * 8) + OVAL(*(c ++));
277 0 : if (OCTAL(*c)) r = (r * 8) + OVAL(*(c ++));
278 : } else {
279 0 : error(eval_line, "invalid escape sequence "
280 0 : "'\\%c'", *c);
281 0 : throw(eval_exception);
282 : }
283 : }
284 0 : } else if (*c == '\'') {
285 0 : error(eval_line, "empty character constant");
286 0 : throw(eval_exception);
287 : } else {
288 0 : r = *((unsigned char *)(c ++));
289 : }
290 :
291 0 : if (transient_characters && r < 256) {
292 0 : r = transient_characters[(size_t)r];
293 : }
294 :
295 0 : if (*c != '\'' && emit_eval_warnings) {
296 0 : warning(eval_line, "multicharacter constant");
297 : }
298 0 : return r;
299 : }
300 :
301 0 : static ppval pp_strtoconst(char *refc)
302 : {
303 : ppval q;
304 0 : char *c = refc, *d;
305 : u_big ru;
306 : s_big rs;
307 : int sp, dec;
308 :
309 0 : if (*c == '\'' || *c == 'L') {
310 0 : q.sign = (*c == 'L') ? WCHAR_SIGNEDNESS : 1;
311 0 : if (*c == 'L' && *(++ c) != '\'') {
312 0 : error(eval_line,
313 : "invalid wide character constant: %s", refc);
314 0 : throw(eval_exception);
315 : }
316 0 : if (q.sign) {
317 0 : q.u.sv = big_s_fromlong(pp_char(c, refc));
318 : } else {
319 0 : q.u.uv = big_u_fromulong(pp_char(c, refc));
320 : }
321 0 : return q;
322 : }
323 0 : if (*c == '0') {
324 : /* octal or hexadecimal */
325 0 : dec = 0;
326 0 : c ++;
327 0 : if (*c == 'x' || *c == 'X') {
328 0 : c ++;
329 0 : d = big_u_hexconst(c, &ru, &rs, &sp);
330 : } else {
331 0 : d = big_u_octconst(c, &ru, &rs, &sp);
332 : }
333 : } else {
334 0 : dec = 1;
335 0 : d = big_u_decconst(c, &ru, &rs, &sp);
336 : }
337 0 : q.sign = pp_suffix(d, refc);
338 0 : if (q.sign) {
339 0 : if (!sp) {
340 0 : if (dec) {
341 0 : error(eval_line, "constant too large "
342 : "for destination type");
343 0 : throw(eval_exception);
344 : } else {
345 0 : warning(eval_line, "constant is so large "
346 : "that it is unsigned");
347 : }
348 0 : q.u.uv = ru;
349 0 : q.sign = 0;
350 : } else {
351 0 : q.u.sv = rs;
352 : }
353 : } else {
354 0 : q.u.uv = ru;
355 : }
356 0 : return q;
357 : }
358 :
359 : /*
360 : * Used by #line directives -- anything beyond what can be put in an
361 : * unsigned long, is considered absurd.
362 : */
363 0 : unsigned long strtoconst(char *c)
364 : {
365 0 : ppval q = pp_strtoconst(c);
366 :
367 0 : if (q.sign) q.u.uv = big_s_to_u(q.u.sv);
368 0 : return big_u_toulong(q.u.uv);
369 : }
370 :
371 : #define OP_UN(x) ((x) == LNOT || (x) == NOT || (x) == UPLUS \
372 : || (x) == UMINUS)
373 :
374 0 : static ppval eval_opun(int op, ppval v)
375 : {
376 0 : if (op == LNOT) {
377 0 : v.sign = 1;
378 0 : v.u.sv = big_s_fromint(big_s_lnot(v.u.sv));
379 0 : return v;
380 : }
381 0 : if (v.sign) {
382 0 : switch (op) {
383 0 : case NOT: v.u.sv = big_s_not(v.u.sv); break;
384 0 : case UPLUS: break;
385 0 : case UMINUS: v.u.sv = big_s_neg(v.u.sv); break;
386 : }
387 : } else {
388 0 : switch (op) {
389 0 : case NOT: v.u.uv = big_u_not(v.u.uv); break;
390 0 : case UPLUS: break;
391 0 : case UMINUS: v.u.uv = big_u_neg(v.u.uv); break;
392 : }
393 : }
394 0 : return v;
395 : }
396 :
397 : #define OP_BIN(x) ((x) == STAR || (x) == SLASH || (x) == PCT \
398 : || (x) == PLUS || (x) == MINUS || (x) == LSH \
399 : || (x) == RSH || (x) == LT || (x) == LEQ \
400 : || (x) == GT || (x) == GEQ || (x) == SAME \
401 : || (x) == NEQ || (x) == AND || (x) == CIRC \
402 : || (x) == OR || (x) == LAND || (x) == LOR \
403 : || (x) == COMMA)
404 :
405 0 : static ppval eval_opbin(int op, ppval v1, ppval v2)
406 : {
407 : ppval r;
408 0 : int iv2 = 0;
409 :
410 0 : switch (op) {
411 : case STAR: case SLASH: case PCT:
412 : case PLUS: case MINUS: case AND:
413 : case CIRC: case OR:
414 : /* promote operands, adjust signedness of result */
415 0 : if (!v1.sign || !v2.sign) {
416 0 : if (v1.sign) {
417 0 : v1.u.uv = big_s_to_u(v1.u.sv);
418 0 : v1.sign = 0;
419 0 : } else if (v2.sign) {
420 0 : v2.u.uv = big_s_to_u(v2.u.sv);
421 0 : v2.sign = 0;
422 : }
423 0 : r.sign = 0;
424 : } else {
425 0 : r.sign = 1;
426 : }
427 0 : break;
428 : case LT: case LEQ: case GT:
429 : case GEQ: case SAME: case NEQ:
430 : /* promote operands */
431 0 : if (!v1.sign || !v2.sign) {
432 0 : if (v1.sign) {
433 0 : v1.u.uv = big_s_to_u(v1.u.sv);
434 0 : v1.sign = 0;
435 0 : } else if (v2.sign) {
436 0 : v2.u.uv = big_s_to_u(v2.u.sv);
437 0 : v2.sign = 0;
438 : }
439 : }
440 : /* fall through */
441 : case LAND:
442 : case LOR:
443 : /* result is signed anyway */
444 0 : r.sign = 1;
445 0 : break;
446 : case LSH:
447 : case RSH:
448 : /* result is as signed as left operand; convert right
449 : operand to int */
450 0 : r.sign = v1.sign;
451 0 : if (v2.sign) {
452 0 : iv2 = big_s_toint(v2.u.sv);
453 : } else {
454 0 : iv2 = big_u_toint(v2.u.uv);
455 : }
456 0 : break;
457 : case COMMA:
458 0 : if (emit_eval_warnings) {
459 0 : warning(eval_line, "ISO C forbids evaluated comma "
460 : "operators in #if expressions");
461 : }
462 0 : r.sign = v2.sign;
463 0 : break;
464 : #ifdef AUDIT
465 : default: ouch("a good operator is a dead operator");
466 : #endif
467 : }
468 :
469 : #define SBINOP(x) if (r.sign) r.u.sv = big_s_ ## x (v1.u.sv, v2.u.sv); \
470 : else r.u.uv = big_u_ ## x (v1.u.uv, v2.u.uv);
471 :
472 : #define NSSBINOP(x) if (v1.sign) r.u.sv = big_s_fromint(big_s_ ## x \
473 : (v1.u.sv, v2.u.sv)); else r.u.sv = big_s_fromint( \
474 : big_u_ ## x (v1.u.uv, v2.u.uv));
475 :
476 : #define LBINOP(x) if (v1.sign) r.u.sv = big_s_fromint( \
477 : big_s_lval(v1.u.sv) x big_s_lval(v2.u.sv)); \
478 : else r.u.sv = big_s_fromint( \
479 : big_u_lval(v1.u.uv) x big_u_lval(v2.u.uv));
480 :
481 : #define ABINOP(x) if (r.sign) r.u.sv = big_s_ ## x (v1.u.sv, iv2); \
482 : else r.u.uv = big_u_ ## x (v1.u.uv, iv2);
483 :
484 0 : switch (op) {
485 0 : case STAR: SBINOP(star); break;
486 0 : case SLASH: SBINOP(slash); break;
487 0 : case PCT: SBINOP(pct); break;
488 0 : case PLUS: SBINOP(plus); break;
489 0 : case MINUS: SBINOP(minus); break;
490 0 : case LSH: ABINOP(lsh); break;
491 0 : case RSH: ABINOP(rsh); break;
492 0 : case LT: NSSBINOP(lt); break;
493 0 : case LEQ: NSSBINOP(leq); break;
494 0 : case GT: NSSBINOP(gt); break;
495 0 : case GEQ: NSSBINOP(geq); break;
496 0 : case SAME: NSSBINOP(same); break;
497 0 : case NEQ: NSSBINOP(neq); break;
498 0 : case AND: SBINOP(and); break;
499 0 : case CIRC: SBINOP(xor); break;
500 0 : case OR: SBINOP(or); break;
501 0 : case LAND: LBINOP(&&); break;
502 0 : case LOR: LBINOP(||); break;
503 0 : case COMMA: r = v2; break;
504 : }
505 0 : return r;
506 : }
507 :
508 : #define ttOP(x) (OP_UN(x) || OP_BIN(x) || (x) == QUEST || (x) == COLON)
509 :
510 0 : static int op_prec(int op)
511 : {
512 0 : switch (op) {
513 : case LNOT:
514 : case NOT:
515 : case UPLUS:
516 : case UMINUS:
517 0 : return 13;
518 : case STAR:
519 : case SLASH:
520 : case PCT:
521 0 : return 12;
522 : case PLUS:
523 : case MINUS:
524 0 : return 11;
525 : case LSH:
526 : case RSH:
527 0 : return 10;
528 : case LT:
529 : case LEQ:
530 : case GT:
531 : case GEQ:
532 0 : return 9;
533 : case SAME:
534 : case NEQ:
535 0 : return 8;
536 : case AND:
537 0 : return 7;
538 : case CIRC:
539 0 : return 6;
540 : case OR:
541 0 : return 5;
542 : case LAND:
543 0 : return 4;
544 : case LOR:
545 0 : return 3;
546 : case QUEST:
547 0 : return 2;
548 : case COMMA:
549 0 : return 1;
550 : }
551 : #ifdef AUDIT
552 : ouch("an unknown species should have a higher precedence");
553 : #endif
554 0 : return 666;
555 : }
556 :
557 : /*
558 : * Perform the hard work of evaluation.
559 : *
560 : * This function works because:
561 : * -- all unary operators are right to left associative, and with
562 : * identical precedence
563 : * -- all binary operators are left to right associative
564 : * -- there is only one non-unary and non-binary operator: the quest-colon
565 : *
566 : * If do_eval is 0, the evaluation of operators is not done. This is
567 : * for sequence point operators (&&, || and ?:).
568 : */
569 0 : static ppval eval_shrd(struct token_fifo *tf, int minprec, int do_eval)
570 : {
571 : ppval top;
572 : struct token *ct;
573 :
574 0 : top.sign = 1;
575 0 : if (tf->art == tf->nt) goto trunc_err;
576 0 : ct = tf->t + (tf->art ++);
577 0 : if (ct->type == LPAR) {
578 0 : top = eval_shrd(tf, 0, do_eval);
579 0 : if (tf->art == tf->nt) goto trunc_err;
580 0 : ct = tf->t + (tf->art ++);
581 0 : if (ct->type != RPAR) {
582 0 : error(eval_line, "a right parenthesis was expected");
583 0 : throw(eval_exception);
584 : }
585 0 : } else if (ct->type == NUMBER || ct->type == CHAR) {
586 0 : top = pp_strtoconst(ct->name);
587 0 : } else if (OP_UN(ct->type)) {
588 0 : top = eval_opun(ct->type, eval_shrd(tf,
589 : op_prec(ct->type), do_eval));
590 0 : goto eval_loop;
591 0 : } else if (ttOP(ct->type)) goto rogue_op_err;
592 : else {
593 : goto invalid_token_err;
594 : }
595 :
596 : eval_loop:
597 0 : if (tf->art == tf->nt) {
598 0 : return top;
599 : }
600 0 : ct = tf->t + (tf->art ++);
601 0 : if (OP_BIN(ct->type)) {
602 0 : int bp = op_prec(ct->type);
603 :
604 0 : if (bp > minprec) {
605 : ppval tr;
606 :
607 0 : if ((ct->type == LOR && boolval(top))
608 0 : || (ct->type == LAND && !boolval(top))) {
609 0 : tr = eval_shrd(tf, bp, 0);
610 0 : if (do_eval) {
611 0 : top.sign = 1;
612 0 : if (ct->type == LOR)
613 0 : top.u.sv = big_s_fromint(1);
614 0 : if (ct->type == LAND)
615 0 : top.u.sv = big_s_fromint(0);
616 : }
617 : } else {
618 0 : tr = eval_shrd(tf, bp, do_eval);
619 0 : if (do_eval)
620 0 : top = eval_opbin(ct->type, top, tr);
621 : }
622 : goto eval_loop;
623 : }
624 0 : } else if (ct->type == QUEST) {
625 0 : int bp = op_prec(QUEST);
626 : ppval r1, r2;
627 :
628 0 : if (bp >= minprec) {
629 0 : int qv = boolval(top);
630 :
631 0 : r1 = eval_shrd(tf, bp, qv ? do_eval : 0);
632 0 : if (tf->art == tf->nt) goto trunc_err;
633 0 : ct = tf->t + (tf->art ++);
634 0 : if (ct->type != COLON) {
635 0 : error(eval_line, "a colon was expected");
636 0 : throw(eval_exception);
637 : }
638 0 : r2 = eval_shrd(tf, bp, qv ? 0 : do_eval);
639 0 : if (do_eval) {
640 0 : if (qv) top = r1; else top = r2;
641 : }
642 : goto eval_loop;
643 : }
644 : }
645 0 : tf->art --;
646 0 : return top;
647 :
648 : trunc_err:
649 0 : error(eval_line, "truncated constant integral expression");
650 0 : throw(eval_exception);
651 : rogue_op_err:
652 0 : error(eval_line, "rogue operator '%s' in constant integral "
653 0 : "expression", operators_name[ct->type]);
654 0 : throw(eval_exception);
655 : invalid_token_err:
656 0 : error(eval_line, "invalid token in constant integral expression");
657 0 : throw(eval_exception);
658 : }
659 :
660 : #define UNARY(x) ((x) != NUMBER && (x) != NAME && (x) != CHAR \
661 : && (x) != RPAR)
662 :
663 : /*
664 : * Evaluate the integer expression contained in the given token_fifo.
665 : * Evaluation is made by precedence of operators, as described in the
666 : * Dragon Book. The unary + and - are distinguished from their binary
667 : * counterparts using the Fortran way: a + or a - is considered unary
668 : * if it does not follow a constant, an identifier or a right parenthesis.
669 : */
670 0 : unsigned long eval_expr(struct token_fifo *tf, int *ret, int ew)
671 : {
672 : size_t sart;
673 : ppval r;
674 :
675 0 : emit_eval_warnings = ew;
676 0 : if (catch(eval_exception)) goto eval_err;
677 : /* first, distinguish unary + and - from binary + and - */
678 0 : for (sart = tf->art; tf->art < tf->nt; tf->art ++) {
679 0 : if (tf->t[tf->art].type == PLUS) {
680 0 : if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
681 0 : tf->t[tf->art].type = UPLUS;
682 0 : } else if (tf->t[tf->art].type == MINUS) {
683 0 : if (sart == tf->art || UNARY(tf->t[tf->art - 1].type))
684 0 : tf->t[tf->art].type = UMINUS;
685 : }
686 : }
687 0 : tf->art = sart;
688 0 : r = eval_shrd(tf, 0, 1);
689 0 : if (tf->art < tf->nt) {
690 0 : error(eval_line, "trailing garbage in constant integral "
691 : "expression");
692 0 : goto eval_err;
693 : }
694 0 : *ret = 0;
695 0 : return boolval(r);
696 : eval_err:
697 0 : *ret = 1;
698 0 : return 0;
699 : }
|
