gcc/ch/nloop.c

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