gcc/ch/loop.c

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