1 /* Copyright David Leonard & Andrew Janke, 2000. All rights reserved. */
2
3 #include <stdio.h>
4 #include <stdlib.h>
5 #include <math.h>
6 #include <limits.h>
7 #include <float.h>
8 #include "node.h"
9
10 #ifndef TRUE
11 # define TRUE 1
12 #endif
13
14 #ifndef FALSE
15 # define FALSE 0
16 #endif
17
18 #define INVALID_VALUE -DBL_MAX
19
20 scalar_t eval_index(int, int *, node_t, vector_t, scalar_t);
21 scalar_t eval_sum(int, int *, node_t, vector_t);
22 scalar_t eval_prod(int, int *, node_t, vector_t);
23 scalar_t eval_max(int, int *, node_t, vector_t, double, int);
24 vector_t eval_vector(int, int *, node_t, sym_t);
25 vector_t gen_vector(int, int *, node_t, sym_t);
26 vector_t gen_range(int, int *, node_t, sym_t);
27 scalar_t for_loop(int, int *, node_t n, sym_t sym);
28
29 extern int debug;
30 extern int propagate_nan;
31 extern double value_for_illegal_operations;
32
eval_error(node_t n,const char * msg)33 void eval_error(node_t n, const char *msg){
34 int pos = n->pos;
35 show_error(pos, msg);
36 }
37
show_error(int pos,const char * msg)38 void show_error(int pos, const char *msg){
39 extern const char *expression;
40 const char *c;
41 int thisline, ichar, linenum;
42
43 if (pos != -1) {
44 thisline = 0;
45 linenum=1;
46 for (ichar=0; ichar < pos; ichar++) {
47 if (expression[ichar] == '\n') {
48 thisline = ichar+1;
49 linenum++;
50 }
51 }
52 pos -= thisline;
53 fprintf(stderr, "\nLine %d:\n", linenum);
54 for (c = &expression[thisline]; *c && *c != '\n'; c++) {
55 (void) putc((int) *c, stderr);
56 }
57 (void) putc((int) '\n', stderr);
58 for (c = &expression[thisline]; *c; c++) {
59 if (pos-- == 0)
60 break;
61 if (*c == '\t') fprintf(stderr, "\t");
62 else fprintf(stderr, " ");
63 }
64 fprintf(stderr, "^\n");
65 }
66 fprintf(stderr, "%s\n", msg);
67 exit(1);
68 }
69
70 /* Try to evaluate an expression in a scalar context */
eval_scalar(int width,int * eval_flags,node_t n,sym_t sym)71 scalar_t eval_scalar(int width, int *eval_flags, node_t n, sym_t sym){
72 vector_t v;
73 scalar_t s, s2, result;
74 scalar_t args[3];
75 double vals[3];
76 int *eval_flags2, *isnan_flags;
77 int found_invalid, all_true, all_false;
78 int iarg, ivalue;
79
80 /* Check that node is of correct type */
81 if (!node_is_scalar(n)) {
82 eval_error(n, "Expression is not a scalar");
83 }
84
85 /* Check special case where all arguments are scalar and we can test
86 for invalid values in a general way */
87 if (n->flags & ALLARGS_SCALAR) {
88
89 /* Check that we don't have too many arguments */
90 if (n->numargs > (int) sizeof(args)/sizeof(args[0])) {
91 eval_error(n, "Internal error: too many arguments");
92 }
93
94 /* Evaluate each argument and save the result. */
95 for (iarg=0; iarg < n->numargs; iarg++) {
96 args[iarg] = eval_scalar(width, eval_flags, n->expr[iarg], sym);
97 }
98
99 /* Set up the result scalar. We re-use the first argument if
100 no one else is using it. */
101 if (n->numargs > 0 && args[0]->refcnt == 1) {
102 result = args[0];
103 scalar_incr_ref(result);
104 }
105 else {
106 result = new_scalar(width);
107 }
108
109 /* Loop over all values in scalar */
110 for (ivalue=0; ivalue < width; ivalue++) {
111
112 /* Check the eval flag */
113 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
114
115 /* Get the values, checking for invalid values. */
116 found_invalid = FALSE;
117 for (iarg=0; iarg < n->numargs; iarg++) {
118 vals[iarg] = args[iarg]->vals[ivalue];
119 if (vals[iarg] == INVALID_VALUE) {
120 found_invalid = TRUE;
121 }
122 }
123
124 /* Debug */
125 if (debug) {
126 (void) fprintf(stderr, "scalar %s:", node_name(n));
127 for (iarg=0; iarg < n->numargs; iarg++)
128 (void) fprintf(stderr, " %g", vals[iarg]);
129 (void) fprintf(stderr, "\n");
130 }
131
132 /* Check for an invalid value. If we are testing for them,
133 return 1.0, otherwise return an invalid value. */
134 if (found_invalid) {
135 result->vals[ivalue] =
136 ( (n->type == NODETYPE_ISNAN) ? 1.0 : INVALID_VALUE );
137 continue;
138 }
139
140 /* Do the operation */
141 switch (n->type) {
142 case NODETYPE_ADD:
143 result->vals[ivalue] = vals[0] + vals[1]; break;
144
145 case NODETYPE_SUB:
146 result->vals[ivalue] = vals[0] - vals[1]; break;
147
148 case NODETYPE_MUL:
149 result->vals[ivalue] = vals[0] * vals[1]; break;
150
151 case NODETYPE_DIV:
152 if (vals[1] == 0.0)
153 result->vals[ivalue] = value_for_illegal_operations;
154 else
155 result->vals[ivalue] = vals[0] / vals[1];
156 break;
157
158 case NODETYPE_LT:
159 result->vals[ivalue] = vals[0] < vals[1]; break;
160
161 case NODETYPE_LE:
162 result->vals[ivalue] = vals[0] <= vals[1]; break;
163
164 case NODETYPE_GT:
165 result->vals[ivalue] = vals[0] > vals[1]; break;
166
167 case NODETYPE_GE:
168 result->vals[ivalue] = vals[0] >= vals[1]; break;
169
170 case NODETYPE_EQ:
171 result->vals[ivalue] = vals[0] == vals[1]; break;
172
173 case NODETYPE_NE:
174 result->vals[ivalue] = vals[0] != vals[1]; break;
175
176 case NODETYPE_NOT:
177 result->vals[ivalue] = (vals[0] == 0.0); break;
178
179 case NODETYPE_AND:
180 result->vals[ivalue] = (vals[0] != 0.0) && (vals[1] != 0.0);
181 break;
182
183 case NODETYPE_OR:
184 result->vals[ivalue] = (vals[0] != 0.0) || (vals[1] != 0.0);
185 break;
186
187 case NODETYPE_ISNAN:
188 /* We only get here if the value is valid */
189 result->vals[ivalue] = 0.0; break;
190
191 case NODETYPE_POW:
192 result->vals[ivalue] = pow(vals[0], vals[1]); break;
193
194 case NODETYPE_SQRT:
195 if (vals[0] < 0.0)
196 result->vals[ivalue] = value_for_illegal_operations;
197 else
198 result->vals[ivalue] = sqrt(vals[0]);
199 break;
200
201 case NODETYPE_ABS:
202 result->vals[ivalue] = fabs(vals[0]); break;
203
204 case NODETYPE_EXP:
205 result->vals[ivalue] = exp(vals[0]); break;
206
207 case NODETYPE_LOG:
208 if (vals[0] <= 0.0)
209 result->vals[ivalue] = value_for_illegal_operations;
210 else
211 result->vals[ivalue] = log(vals[0]);
212 break;
213
214 case NODETYPE_SIN:
215 result->vals[ivalue] = sin(vals[0]); break;
216
217 case NODETYPE_COS:
218 result->vals[ivalue] = cos(vals[0]); break;
219
220 case NODETYPE_TAN:
221 result->vals[ivalue] = tan(vals[0]); break;
222
223 case NODETYPE_ASIN:
224 result->vals[ivalue] = asin(vals[0]); break;
225
226 case NODETYPE_ACOS:
227 result->vals[ivalue] = acos(vals[0]); break;
228
229 case NODETYPE_ATAN:
230 result->vals[ivalue] = atan(vals[0]); break;
231
232 case NODETYPE_CLAMP:
233 if (vals[0] < vals[1]) result->vals[ivalue] = vals[1];
234 else if (vals[0] > vals[2]) result->vals[ivalue] = vals[2];
235 else result->vals[ivalue] = vals[0];
236 break;
237
238 case NODETYPE_SEGMENT:
239 result->vals[ivalue] =
240 ( (vals[0] >= vals[1] && vals[0] <= vals[2]) ? 1.0 : 0.0);
241 break;
242
243 } /* switch on type */
244
245 } /* Loop over values of scalar */
246
247 /* Free the intermediate results */
248 for (iarg=0; iarg < n->numargs; iarg++) {
249 scalar_free(args[iarg]);
250 }
251
252 /* Return the result vector */
253 return result;
254
255 } /* If all args are scalar */
256
257 /* If we get here then we are not doing a simple scalar operation
258 and we have to handle invalid values on a case-by-case basis. */
259
260 switch (n->type) {
261 case NODETYPE_EXPRLIST:
262 if (node_is_scalar(n->expr[0])) {
263 s = eval_scalar(width, eval_flags, n->expr[0], sym);
264 scalar_free(s);
265 }
266 else {
267 v = eval_vector(width, eval_flags, n->expr[0], sym);
268 vector_free(v);
269 }
270 return eval_scalar(width, eval_flags, n->expr[1], sym);
271
272 case NODETYPE_INDEX:
273 v = eval_vector(width, eval_flags, n->expr[0], sym);
274 s = eval_scalar(width, eval_flags, n->expr[1], sym);
275 result = eval_index(width, eval_flags, n, v, s);
276 vector_free(v);
277 scalar_free(s);
278 return result;
279
280 case NODETYPE_SUM:
281 v = eval_vector(width, eval_flags, n->expr[0], sym);
282 s = eval_sum(width, eval_flags, n, v);
283 vector_free(v);
284 return s;
285
286 case NODETYPE_PROD:
287 v = eval_vector(width, eval_flags, n->expr[0], sym);
288 s = eval_prod(width, eval_flags, n, v);
289 vector_free(v);
290 return s;
291
292 case NODETYPE_AVG:
293 v = eval_vector(width, eval_flags, n->expr[0], sym);
294 s = eval_sum(width, eval_flags, n, v);
295 for (ivalue=0; ivalue < width; ivalue++) {
296 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
297 if (s->vals[ivalue] != INVALID_VALUE)
298 s->vals[ivalue] /= (double) v->len;
299 }
300 vector_free(v);
301 return s;
302
303 case NODETYPE_LEN:
304 v = eval_vector(width, eval_flags, n->expr[0], sym);
305 s = new_scalar(width);
306 for (ivalue=0; ivalue < width; ivalue++) {
307 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
308 s->vals[ivalue] = (double) v->len;
309 }
310 if (debug) {
311 (void) fprintf(stderr, "len : %d\n", v->len);
312 }
313 vector_free(v);
314 return s;
315
316 case NODETYPE_MAX:
317 v = eval_vector(width, eval_flags, n->expr[0], sym);
318 s = eval_max(width, eval_flags, n, v, 1.0, 0);
319 vector_free(v);
320 return s;
321
322 case NODETYPE_MIN:
323 v = eval_vector(width, eval_flags, n->expr[0], sym);
324 s = eval_max(width, eval_flags, n, v, -1.0, 0);
325 vector_free(v);
326 return s;
327
328 case NODETYPE_IMAX:
329 v = eval_vector(width, eval_flags, n->expr[0], sym);
330 s = eval_max(width, eval_flags, n, v, 1.0, 1);
331 vector_free(v);
332 return s;
333
334 case NODETYPE_IMIN:
335 v = eval_vector(width, eval_flags, n->expr[0], sym);
336 s = eval_max(width, eval_flags, n, v, -1.0, 1);
337 vector_free(v);
338 return s;
339
340 case NODETYPE_FOR:
341 return for_loop(width, eval_flags, n, sym);
342
343 case NODETYPE_IDENT:
344 s = sym_lookup_scalar(n->ident, sym);
345 if (s) {
346 scalar_incr_ref(s);
347 }
348 return s;
349
350 case NODETYPE_REAL:
351 s = new_scalar(width);
352 for (ivalue=0; ivalue < width; ivalue++) {
353 s->vals[ivalue] = n->real;
354 }
355 return s;
356
357 case NODETYPE_ASSIGN:
358 s = eval_scalar(width, eval_flags, n->expr[0], sym);
359 sym_set_scalar(width, eval_flags, s, n->ident, sym);
360 return s;
361
362 case NODETYPE_LET:
363 if (ident_is_scalar(n->ident)) {
364 s = eval_scalar(width, eval_flags, n->expr[0], sym);
365 sym_set_scalar(width, eval_flags, s, n->ident, sym);
366 scalar_free(s);
367 } else {
368 v = eval_vector(width, eval_flags, n->expr[0], sym);
369 sym_set_vector(width, eval_flags, v, n->ident, sym);
370 vector_free(v);
371 }
372 s = eval_scalar(width, eval_flags, n->expr[1], sym);
373 return s;
374
375 case NODETYPE_IFELSE:
376 /* Do the test */
377 s = eval_scalar(width, eval_flags, n->expr[0], sym);
378
379 /* Set the eval flags based on the results. Keep track of invalid
380 data in the expression - we will not evaluate either part in that
381 case. */
382 eval_flags2 = malloc(sizeof(eval_flags[0]) * width);
383 isnan_flags = malloc(sizeof(eval_flags[0]) * width);
384 all_true = TRUE;
385 all_false = TRUE;
386 for (ivalue=0; ivalue < width; ivalue++) {
387 isnan_flags[ivalue] = (s->vals[ivalue] == INVALID_VALUE);
388 eval_flags2[ivalue] = ((eval_flags == NULL ? 1 : eval_flags[ivalue])
389 && (s->vals[ivalue] != 0.0)
390 && (!isnan_flags[ivalue]));
391 if (eval_flags2[ivalue])
392 all_false = FALSE;
393 else
394 all_true = FALSE;
395 }
396 scalar_free(s);
397 if (all_true || all_false) {
398 free(eval_flags2);
399 eval_flags2 = NULL;
400 }
401
402 /* Evaluate the then part */
403 s = NULL;
404 if (!all_false) {
405 s = eval_scalar(width, eval_flags2, n->expr[1], sym);
406 }
407
408 /* Evaluate the else part if needed - remember to invert the flags */
409 s2 = NULL;
410 if (!all_true && n->numargs > 2) {
411 if (eval_flags2 != NULL) {
412 for (ivalue=0; ivalue < width; ivalue++)
413 eval_flags2[ivalue] =
414 !eval_flags2[ivalue] && !isnan_flags[ivalue];
415 }
416 s2 = eval_scalar(width, eval_flags2, n->expr[2], sym);
417 if (eval_flags2 != NULL) {
418 for (ivalue=0; ivalue < width; ivalue++)
419 eval_flags2[ivalue] =
420 !eval_flags2[ivalue] && !isnan_flags[ivalue];
421 }
422 }
423
424 /* Make sure that we have an answer */
425 if (s == NULL) {
426 if (s2 != NULL) {
427 s = s2;
428 s2 = NULL;
429 }
430 else {
431 s = new_scalar(width);
432 for (ivalue=0; ivalue < width; ivalue++)
433 s->vals[ivalue] = 0.0;
434 }
435 }
436
437 /* Merge the results */
438 if (eval_flags2 != NULL) {
439 for (ivalue=0; ivalue < width; ivalue++) {
440 if (!eval_flags2[ivalue]) {
441 s->vals[ivalue] =
442 (n->numargs > 2 ? s2->vals[ivalue] : 0.0);
443 }
444 }
445 }
446
447 /* Mark appropriate invalid values */
448 for (ivalue=0; ivalue < width; ivalue++) {
449 if (isnan_flags[ivalue]) {
450 s->vals[ivalue] = value_for_illegal_operations;
451 }
452 }
453
454
455 /* Free things and return */
456 if (s2 != NULL) scalar_free(s2);
457 if (eval_flags2 != NULL) free(eval_flags2);
458 if (isnan_flags != NULL) free(isnan_flags);
459 return s;
460
461 default:
462 eval_error(n, "expected a scalar value");
463 /* NOTREACHED */
464 return 0;
465 }
466 }
467
468 /* Index into a vector */
eval_index(int width,int * eval_flags,node_t n,vector_t v,scalar_t i)469 scalar_t eval_index(int width, int *eval_flags,
470 node_t n, vector_t v, scalar_t i){
471 scalar_t s;
472 int idx;
473 int ivalue;
474
475 s = new_scalar(width);
476 for (ivalue=0; ivalue < width; ivalue++) {
477 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
478 idx = SCALAR_ROUND(i->vals[ivalue]);
479 if (idx < 0 || idx >= v->len)
480 eval_error(n, "index out of bounds");
481 s->vals[ivalue] = v->el[idx]->vals[ivalue];
482 if (debug) (void) fprintf(stderr, "Index [%d] = %g\n",
483 idx, s->vals[ivalue]);
484 }
485 return s;
486 }
487
488 /* Perform a sum over the arguments */
eval_sum(int width,int * eval_flags,node_t n,vector_t v)489 scalar_t eval_sum(int width, int *eval_flags, node_t n, vector_t v)
490 {
491 int i, ivalue;
492 scalar_t result;
493 double value;
494 int found_invalid, found_valid;
495
496 result = new_scalar(width);
497 for (ivalue=0; ivalue < width; ivalue++) {
498 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
499 result->vals[ivalue] = 0.0;
500 found_invalid = found_valid = FALSE;
501 for (i = 0; i < v->len; i++) {
502 value = v->el[i]->vals[ivalue];
503 if (value == INVALID_VALUE)
504 found_invalid = TRUE;
505 else {
506 result->vals[ivalue] += value;
507 found_valid = TRUE;
508 }
509 }
510 if ((found_invalid && propagate_nan) || !found_valid) {
511 result->vals[ivalue] = value_for_illegal_operations;
512 }
513 }
514 return result;
515 }
516
517 /* Perform a product over the arguments */
eval_prod(int width,int * eval_flags,node_t n,vector_t v)518 scalar_t eval_prod(int width, int *eval_flags, node_t n, vector_t v)
519 {
520 int i, ivalue;
521 scalar_t result;
522 double value;
523 int found_invalid, found_valid;
524
525 result = new_scalar(width);
526 for (ivalue=0; ivalue < width; ivalue++) {
527 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
528 result->vals[ivalue] = 1.0;
529 found_invalid = found_valid = FALSE;
530 for (i = 0; i < v->len; i++) {
531 value = v->el[i]->vals[ivalue];
532 if (value == INVALID_VALUE)
533 found_invalid = TRUE;
534 else {
535 result->vals[ivalue] *= value;
536 found_valid = TRUE;
537 }
538 }
539 if ((found_invalid && propagate_nan) || !found_valid) {
540 result->vals[ivalue] = value_for_illegal_operations;
541 }
542 }
543 return result;
544 }
545
546 /* Find the maximum of a vector. Sign should be +1.0 for maxima search
547 and -1.0 for minima search.
548 type should be 0 for value and 1 for index */
eval_max(int width,int * eval_flags,node_t n,vector_t v,double sign,int type)549 scalar_t eval_max(int width, int *eval_flags,
550 node_t n, vector_t v, double sign, int type)
551 {
552 int i, ivalue;
553 scalar_t result;
554 double value, max, idx;
555
556 result = new_scalar(width);
557 for (ivalue=0; ivalue < width; ivalue++) {
558 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
559 result->vals[ivalue] = max = INVALID_VALUE;
560 for (i = 0; i < v->len; i++) {
561 value = v->el[i]->vals[ivalue];
562 if (value != INVALID_VALUE) {
563 if (max == INVALID_VALUE || (sign*(value-max) > 0.0)) {
564 max = value;
565 idx = (double)i;
566 }
567 }
568 }
569 result->vals[ivalue] = (type == 0) ? max : idx;
570 }
571 return result;
572 }
573
574 /* Evaluate an expression in a vector context */
eval_vector(int width,int * eval_flags,node_t n,sym_t sym)575 vector_t eval_vector(int width, int *eval_flags, node_t n, sym_t sym){
576 vector_t v, v2;
577 scalar_t s;
578 int ivalue, iel;
579 int *eval_flags2, *isnan_flags;
580 int all_true, all_false;
581
582 /* Check that node is of correct type */
583 if (node_is_scalar(n)) {
584 eval_error(n, "Expression is not a vector");
585 }
586
587 switch (n->type) {
588 case NODETYPE_EXPRLIST:
589 if (node_is_scalar(n->expr[0])) {
590 s = eval_scalar(width, eval_flags, n->expr[0], sym);
591 scalar_free(s);
592 }
593 else {
594 v = eval_vector(width, eval_flags, n->expr[0], sym);
595 vector_free(v);
596 }
597 return eval_vector(width, eval_flags, n->expr[1], sym);
598
599 case NODETYPE_ASSIGN:
600 v = eval_vector(width, eval_flags, n->expr[0], sym);
601 sym_set_vector(width, eval_flags, v, n->ident, sym);
602 return v;
603
604 case NODETYPE_LET:
605 if (ident_is_scalar(n->ident)) {
606 s = eval_scalar(width, eval_flags, n->expr[0], sym);
607 sym_set_scalar(width, eval_flags, s, n->ident, sym);
608 scalar_free(s);
609 } else {
610 v = eval_vector(width, eval_flags, n->expr[0], sym);
611 sym_set_vector(width, eval_flags, v, n->ident, sym);
612 vector_free(v);
613 }
614 v = eval_vector(width, eval_flags, n->expr[1], sym);
615 return v;
616
617 case NODETYPE_VEC2:
618 v = eval_vector(width, eval_flags, n->expr[0], sym);
619 s = eval_scalar(width, eval_flags, n->expr[1], sym);
620 vector_append(v, s);
621 scalar_free(s);
622 return v;
623
624 case NODETYPE_VEC1:
625 s = eval_scalar(width, eval_flags, n->expr[0], sym);
626 v = new_vector();
627 vector_append(v, s);
628 scalar_free(s);
629 return v;
630
631 case NODETYPE_GEN:
632 return gen_vector(width, eval_flags, n, sym);
633
634 case NODETYPE_RANGE:
635 return gen_range(width, eval_flags, n, sym);
636
637 case NODETYPE_IFELSE:
638 /* Do the test */
639 s = eval_scalar(width, eval_flags, n->expr[0], sym);
640
641 /* Set the eval flags based on the results */
642 eval_flags2 = malloc(sizeof(eval_flags[0]) * width);
643 isnan_flags = malloc(sizeof(eval_flags[0]) * width);
644 all_true = TRUE;
645 all_false = TRUE;
646 for (ivalue=0; ivalue < width; ivalue++) {
647 isnan_flags[ivalue] = (s->vals[ivalue] == INVALID_VALUE);
648 eval_flags2[ivalue] = ((eval_flags == NULL ? 1 : eval_flags[ivalue])
649 && (s->vals[ivalue] != 0.0)
650 && (!isnan_flags[ivalue]));
651 if (eval_flags2[ivalue])
652 all_false = FALSE;
653 else
654 all_true = FALSE;
655 }
656 scalar_free(s);
657 if (all_true || all_false) {
658 free(eval_flags2);
659 eval_flags2 = NULL;
660 }
661
662 /* Evaluate the then part */
663 v = NULL;
664 if (!all_false) {
665 v = eval_vector(width, eval_flags2, n->expr[1], sym);
666 }
667
668 /* Evaluate the else part if needed - remember to invert the flags */
669 v2 = NULL;
670 if (!all_true && n->numargs > 2) {
671 if (eval_flags2 != NULL) {
672 for (ivalue=0; ivalue < width; ivalue++)
673 eval_flags2[ivalue] =
674 !eval_flags2[ivalue] && !isnan_flags[ivalue];
675 }
676 v2 = eval_vector(width, eval_flags2, n->expr[2], sym);
677 if (eval_flags2 != NULL) {
678 for (ivalue=0; ivalue < width; ivalue++)
679 eval_flags2[ivalue] =
680 !eval_flags2[ivalue] && !isnan_flags[ivalue];
681 }
682 }
683
684 /* Make sure that we have an answer */
685 if (v == NULL) {
686 if (v2 != NULL) {
687 v = v2;
688 v2 = NULL;
689 }
690 else {
691 v = new_vector();
692 }
693 }
694
695 /* Merge the results */
696 if (v2 != NULL && v->len != v2->len) {
697 eval_error(n, "Vector expressions in if-else do not have the same length");
698 }
699 if (eval_flags2 != NULL) {
700 for (ivalue=0; ivalue < width; ivalue++) {
701 if (!eval_flags2[ivalue]) {
702 for (iel=0; iel < v->len; iel++) {
703 v->el[iel]->vals[ivalue] =
704 (n->numargs > 2 ? v2->el[iel]->vals[ivalue] : 0.0);
705 }
706 }
707 }
708 }
709
710 /* Mark appropriate invalid values */
711 for (ivalue=0; ivalue < width; ivalue++) {
712 if (isnan_flags[ivalue]) {
713 for (iel=0; iel < v->len; iel++) {
714 v->el[iel]->vals[ivalue] = value_for_illegal_operations;
715 }
716 }
717 }
718
719 /* Free things and return */
720 if (v2 != NULL) vector_free(v2);
721 if (eval_flags2 != NULL) free(eval_flags2);
722 if (isnan_flags != NULL) free(isnan_flags);
723 return v;
724
725 case NODETYPE_IDENT:
726 v = sym_lookup_vector(n->ident, sym);
727 if (v) {
728 vector_incr_ref(v);
729 return v;
730 }
731 /* fallthrough */
732 default:
733 /* XXX coerce scalar to vector! */
734 v = new_vector();
735 s = eval_scalar(width, eval_flags, n, sym);
736 vector_append(v, s);
737 scalar_free(s);
738 return v;
739 }
740 }
741
742 /* Generate a vector */
gen_vector(int width,int * eval_flags,node_t n,sym_t sym)743 vector_t gen_vector(int width, int *eval_flags, node_t n, sym_t sym){
744 int i;
745 scalar_t value;
746 ident_t ident;
747 node_t expr;
748 vector_t v;
749 vector_t els;
750
751 ident = n->ident;
752 if (!ident_is_scalar(ident))
753 eval_error(n, "expected scalar (lowercase) index as 1st arg");
754 els = eval_vector(width, eval_flags, n->expr[0], sym);
755 expr = n->expr[1];
756 v = new_vector();
757
758 for (i = 0; i < els->len; i++) {
759 value = els->el[i];
760 scalar_incr_ref(value);
761 sym_set_scalar(width, eval_flags, value, ident, sym);
762 scalar_free(value);
763 value = eval_scalar(width, eval_flags, expr, sym);
764 vector_append(v, value);
765 scalar_free(value);
766 }
767 vector_free(els);
768
769 return v;
770 }
771
772 /* Implement a for loop */
for_loop(int width,int * eval_flags,node_t n,sym_t sym)773 scalar_t for_loop(int width, int *eval_flags, node_t n, sym_t sym){
774 int i, ivalue;
775 scalar_t value;
776 ident_t ident;
777 node_t expr;
778 vector_t els;
779
780 ident = n->ident;
781 if (!ident_is_scalar(ident))
782 eval_error(n, "expected scalar (lowercase) index as 1st arg");
783 els = eval_vector(width, eval_flags, n->expr[0], sym);
784 expr = n->expr[1];
785
786 for (i = 0; i < els->len; i++) {
787 if (debug) {
788 (void) fprintf(stderr, "For loop iteration %d\n", i);
789 }
790 value = els->el[i];
791 scalar_incr_ref(value);
792 sym_set_scalar(width, eval_flags, value, ident, sym);
793 scalar_free(value);
794 value = eval_scalar(width, eval_flags, expr, sym);
795 scalar_free(value);
796 }
797 vector_free(els);
798
799 value = new_scalar(width);
800 for (ivalue=0; ivalue < width; ivalue++) {
801 value->vals[ivalue] = (double) i;
802 }
803 return value;
804 }
805
gen_range(int width,int * eval_flags,node_t n,sym_t sym)806 vector_t gen_range(int width, int *eval_flags, node_t n, sym_t sym){
807 int i, ivalue;
808 scalar_t start;
809 scalar_t stop;
810 vector_t v;
811 int length;
812
813 v = new_vector();
814 start = eval_scalar(width, eval_flags, n->expr[0], sym);
815 stop = eval_scalar(width, eval_flags, n->expr[1], sym);
816
817 for (ivalue = 0; ivalue < width; ivalue++) {
818
819 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
820
821 start->vals[ivalue] = SCALAR_ROUND(start->vals[ivalue]);
822 stop->vals[ivalue] = SCALAR_ROUND(stop->vals[ivalue]);
823
824 if (!(n->flags & RANGE_EXACT_LOWER))
825 start->vals[ivalue]++;
826 if (!(n->flags & RANGE_EXACT_UPPER))
827 stop->vals[ivalue]--;
828
829 if (ivalue == 0) {
830 length = stop->vals[ivalue] - start->vals[ivalue];
831 }
832 else if (length != (int) (stop->vals[ivalue] - start->vals[ivalue])) {
833 eval_error(n, "Vectors must have same size in vector generator");
834 }
835
836 }
837 length++;
838
839 scalar_free(stop);
840
841 for (i = 0; i < length ; i++) {
842 stop = new_scalar(width);
843 for (ivalue = 0; ivalue < width; ivalue++) {
844 if (eval_flags != NULL && !eval_flags[ivalue]) continue;
845 stop->vals[ivalue] = start->vals[ivalue] + i;
846 if (debug) {
847 (void) fprintf(stderr, "Range %d -> %d\n",
848 i, (int) stop->vals[ivalue]);
849 }
850 }
851 vector_append(v, stop);
852 scalar_free(stop);
853 }
854
855 scalar_free(start);
856
857 return v;
858
859 }
860