OSDN Git Service

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