OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / gcc / ch / nloop.c
1 /* Implement looping actions for CHILL.
2    Copyright (C) 1992, 1993, 1994, 2000
3    Free Software Foundation, Inc.
4
5 This file is part of GNU CC.
6
7 GNU CC is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU CC is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU CC; see the file COPYING.  If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 #include <stdio.h>
23 #include <limits.h>
24 #include "config.h"
25 #include "tree.h"
26 #include "ch-tree.h"
27 #include "lex.h"
28 #include "flags.h"
29 #include "actions.h"
30 #include "input.h"
31 #include "obstack.h"
32 #include "assert.h"
33 #include "rtl.h"
34
35 /* if the user codes '-flocal-loop-counter' on the command line,
36    ch-actions.c (lang_decode_option) will set this flag. */
37 int flag_local_loop_counter = 0;
38
39 extern tree chill_truthvalue_conversion PARAMS ((tree));
40 extern rtx  emit_line_note              PARAMS ((char *, int)); 
41 extern void error                       PARAMS ((char *, ...));
42 extern rtx  expand_assignment           PARAMS ((tree, tree, int, int));
43 extern void save_expr_under_name        PARAMS ((tree, tree));
44 extern void stamp_nesting_label         PARAMS ((tree));
45 extern int  int_fits_type_p             PARAMS ((tree, tree));
46 extern void warning                     PARAMS ((char *, ...));
47
48 /* forward declarations */
49 static int  classify_loop            PARAMS ((void));
50 static int  declare_temps            PARAMS ((void));
51 static int  initialize_iter_var      PARAMS ((void));
52 static int  maybe_skip_loop          PARAMS ((void));
53 static int  top_loop_end_check       PARAMS ((void));
54 static int  bottom_loop_end_check    PARAMS ((void));
55 static int  increment_temps          PARAMS ((void));
56 static tree build_temporary_variable PARAMS ((char *, tree));
57 static tree maybe_make_for_temp      PARAMS ((tree, char *, tree));
58 static tree chill_unsigned_type      PARAMS ((tree));
59 \f
60 /* In terms of the parameters passed to build_loop_iterator,
61  *   there are several types of loops.  They are encoded by
62  *   the ITER_TYPE enumeration.
63  *
64  *   1) DO FOR EVER; ... OD
65  *      indicated by a NULL_TREE start_exp, step_exp and end_exp,
66  *      condition == NULL, in_flag = 0, and ever_flag == 1 in the
67  *      first ITERATOR.
68  *
69  *   2) DO WHILE cond; ... OD
70  *      indicated by NULL_TREE start_exp, step_exp and end_exp, 
71  *      in_flag = 0, and condition != NULL.
72  *
73  *   3) DO; ... OD
74  *      indicated by NULL_TREEs in start_exp, step_exp and end_exp,
75  *      condition != NULL, in_flag == 0 and ever_flag == 0.  This
76  *      is not really a loop, but a compound statement.
77  *
78  *   4) DO FOR user_var := start_exp 
79  *         [DOWN] TO end_exp BY step_exp; ... DO
80  *      indicated by non-NULL_TREE start_exp, step_exp and end_exp.
81  *
82  *   5) DO FOR user_var [DOWN] IN discrete_mode; ... OD
83  *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
84  *      discrete mode, with an optional down_flag.
85  *
86  *   6) DO FOR user_var [DOWN] IN powerset_expr; ... OD
87  *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
88  *      powerset mode, with an optional down_flag.
89  *
90  *   7) DO FOR user_var [DOWN] IN location; ... OD
91  *      indicated by in_flag == 1.  start_exp is a non-NULL_TREE 
92  *      location mode, with an optional down_flag.
93  */
94 typedef enum 
95 {
96    DO_UNUSED,
97    DO_FOREVER,
98    DO_WHILE,
99    DO_OD,
100    DO_STEP,
101    DO_RANGE,
102    DO_POWERSET,
103    DO_LOC,
104    DO_LOC_VARYING 
105 } ITER_TYPE;
106
107
108 typedef struct iterator 
109 {
110 /* These variables only have meaning in the first ITERATOR structure. */
111   ITER_TYPE itype;                  /* type of this iterator */
112   int  error_flag;                  /* TRUE if no loop was started due to 
113                                        user error */
114   tree condition;                   /* WHILE condition expression */
115   int  down_flag;                   /* TRUE if DOWN was coded */
116
117 /* These variables have meaning in every ITERATOR structure. */
118   tree user_var;                    /* user's explicit iteration variable */
119   tree start_exp;                   /* user's start expression
120                                        or IN expression of a FOR .. IN*/
121   tree step_exp;                    /* user's step expression */
122   tree end_exp;                     /* user's end expression */
123   tree start_temp;                  /* temp holding evaluated start_exp */
124   tree end_temp;                    /* temp holding evaluated end_exp */
125   tree step_temp;                   /* temp holding evaluated step_exp */
126   tree powerset_temp;               /* temp holding user's initial powerset expression */
127   tree loc_ptr_temp;                /* temp holding count for LOC enumeration ptr */
128   tree iter_var;                    /* hidden variable for the loop */
129   tree iter_type;                   /* hidden variable's type */
130   tree base_type;                   /* LOC enumeration base type */
131   struct iterator *next;            /* ptr to next iterator for this loop */
132 } ITERATOR;
133
134 /*
135  * There's an entry like this for each nested DO loop.
136  * The list is maintained by push_loop_block
137  * and pop_loop_block.
138  */
139 typedef struct loop {
140   struct loop *nxt_level;   /* pointer to enclosing loop */
141   ITERATOR    *iter_list;   /* iterators for the current loop */
142 } LOOP;
143
144 static LOOP *loop_stack = (LOOP *)0;
145 \f
146 /*
147
148 Here is a CHILL DO FOR statement:
149
150 DO FOR user_var := start_exp BY step_exp [DOWN] TO end_exp 
151    WHILE condition;
152
153 For this loop to be 'safe', like a Pascal FOR loop, the start,
154 end, and increment expressions are computed once, before the
155 assignment to the iteration variable and saved in temporaries,
156 before the first assignment of the iteration variable, so the
157 following works:
158
159           FOR i := (i+1) TO (i+10) DO
160
161 To prevent changes to the start/end/step expressions from
162 effecting the loop's termination, and to make the loop end-check
163 as simple as possible, we evaluate the step expression into
164 a temporary and compute a hidden iteration count before entering 
165 the loop's body.  User code cannot effect the counter, and the
166 end-loop check simply decrements the counter and checks for zero.
167
168 The whole phrase FOR iter := ... TO end_exp can be repeated
169 multiple times, with different user-iteration variables.  This
170 is discussed later.
171
172 The loop counter calculations need careful design since a loop
173 from MININT TO MAXINT must work, in the precision of integers.
174
175 Here's how it works, in C:
176
177         0) The DO ... OD loop is simply a block with 
178            its own scope.  
179
180         1) The DO FOR EVER is simply implemented:
181
182            loop_top:
183                 .
184                 . body of loop
185                 .
186                 goto loop_top
187            end_loop:
188
189         2) The DO WHILE is also simple:
190
191
192            loop_top:
193                 if (!condition) goto end_loop
194                 .
195                 . body of loop
196                 .
197                 goto loop_top
198            end_loop:
199
200
201         3) The DO FOR [while condition] loop (no DOWN)
202
203         push a new scope,
204         decl iter_var
205
206                 step_temp = step_exp
207                 start_temp = start_exp
208                 end_temp = end_exp
209                 if (end_exp < start_exp) goto end_loop
210                 // following line is all unsigned arithmetic
211                 iter_var = (end_exp - start_exp + step_exp) / step_exp
212                 user_var = start_temp
213            loop_top:
214                 if (!condition) goto end_loop
215                 .
216                 . body of loop
217                 .
218                 iter_var--
219                 if (iter_var == 0) goto end_loop
220                 user_var += step_temp
221                 goto loop_top
222         end_loop:
223         pop scope
224
225         4) The proposed CHILL for [while condition] loop (with DOWN)
226
227         push a new scope,
228         decl iter
229                 step_temp = step_exp
230                 start_temp = start_exp
231                 end_temp = end_exp
232                 if (end_exp > start_exp) goto end_loop
233                 // following line is all unsigned arithmetic
234                 iter_var = (start_exp - end_exp + step_exp) / step_exp
235                 user_var = start_temp
236            loop_top:
237                 if (!condition) goto end_loop
238                 .
239                 . body of loop
240                 .
241                 iter_var--
242                 if (iter_var == 0) goto end_loop
243                 user_var -= step_temp
244                 goto loop_top
245             end_loop:
246         pop scope
247
248
249         5) The range loop, which iterates over a mode's possible
250            values, works just like the above step loops, but with
251            the start and end values taken from the mode's lower
252            and upper domain values.
253 \f
254
255         6) The FOR IN loop, where a location enumeration is
256            specified (see spec on page 81 of Z.200, bottom
257            of page 186):
258
259         push a new scope,
260         decl iter_var as an unsigned integer
261              loc_ptr_temp as pointer to a composite base type
262         
263                if array is varying
264                    iter_var = array's length field
265                else
266                    iter_var = sizeof array / sizeof base_type
267                loc_ptr_temp = &of highest or lowest indexable entry
268            loop_top:
269                 if (!condition) goto end_loop
270                 .
271                 . body of loop
272                 .
273                 iter_var--
274                 if (iter_var == 0) goto end_loop               
275                 loc_ptr_temp +/-= sizeof array base_type
276                 goto loop_top
277            end_loop:
278         pop scope
279
280         7) The DO FOR (DOWN) IN powerset_exp
281
282         push a new scope,
283         decl powerset_temp
284         decl iterator as basetype of powerset
285
286                 powerset_temp := start_exp
287            loop_top:
288                 // if DOWN
289                 if (__flsetclrpowerset () == 0) goto end_loop;
290                 // not DOWN
291                 if (__ffsetclrpowerset () == 0) goto end_loop;
292                 if (!condition) goto end_loop
293                 .
294                 . body of loop
295                 .
296                 goto loop_top
297            end_loop:
298         pop scope
299 \f
300
301 So, here's the general DO FOR schema, as implemented here:
302
303         classify_loop       -- what type of loop have we?
304                             -- build_iterator does some of this, also
305         expand_start_loop   -- start the loop's control scope
306         -- start scope for synthesized loop variables
307         declare_temps       -- create, initialize temporary variables
308         maybe_skip_loop     -- skip loop if end conditions unsatisfiable
309         initialize_iter_var -- initialize the iteration counter
310                             -- initialize user's loop variable
311         expand_start_loop   -- generate top-of-loop label
312         top_loop_end_check  -- generate while code and/or
313                                powerset find-a-bit function call
314         .
315         .
316         .  user's loop body code
317         .
318         .
319         bottom_loop_end_check  -- exit if counter has become zero
320         increment_temps     -- update temps for next iteration
321         expand_end_loop     -- generate jump back to top of loop
322         expand_end_cond     -- generate label for end of conditional
323         -- end of scope for synthesized loop variables
324         free_iterators      -- free up iterator space
325
326 When there are two or more iterator phrases, each of the
327 above loop steps must act upon all iterators.  For example,
328 the 'increment_temps' step must increment all temporaries
329 (associated with all iterators).
330
331  NOTE: Z.200, section 10.1 says that a block is ...
332        "the actions statement list in a do action, including any
333        loop counter and while control".  This means that an exp-
334        ression in a WHILE control can include references to the
335        loop counters created for the loop's exclusive use.  
336        Example:
337
338              DCL a (1:10) INT;
339              DCL j INT;
340              DO FOR j IN a WHILE j > 0;
341              ...
342              OD;
343        The 'j' referenced in the while is the loc-identity 'j'
344        created inside the loop's scope, and NOT the 'j' declared
345        before the loop.
346 */
347 \f
348 /*
349  * The following routines are called directly by the
350  * CHILL parser.
351  */
352 void
353 push_loop_block ()
354 {
355   LOOP *temp = (LOOP *)xmalloc (sizeof (LOOP));
356
357   /* push a new loop onto the stack */
358   temp->nxt_level = loop_stack;
359   temp->iter_list = (ITERATOR *)0;
360   loop_stack = temp;
361 }
362
363 void
364 pop_loop_block ()
365 {
366   LOOP *do_temp = loop_stack;
367   ITERATOR  *ip;
368
369   /* pop loop block off the list */
370   loop_stack = do_temp->nxt_level;
371
372   /* free the loop's iterator blocks */
373   ip = do_temp->iter_list;
374   while (ip != NULL)
375     {
376       ITERATOR *temp = ip->next;
377       free (ip);
378       ip = temp;
379     }
380   free (do_temp);
381 }
382 \f
383 void
384 begin_loop_scope ()
385 {
386   ITERATOR *firstp = loop_stack->iter_list;
387
388   if (pass < 2)
389     return;
390
391   /*
392    * We need to classify the loop and declare its temporaries
393    * here, so as to define them before the WHILE condition
394    * (if any) is parsed.  The WHILE expression may refer to
395    * a temporary.
396    */
397   if (classify_loop ())
398     return;
399
400   if (firstp->itype != DO_OD)
401     declare_temps ();
402   
403   clear_last_expr ();
404   push_momentary ();
405   expand_start_bindings (0);
406 }
407
408
409 void
410 end_loop_scope (opt_label)
411      tree opt_label;
412 {
413   if (opt_label)
414     possibly_define_exit_label (opt_label);
415   poplevel (0, 0, 0);
416
417   if (pass < 2)
418     return;
419
420   expand_end_bindings (getdecls (), kept_level_p (), 0);
421   pop_momentary ();
422 }
423 \f
424 /* The iterator structure records all aspects of a 
425  * 'FOR i := start [DOWN] TO end' clause or
426  * 'FOR i IN modename' or 'FOR i IN powerset' clause.
427  * It's saved on the iter_list of the current LOOP.
428  */
429 void
430 build_loop_iterator (user_var, start_exp, step_exp, end_exp, 
431                      down_flag, in_flag, ever_flag)
432      tree user_var, start_exp, step_exp, end_exp;
433      int  down_flag, in_flag, ever_flag;
434 {
435   ITERATOR *ip = (ITERATOR *)xmalloc (sizeof (ITERATOR));
436
437   /* chain this iterator onto the current loop */
438   if (loop_stack->iter_list == NULL)
439     loop_stack->iter_list = ip;
440   else
441     {
442       ITERATOR *temp = loop_stack->iter_list;
443       while (temp->next != NULL)
444         temp = temp->next;
445       temp->next = ip;
446     }
447
448   ip->itype         = DO_UNUSED;
449   ip->user_var      = user_var;
450   ip->start_exp     = start_exp;
451   ip->step_exp      = step_exp;
452   ip->end_exp       = end_exp;
453   ip->condition     = NULL_TREE;
454   ip->start_temp    = NULL_TREE;
455   ip->end_temp      = NULL_TREE;
456   ip->step_temp     = NULL_TREE;
457   ip->down_flag     = down_flag;
458   ip->powerset_temp = NULL_TREE;
459   ip->iter_var      = NULL_TREE;
460   ip->iter_type     = NULL_TREE;
461   ip->loc_ptr_temp  = NULL_TREE;
462   ip->error_flag    = 1;          /* assume error will be found */
463   ip->next          = (ITERATOR *)0;
464
465   if (ever_flag)
466     ip->itype = DO_FOREVER;
467   else if (in_flag && start_exp != NULL_TREE)
468     {
469       if (TREE_CODE (start_exp) == ERROR_MARK)
470         return;
471       if (TREE_CODE (TREE_TYPE (start_exp)) == SET_TYPE)
472         ip->itype = DO_POWERSET;
473       else if (discrete_type_p (TREE_TYPE (ip->start_exp)))
474         ip->itype = DO_RANGE;
475       else if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ARRAY_TYPE)
476         ip->itype = DO_LOC;
477       else if (chill_varying_type_p (TREE_TYPE (ip->start_exp)))
478         ip->itype = DO_LOC_VARYING;
479       else
480         {
481           error ("loop's IN expression is not a composite object");
482           return;
483         }
484     }
485   else if (start_exp == NULL_TREE && end_exp == NULL_TREE
486            && step_exp == NULL_TREE && !down_flag)
487     ip->itype = DO_OD;
488   else
489     {
490       /* FIXME: Move this to the lexer? */
491 #define CST_FITS_INT(NODE) (TREE_CODE(NODE) == INTEGER_CST &&\
492             int_fits_type_p (NODE, integer_type_node))
493
494       tree max_prec_type = integer_type_node;
495
496       if (! discrete_type_p (TREE_TYPE (ip->start_exp)))
497         {
498           error ("start expr must have discrete mode");
499           return;
500         }
501       if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ENUMERAL_TYPE
502           && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->start_exp)))
503         {
504           error ("DO FOR start expression is a numbered SET");
505           return;
506         }
507       if (TREE_CODE (TREE_TYPE (ip->end_exp)) == ENUMERAL_TYPE
508           && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->end_exp)))
509         {
510           error ("TO expression is a numbered SET");
511           return;
512         }
513       /* Convert all three expressions to a common precision,
514          which is the largest precision they exhibit, but
515          INTEGER_CST nodes are built in the lexer as
516          long_integer_type nodes.  We'll treat convert them to
517          integer_type_nodes if possible, for faster loop times. */
518
519       if (TYPE_PRECISION (max_prec_type) <
520             TYPE_PRECISION (TREE_TYPE (ip->start_exp))
521           && !CST_FITS_INT (ip->start_exp))
522         max_prec_type = TREE_TYPE (ip->start_exp);
523       if (! discrete_type_p (TREE_TYPE (ip->end_exp)))
524         {
525           error ("TO expr must have discrete mode");
526           return;
527         }
528       if (! CH_COMPATIBLE (ip->start_exp, 
529                            TREE_TYPE (ip->end_exp)))
530         {
531           error ("start expr and TO expr must be compatible");
532           return;
533         }
534       if (TYPE_PRECISION (max_prec_type) <
535             TYPE_PRECISION (TREE_TYPE (ip->end_exp))
536           && !CST_FITS_INT (ip->end_exp))
537         max_prec_type = TREE_TYPE (ip->end_exp);
538       if (ip->step_exp != NULL_TREE)
539         {
540           /* assure that default 'BY 1' gets a useful type */
541           if (ip->step_exp == integer_one_node)
542             ip->step_exp = convert (TREE_TYPE (ip->start_exp),
543                                     ip->step_exp);
544           if (! discrete_type_p (TREE_TYPE (ip->step_exp)))
545             {
546               error ("BY expr must have discrete mode");
547               return;
548             }
549           if (! CH_COMPATIBLE (ip->start_exp,
550                   TREE_TYPE (ip->step_exp)))
551             {
552               error ("start expr and BY expr must be compatible");
553               return;
554             }
555           if (TYPE_PRECISION (max_prec_type) <
556                 TYPE_PRECISION (TREE_TYPE (ip->step_exp))
557               && !CST_FITS_INT (ip->step_exp))
558             max_prec_type = TREE_TYPE (ip->step_exp);
559         }
560       if (TREE_CODE (ip->start_exp) == INTEGER_CST
561           && TREE_CODE (ip->end_exp) == INTEGER_CST
562           && compare_int_csts (ip->down_flag ? LT_EXPR : GT_EXPR,
563                                ip->start_exp, ip->end_exp))
564         warning ("body of DO FOR will never execute");
565
566       ip->start_exp = 
567         convert (max_prec_type, ip->start_exp);
568       ip->end_exp   = 
569         convert (max_prec_type, ip->end_exp);
570
571       if (ip->step_exp != NULL_TREE)
572         {
573           ip->step_exp =
574             convert (max_prec_type, ip->step_exp);
575
576           if (TREE_CODE (ip->step_exp) != INTEGER_CST)
577             {
578               /* generate runtime check for negative BY expr */
579               ip->step_exp = 
580                 check_range (ip->step_exp, ip->step_exp,
581                              integer_zero_node, NULL_TREE);
582             }
583           else if (compare_int_csts (LE_EXPR, ip->step_exp, integer_zero_node))
584             {
585               error ("BY expression is negative or zero");
586               return;
587             }
588         }
589       ip->itype = DO_STEP;
590     }
591
592   ip->error_flag = 0;           /* no errors! */
593 }
594 \f
595 void
596 build_loop_start (while_control, start_label)
597      tree while_control, start_label;
598 {
599   ITERATOR *firstp = loop_stack->iter_list;
600   
601   firstp->condition = while_control;
602
603   if (firstp->error_flag)
604     return;
605
606   /* We didn't know at begin_loop_scope time about the condition;
607      adjust iterator type now. */
608   if (firstp->itype == DO_OD && firstp->condition)
609     firstp->itype = DO_WHILE;
610
611   if (initialize_iter_var ())
612     return;
613   
614   if (maybe_skip_loop ())
615     return;
616
617   /* use the label as an 'exit' label, 
618      'goto' needs another sort of label */
619   expand_start_loop (start_label != NULL_TREE);
620   
621   if (top_loop_end_check ())
622     return;
623   emit_line_note (input_filename, lineno); 
624 }
625 \f
626 /*
627  * Called after the last action of the loop body
628  * has been parsed.
629  */
630 void
631 build_loop_end ()
632 {
633   ITERATOR *ip = loop_stack->iter_list;
634
635   emit_line_note (input_filename, lineno);
636
637   if (ip->error_flag)
638     return;
639
640   if (bottom_loop_end_check ())
641     return;
642
643   if (increment_temps ())
644     return;
645
646   if (ip->itype != DO_OD)
647     {
648       expand_end_loop ();
649
650       for (; ip != NULL; ip = ip->next)
651         {
652           switch (ip->itype)
653             {
654             case DO_LOC_VARYING:
655             case DO_STEP:
656               expand_end_cond ();
657               break;
658             default:
659               break;
660             }
661         }
662     }
663 }
664 \f
665 /*
666  * The rest of the routines in this file are called from
667  * the above three routines.
668  */
669 static int
670 classify_loop ()
671 {
672   ITERATOR *firstp = loop_stack->iter_list, *ip;
673
674   firstp->error_flag = 0;
675   if (firstp->itype == DO_UNUSED || firstp->itype == DO_OD)
676     {
677       /* if we have just DO .. OD, do nothing - this is just a 
678          BEGIN .. END without creating a new scope, and no looping  */
679       if (firstp->condition != NULL_TREE)
680         firstp->itype = DO_WHILE;
681       else
682         firstp->itype = DO_OD;
683     }
684   
685   /* Issue a warning if the any loop counter is mentioned more 
686      than once in the iterator list. */
687   for (ip = firstp; ip != NULL; ip = ip->next)
688     {
689       switch (ip->itype)
690         {
691         case DO_FOREVER:
692         case DO_WHILE:
693           break;
694         case DO_STEP:
695         case DO_RANGE:
696         case DO_POWERSET:
697         case DO_LOC:
698         case DO_LOC_VARYING:
699           /* FIXME: check for name uniqueness */
700           break;
701         default:
702           ;
703         }
704     }
705   return firstp->error_flag;
706 }
707 \f
708 /*
709  * Reserve space for any loop-control temporaries, initialize them
710  */
711 static int
712 declare_temps ()
713 {
714   ITERATOR *firstp = loop_stack->iter_list, *ip;
715   tree start_ptr;
716
717   for (ip = firstp; ip != NULL; ip = ip->next)
718     {
719       switch (ip->itype)
720         {
721         case DO_FOREVER:
722         case DO_WHILE:
723           break;
724         case DO_STEP:
725           ip->iter_type = chill_unsigned_type (TREE_TYPE (ip->start_exp));
726
727           /* create, initialize temporaries if expressions aren't constant */
728           ip->start_temp = maybe_make_for_temp (ip->start_exp, "for_start",
729                                                 ip->iter_type);
730           ip->end_temp = maybe_make_for_temp (ip->end_exp, "for_end",
731                                               ip->iter_type);
732           /* this is just the step-expression */
733           ip->step_temp    = maybe_make_for_temp (ip->step_exp, "for_step",
734                                                   ip->iter_type);
735           goto do_step_range;
736           
737         case DO_RANGE:
738           ip->iter_type = chill_unsigned_type_node;
739           
740           ip->start_temp =
741             (ip->down_flag ? build_chill_upper : build_chill_lower)(TREE_TYPE (ip->start_exp));
742           ip->end_temp =
743             (ip->down_flag ? build_chill_lower : build_chill_upper)(TREE_TYPE (ip->start_exp));
744           
745           ip->step_temp = integer_one_node;
746           
747         do_step_range:
748           if (flag_local_loop_counter)
749             {
750               /* (re-)declare the user's iteration variable in the 
751                  loop's scope. */
752               tree id_node = ip->user_var;
753               IDENTIFIER_LOCAL_VALUE (id_node) = ip->user_var = 
754                 decl_temp1 (id_node, ip->iter_type, 0, NULL_TREE,
755                             0, 0);
756             }
757           else
758             {
759               /* in this case, it's a previously-declared 
760                  VAR_DECL node, checked in build_loop_iterator. */
761               if (TREE_CODE (ip->user_var) == IDENTIFIER_NODE)
762                 ip->user_var = lookup_name (ip->user_var);
763               if (ip->user_var == NULL_TREE)
764                 {
765                   error ("loop identifier undeclared");
766                   ip->error_flag = 1;
767                   return 1;
768                 }
769             }
770           ip->iter_var = 
771             decl_temp1 (get_unique_identifier ("iter_var"),
772                         ip->iter_type, 0, NULL_TREE, 0, 0);
773           break;
774
775         case DO_POWERSET:
776           ip->iter_type = chill_unsigned_type (
777                             TYPE_DOMAIN (TREE_TYPE (ip->start_exp)));
778           if (flag_local_loop_counter)
779             {
780               /* declare the user's iteration variable in the loop's scope. */
781               /* in this case, it's just an IDENTIFIER_NODE */
782               ip->user_var = 
783                 decl_temp1 (ip->user_var, ip->iter_type, 0, NULL_TREE, 0, 0);
784             }
785           else
786             {
787               /* in this case, it's a previously-declared VAR_DECL node */
788               ip->user_var = lookup_name (ip->user_var);
789             }
790           /* the user's powerset-expression, evaluated and saved in a temp */
791           ip->powerset_temp = maybe_make_for_temp (ip->start_exp, "for_set",
792                                                  TREE_TYPE (ip->start_exp));
793           mark_addressable (ip->powerset_temp);
794           break;
795
796         case DO_LOC:
797         case DO_LOC_VARYING:
798           ip->iter_type = chill_unsigned_type_node;
799           /* create the counter temp */
800           ip->iter_var = 
801             build_temporary_variable ("iter_var", ip->iter_type);
802
803           if (!CH_LOCATION_P (ip->start_exp))
804             ip->start_exp
805               = decl_temp1 (get_unique_identifier ("iter_loc"),
806                             TREE_TYPE (ip->start_exp), 0,
807                             ip->start_exp, 0, 0);
808
809           if (ip->itype == DO_LOC)
810             {
811               tree array_type = TREE_TYPE (ip->start_exp);
812               tree ptr_type;
813               tree temp;
814               
815               if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
816                 {
817                   error ("can't iterate through array of BOOL");
818                   ip->error_flag = 1;
819                   return ip->error_flag;
820                 }
821               
822               /* FIXME: check for array type in ip->start_exp */
823
824               /* create pointer temporary */
825               ip->base_type = TREE_TYPE (array_type);
826               ptr_type = build_pointer_type (ip->base_type);
827               ip->loc_ptr_temp =
828                 build_temporary_variable ("loc_ptr_tmp", ptr_type);
829               
830               /* declare the user's iteration variable in 
831                  the loop's scope, as an expression, to be
832                  passed to build_component_ref later */
833               save_expr_under_name (ip->user_var, 
834                 build1 (INDIRECT_REF, ip->base_type, 
835                         ip->loc_ptr_temp));
836               
837               /* FIXME: see stor_layout */
838               ip->step_temp = size_in_bytes (ip->base_type);
839               
840               temp = TYPE_DOMAIN (array_type);
841
842               /* pointer to first array entry to look at */
843               start_ptr = build1 (ADDR_EXPR, ptr_type, ip->start_exp);
844               mark_addressable (ip->start_exp);
845               ip->start_temp = ip->down_flag ? 
846                 fold (build (PLUS_EXPR, ptr_type, 
847                              start_ptr,
848                   fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
849                     fold (build (MINUS_EXPR, integer_type_node,
850                                  TYPE_MAX_VALUE (temp),
851                                  TYPE_MIN_VALUE (temp)))))))
852                   : start_ptr;
853             }
854           else
855             {
856               tree array_length =
857                 convert (integer_type_node,
858                   build_component_ref (ip->start_exp, var_length_id));
859               tree array_type = TREE_TYPE (TREE_CHAIN (
860                         TYPE_FIELDS (TREE_TYPE (ip->start_exp))));
861               tree array_data_ptr = 
862                 build_component_ref (ip->start_exp, var_data_id);
863               tree ptr_type;
864               
865               if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
866                 {
867                   error ("Can't iterate through array of BOOL");
868                   firstp->error_flag = 1;
869                   return firstp->error_flag;
870                 }
871               
872               /* create pointer temporary */
873               ip->base_type = TREE_TYPE (array_type);
874               ptr_type = build_pointer_type (ip->base_type);
875               ip->loc_ptr_temp = 
876                 build_temporary_variable ("loc_ptr_temp", ptr_type);
877                                                            
878               
879               /* declare the user's iteration variable in 
880                  the loop's scope, as an expression, to be
881                  passed to build_component_ref later */
882               save_expr_under_name (ip->user_var, 
883                 build1 (INDIRECT_REF, ip->base_type, 
884                         ip->loc_ptr_temp));
885               
886               /* FIXME: see stor_layout */
887               ip->step_temp = size_in_bytes (ip->base_type);
888               
889               /* pointer to first array entry to look at */
890               start_ptr = build1 (ADDR_EXPR, ptr_type, array_data_ptr);
891               mark_addressable (array_data_ptr);
892               ip->start_temp = ip->down_flag ? 
893                 fold (build (PLUS_EXPR, ptr_type, 
894                   start_ptr,
895                     fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
896                       fold (build (MINUS_EXPR, integer_type_node,
897                                    array_length,
898                                    integer_one_node))))))
899                   : start_ptr;
900             }
901         default:
902           ;
903         }
904     }
905   return firstp->error_flag;
906 }
907 \f
908 /*
909  * Initialize the hidden iteration-control variables,
910  * and the user's explicit loop variable.
911  */
912 static int
913 initialize_iter_var ()
914 {
915   ITERATOR *firstp = loop_stack->iter_list, *ip;
916
917   for (ip = firstp; ip != NULL; ip = ip->next)
918     {
919       switch (ip->itype)
920         {
921         case DO_FOREVER:
922         case DO_WHILE:
923           break;
924         case DO_STEP:
925         case DO_RANGE:
926           {
927             tree count =
928               fold (build (PLUS_EXPR, ip->iter_type, integer_one_node,
929                   fold (build (TRUNC_DIV_EXPR, ip->iter_type, 
930                     convert (ip->iter_type,
931                       fold (build (MINUS_EXPR, ip->iter_type,
932                         ip->down_flag ? ip->start_temp : ip->end_temp,
933                         ip->down_flag ? ip->end_temp   : ip->start_temp))),
934                                ip->step_temp))));
935             /* initialize the loop's hidden counter variable */
936             expand_expr_stmt (
937               build_chill_modify_expr (ip->iter_var, count));
938
939             /* initialize user's variable */
940             expand_expr_stmt (
941               build_chill_modify_expr (ip->user_var, ip->start_temp));
942           }
943           break;
944         case DO_POWERSET:
945           break;
946         case DO_LOC:
947           {
948             tree array_type = TREE_TYPE (ip->start_exp);
949             tree array_length =
950               fold (build (TRUNC_DIV_EXPR, integer_type_node,
951                            size_in_bytes (array_type),
952                            size_in_bytes (TREE_TYPE (array_type))));
953
954             expand_expr_stmt (
955               build_chill_modify_expr (ip->iter_var, array_length));
956             goto do_loc_common;
957           }
958
959         case DO_LOC_VARYING:
960           expand_expr_stmt (
961             build_chill_modify_expr (ip->iter_var,
962               convert (integer_type_node,
963                 build_component_ref (ip->start_exp, var_length_id))));
964
965         do_loc_common:
966           expand_expr_stmt (
967             build_chill_modify_expr (ip->loc_ptr_temp, 
968                                      ip->start_temp));
969           break;
970
971         default:
972           ;
973         }
974     }
975   return firstp->error_flag;
976 }
977 \f
978 /* Generate code to skip the whole loop, if start expression not
979  * <= end expression (or >= for DOWN loops).  This comparison must
980  * *NOT* be done in unsigned mode, or it will fail.
981  *  Also, skip processing an empty VARYING array. 
982  */
983 static int
984 maybe_skip_loop ()
985 {
986   ITERATOR *firstp = loop_stack->iter_list, *ip;
987
988   for (ip = firstp; ip != NULL; ip = ip->next)
989     {
990       switch (ip->itype)
991         {
992         case DO_STEP:
993           expand_start_cond (
994             build (ip->down_flag ? GE_EXPR : LE_EXPR, 
995                    TREE_TYPE (ip->start_exp),
996                    ip->start_exp, ip->end_exp), 0);
997           break;
998     
999         case DO_LOC_VARYING:
1000           { tree array_length =
1001               convert (integer_type_node,
1002                 build_component_ref (ip->start_exp, var_length_id));
1003             expand_start_cond (
1004               build (NE_EXPR, TREE_TYPE (array_length),
1005                      array_length, integer_zero_node), 0);
1006             break;
1007           }
1008         default:
1009           break;
1010         }
1011     }
1012   return 0;
1013 }  
1014 \f
1015 /*
1016  * Check at the top of the loop for a termination
1017  */
1018 static int
1019 top_loop_end_check ()
1020 {
1021   ITERATOR *firstp = loop_stack->iter_list, *ip;
1022
1023   /* now, exit the loop if the condition isn't TRUE. */
1024   if (firstp->condition)
1025     {
1026       expand_exit_loop_if_false (0,
1027         chill_truthvalue_conversion (firstp->condition));
1028     }
1029
1030   for (ip = firstp; ip != NULL; ip = ip->next)
1031     {
1032       switch (ip->itype)
1033         {
1034         case DO_FOREVER:
1035         case DO_WHILE:
1036         case DO_STEP:
1037         case DO_RANGE:
1038           break;
1039         case DO_POWERSET:
1040           {
1041             tree temp1;
1042             char *func_name;
1043
1044             if (ip->down_flag)
1045               func_name = "__flsetclrpowerset";
1046             else
1047               func_name = "__ffsetclrpowerset";
1048             
1049             temp1 = TYPE_MIN_VALUE
1050               (TYPE_DOMAIN (TREE_TYPE (ip->powerset_temp)));
1051             expand_exit_loop_if_false (0,
1052               build_chill_function_call (lookup_name (get_identifier (func_name)),
1053                 tree_cons (NULL_TREE, force_addr_of (ip->powerset_temp),
1054                   tree_cons (NULL_TREE, powersetlen (ip->powerset_temp),
1055                     tree_cons (NULL_TREE, force_addr_of (ip->user_var),
1056                       tree_cons (NULL_TREE, size_in_bytes (TREE_TYPE (ip->user_var)),
1057                         tree_cons (NULL_TREE,
1058                                    convert (long_integer_type_node, temp1),
1059                                    NULL_TREE)))))));
1060           }
1061           break;
1062         case DO_LOC:
1063         case DO_LOC_VARYING:
1064           break;
1065         default:
1066           ;
1067         }
1068     }
1069   return firstp->error_flag;
1070 }
1071 \f
1072 /*
1073  * Check generated temporaries for loop's end
1074  */
1075 static int
1076 bottom_loop_end_check ()
1077 {
1078   ITERATOR *firstp = loop_stack->iter_list, *ip;
1079
1080   emit_line_note (input_filename, lineno);
1081
1082   /* now, generate code to check each loop counter for termination */
1083   for (ip = firstp; ip != NULL; ip = ip->next)
1084     {
1085       switch (ip->itype)
1086         {
1087         case DO_FOREVER:
1088         case DO_WHILE:
1089           break;
1090         case DO_STEP:
1091         case DO_RANGE:
1092         case DO_LOC:
1093         case DO_LOC_VARYING:
1094           /* decrement iteration counter by one */
1095           chill_expand_assignment (ip->iter_var, MINUS_EXPR, integer_one_node);
1096           /* exit if it's zero */
1097           expand_exit_loop_if_false (0,
1098             build (NE_EXPR, boolean_type_node, 
1099                    ip->iter_var,
1100                    integer_zero_node));
1101           break;
1102         case DO_POWERSET:
1103           break;
1104         default:
1105           ;
1106         }
1107     }
1108
1109   return firstp->error_flag;
1110 }
1111 \f
1112 /*
1113  * increment the loop-control variables.
1114  */
1115 static int
1116 increment_temps ()
1117 {
1118   ITERATOR *firstp = loop_stack->iter_list, *ip;
1119
1120   for (ip  = firstp; ip != NULL; ip = ip->next)
1121     {
1122       switch (ip->itype)
1123         {
1124         case DO_FOREVER:
1125         case DO_WHILE:
1126           break;
1127         case DO_STEP:
1128         case DO_RANGE:
1129           {
1130             tree delta =
1131               fold (build (ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
1132                            TREE_TYPE (ip->user_var), ip->user_var,
1133                            ip->step_temp));
1134             expand_expr_stmt (
1135               build_chill_modify_expr (ip->user_var, delta));
1136           }
1137           break;
1138         case DO_LOC:
1139         case DO_LOC_VARYING:
1140           /* This statement uses the C semantics, so that 
1141              the pointer is actually incremented by the 
1142              length of the object pointed to. */
1143 #if 1
1144           expand_expr_stmt (
1145             build_modify_expr (ip->loc_ptr_temp, 
1146                                ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
1147                                integer_one_node));
1148 #else
1149           {
1150             enum tree_code op = ip->down_flag ? MINUS_EXPR : PLUS_EXPR;
1151             tree el_type = TREE_TYPE (TREE_TYPE (ip->loc_ptr_temp));
1152             chill_expand_assignment (ip->loc_ptr_temp, NOP_EXPR,
1153                                      build (op,
1154                                             TREE_TYPE (ip->loc_ptr_temp),
1155                                             ip->loc_ptr_temp,
1156                                             size_in_bytes (el_type)));
1157           }
1158 #endif
1159           break;
1160         case DO_POWERSET:
1161           break;
1162         default:
1163           ;
1164         }
1165     }
1166   return firstp->error_flag;
1167 }
1168 \f
1169 /*
1170  * Generate a (temporary) unique identifier_node of
1171  * the form "__tmp_%s_%d"
1172  */
1173 tree
1174 get_unique_identifier (lead)
1175      char *lead;
1176 {
1177   char idbuf [256];
1178   static int idcount = 0;
1179
1180   sprintf (idbuf, "__tmp_%s_%d", lead ? lead : "", idcount++);
1181   return get_identifier (idbuf);
1182 }
1183 \f
1184 /*
1185  * build a temporary variable, given its NAME and TYPE.
1186  * The name will have a number appended to assure uniqueness.
1187  * return its DECL node.
1188  */
1189 static tree
1190 build_temporary_variable (name, type)
1191      char *name;
1192      tree type;
1193 {
1194   return decl_temp1 (get_unique_identifier (name), type, 0, NULL_TREE, 0, 0);
1195 }
1196
1197
1198 /*
1199  * If the given expression isn't a constant, build a temp for it
1200  * and evaluate the expression into the temp.  Return the tree
1201  * representing either the original constant expression or the
1202  * temp which now contains the expression's value. 
1203  */
1204 static tree
1205 maybe_make_for_temp (exp, temp_name, exp_type)
1206      tree exp;
1207      char *temp_name;
1208      tree exp_type;
1209 {
1210   tree result = exp;
1211
1212   if (exp != NULL_TREE)
1213     {
1214       /* if exp isn't constant, create a temporary for its value */
1215       if (TREE_CONSTANT (exp))
1216         {
1217           /* FIXME: assure that TREE_TYPE (result) == ip->exp_type */
1218           result = convert (exp_type, exp);
1219         }
1220       else {
1221         /* build temp, assign the value */
1222         result = decl_temp1 (get_unique_identifier (temp_name), exp_type, 0,
1223                              exp, 0, 0);
1224       }
1225     }
1226   return result;
1227 }
1228
1229
1230 /*
1231  * Adapt the C unsigned_type function to CHILL - we need to
1232  * account for any CHILL-specific integer types here.  So far,
1233  * the 16-bit integer type is the only one.
1234  */
1235 static tree
1236 chill_unsigned_type (type)
1237      tree type;
1238 {
1239   extern tree chill_unsigned_type_node;
1240   tree type1 = TYPE_MAIN_VARIANT (type);
1241
1242   if (type1 == chill_integer_type_node)
1243     return chill_unsigned_type_node;
1244   else
1245     return unsigned_type (type);
1246 }