gcc/ch/nloop.c

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