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 #if 0
 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 #endif
 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 }