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