aboutsummaryrefslogtreecommitdiff
path: root/gcc/ch/nloop.c
diff options
context:
space:
mode:
authorPer Bothner <bothner@gcc.gnu.org>1998-08-27 13:51:39 -0700
committerPer Bothner <bothner@gcc.gnu.org>1998-08-27 13:51:39 -0700
commit80a093b29e752ac54172945174c7cd59cec1fd05 (patch)
tree878b128b0bfbd427bff598b9db9be9cbf462fbec /gcc/ch/nloop.c
parentfc5074d4c9e4e1877450249c436f7d8af846b12b (diff)
downloadgcc-80a093b29e752ac54172945174c7cd59cec1fd05.zip
gcc-80a093b29e752ac54172945174c7cd59cec1fd05.tar.gz
gcc-80a093b29e752ac54172945174c7cd59cec1fd05.tar.bz2
Migrate from devo/gcc/ch. From-SVN: r22034
Diffstat (limited to 'gcc/ch/nloop.c')
-rw-r--r--gcc/ch/nloop.c1244
1 files changed, 1244 insertions, 0 deletions
diff --git a/gcc/ch/nloop.c b/gcc/ch/nloop.c
new file mode 100644
index 0000000..ddd4aad
--- /dev/null
+++ b/gcc/ch/nloop.c
@@ -0,0 +1,1244 @@
+/* Implement looping actions for CHILL.
+ Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+
+This file is part of GNU CC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU CC; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <stdio.h>
+#include <limits.h>
+#include "config.h"
+#include "tree.h"
+#include "ch-tree.h"
+#include "lex.h"
+#include "flags.h"
+#include "actions.h"
+#include "input.h"
+#include "obstack.h"
+#include "assert.h"
+#include "rtl.h"
+
+/* if the user codes '-flocal-loop-counter' on the command line,
+ ch-actions.c (lang_decode_option) will set this flag. */
+int flag_local_loop_counter = 0;
+
+extern tree chill_truthvalue_conversion PROTO((tree));
+extern rtx emit_line_note PROTO((char *, int));
+extern void error PROTO((char *, ...));
+extern rtx expand_assignment PROTO((tree, tree, int, int));
+extern void save_expr_under_name PROTO((tree, tree));
+extern void stamp_nesting_label PROTO((tree));
+extern int int_fits_type_p PROTO((tree, tree));
+extern void warning PROTO((char *, ...));
+
+/* forward declarations */
+static int classify_loop PROTO((void));
+static int declare_temps PROTO((void));
+static int initialize_iter_var PROTO((void));
+static int maybe_skip_loop PROTO((void));
+static int top_loop_end_check PROTO((void));
+static int bottom_loop_end_check PROTO((void));
+static int increment_temps PROTO((void));
+static tree build_temporary_variable PROTO((char *, tree));
+static tree maybe_make_for_temp PROTO((tree, char *, tree));
+static tree chill_unsigned_type PROTO((tree));
+
+/* In terms of the parameters passed to build_loop_iterator,
+ * there are several types of loops. They are encoded by
+ * the ITER_TYPE enumeration.
+ *
+ * 1) DO FOR EVER; ... OD
+ * indicated by a NULL_TREE start_exp, step_exp and end_exp,
+ * condition == NULL, in_flag = 0, and ever_flag == 1 in the
+ * first ITERATOR.
+ *
+ * 2) DO WHILE cond; ... OD
+ * indicated by NULL_TREE start_exp, step_exp and end_exp,
+ * in_flag = 0, and condition != NULL.
+ *
+ * 3) DO; ... OD
+ * indicated by NULL_TREEs in start_exp, step_exp and end_exp,
+ * condition != NULL, in_flag == 0 and ever_flag == 0. This
+ * is not really a loop, but a compound statement.
+ *
+ * 4) DO FOR user_var := start_exp
+ * [DOWN] TO end_exp BY step_exp; ... DO
+ * indicated by non-NULL_TREE start_exp, step_exp and end_exp.
+ *
+ * 5) DO FOR user_var [DOWN] IN discrete_mode; ... OD
+ * indicated by in_flag == 1. start_exp is a non-NULL_TREE
+ * discrete mode, with an optional down_flag.
+ *
+ * 6) DO FOR user_var [DOWN] IN powerset_expr; ... OD
+ * indicated by in_flag == 1. start_exp is a non-NULL_TREE
+ * powerset mode, with an optional down_flag.
+ *
+ * 7) DO FOR user_var [DOWN] IN location; ... OD
+ * indicated by in_flag == 1. start_exp is a non-NULL_TREE
+ * location mode, with an optional down_flag.
+ */
+typedef enum
+{
+ DO_UNUSED,
+ DO_FOREVER,
+ DO_WHILE,
+ DO_OD,
+ DO_STEP,
+ DO_RANGE,
+ DO_POWERSET,
+ DO_LOC,
+ DO_LOC_VARYING
+} ITER_TYPE;
+
+
+typedef struct iterator
+{
+/* These variables only have meaning in the first ITERATOR structure. */
+ ITER_TYPE itype; /* type of this iterator */
+ int error_flag; /* TRUE if no loop was started due to
+ user error */
+ tree condition; /* WHILE condition expression */
+ int down_flag; /* TRUE if DOWN was coded */
+
+/* These variables have meaning in every ITERATOR structure. */
+ tree user_var; /* user's explicit iteration variable */
+ tree start_exp; /* user's start expression
+ or IN expression of a FOR .. IN*/
+ tree step_exp; /* user's step expression */
+ tree end_exp; /* user's end expression */
+ tree start_temp; /* temp holding evaluated start_exp */
+ tree end_temp; /* temp holding evaluated end_exp */
+ tree step_temp; /* temp holding evaluated step_exp */
+ tree powerset_temp; /* temp holding user's initial powerset expression */
+ tree loc_ptr_temp; /* temp holding count for LOC enumeration ptr */
+ tree iter_var; /* hidden variable for the loop */
+ tree iter_type; /* hidden variable's type */
+ tree base_type; /* LOC enumeration base type */
+ struct iterator *next; /* ptr to next iterator for this loop */
+} ITERATOR;
+
+/*
+ * There's an entry like this for each nested DO loop.
+ * The list is maintained by push_loop_block
+ * and pop_loop_block.
+ */
+typedef struct loop {
+ struct loop *nxt_level; /* pointer to enclosing loop */
+ ITERATOR *iter_list; /* iterators for the current loop */
+} LOOP;
+
+static LOOP *loop_stack = (LOOP *)0;
+
+#if 0
+
+Here is a CHILL DO FOR statement:
+
+DO FOR user_var := start_exp BY step_exp [DOWN] TO end_exp
+ WHILE condition;
+
+For this loop to be 'safe', like a Pascal FOR loop, the start,
+end, and increment expressions are computed once, before the
+assignment to the iteration variable and saved in temporaries,
+before the first assignment of the iteration variable, so the
+following works:
+
+ FOR i := (i+1) TO (i+10) DO
+
+To prevent changes to the start/end/step expressions from
+effecting the loop''s termination, and to make the loop end-check
+as simple as possible, we evaluate the step expression into
+a temporary and compute a hidden iteration count before entering
+the loop''s body. User code cannot effect the counter, and the
+end-loop check simply decrements the counter and checks for zero.
+
+The whole phrase FOR iter := ... TO end_exp can be repeated
+multiple times, with different user-iteration variables. This
+is discussed later.
+
+The loop counter calculations need careful design since a loop
+from MININT TO MAXINT must work, in the precision of integers.
+
+Here''s how it works, in C:
+
+ 0) The DO ... OD loop is simply a block with
+ its own scope.
+
+ 1) The DO FOR EVER is simply implemented:
+
+ loop_top:
+ .
+ . body of loop
+ .
+ goto loop_top
+ end_loop:
+
+ 2) The DO WHILE is also simple:
+
+
+ loop_top:
+ if (!condition) goto end_loop
+ .
+ . body of loop
+ .
+ goto loop_top
+ end_loop:
+
+
+ 3) The DO FOR [while condition] loop (no DOWN)
+
+ push a new scope,
+ decl iter_var
+
+ step_temp = step_exp
+ start_temp = start_exp
+ end_temp = end_exp
+ if (end_exp < start_exp) goto end_loop
+ /* following line is all unsigned arithmetic */
+ iter_var = (end_exp - start_exp + step_exp) / step_exp
+ user_var = start_temp
+ loop_top:
+ if (!condition) goto end_loop
+ .
+ . body of loop
+ .
+ iter_var--
+ if (iter_var == 0) goto end_loop
+ user_var += step_temp
+ goto loop_top
+ end_loop:
+ pop scope
+
+ 4) The proposed CHILL for [while condition] loop (with DOWN)
+
+ push a new scope,
+ decl iter
+ step_temp = step_exp
+ start_temp = start_exp
+ end_temp = end_exp
+ if (end_exp > start_exp) goto end_loop
+ /* following line is all unsigned arithmetic */
+ iter_var = (start_exp - end_exp + step_exp) / step_exp
+ user_var = start_temp
+ loop_top:
+ if (!condition) goto end_loop
+ .
+ . body of loop
+ .
+ iter_var--
+ if (iter_var == 0) goto end_loop
+ user_var -= step_temp
+ goto loop_top
+ end_loop:
+ pop scope
+
+
+ 5) The range loop, which iterates over a mode''s possible
+ values, works just like the above step loops, but with
+ the start and end values taken from the mode''s lower
+ and upper domain values.
+
+
+ 6) The FOR IN loop, where a location enumeration is
+ specified (see spec on page 81 of Z.200, bottom
+ of page 186):
+
+ push a new scope,
+ decl iter_var as an unsigned integer
+ loc_ptr_temp as pointer to a composite base type
+
+ if array is varying
+ iter_var = array''s length field
+ else
+ iter_var = sizeof array / sizeof base_type
+ loc_ptr_temp = &of highest or lowest indexable entry
+ loop_top:
+ if (!condition) goto end_loop
+ .
+ . body of loop
+ .
+ iter_var--
+ if (iter_var == 0) goto end_loop
+ loc_ptr_temp +/-= sizeof array base_type
+ goto loop_top
+ end_loop:
+ pop scope
+
+ 7) The DO FOR (DOWN) IN powerset_exp
+
+ push a new scope,
+ decl powerset_temp
+ decl iterator as basetype of powerset
+
+ powerset_temp := start_exp
+ loop_top:
+ /* if DOWN */
+ if (__flsetclrpowerset () == 0) goto end_loop;
+ /* not DOWN */
+ if (__ffsetclrpowerset () == 0) goto end_loop;
+ if (!condition) goto end_loop
+ .
+ . body of loop
+ .
+ goto loop_top
+ end_loop:
+ pop scope
+
+
+So, here''s the general DO FOR schema, as implemented here:
+
+ classify_loop -- what type of loop have we?
+ -- build_iterator does some of this, also
+ expand_start_loop -- start the loop''s control scope
+ -- start scope for synthesized loop variables
+ declare_temps -- create, initialize temporary variables
+ maybe_skip_loop -- skip loop if end conditions unsatisfiable
+ initialize_iter_var -- initialize the iteration counter
+ -- initialize user''s loop variable
+ expand_start_loop -- generate top-of-loop label
+ top_loop_end_check -- generate while code and/or
+ powerset find-a-bit function call
+ .
+ .
+ . user''s loop body code
+ .
+ .
+ bottom_loop_end_check -- exit if counter has become zero
+ increment_temps -- update temps for next iteration
+ expand_end_loop -- generate jump back to top of loop
+ expand_end_cond -- generate label for end of conditional
+ -- end of scope for synthesized loop variables
+ free_iterators -- free up iterator space
+
+When there are two or more iterator phrases, each of the
+above loop steps must act upon all iterators. For example,
+the 'increment_temps' step must increment all temporaries
+(associated with all iterators).
+
+ NOTE: Z.200, section 10.1 says that a block is ...
+ "the actions statement list in a do action, including any
+ loop counter and while control". This means that an exp-
+ ression in a WHILE control can include references to the
+ loop counters created for the loop''s exclusive use.
+ Example:
+
+ DCL a (1:10) INT;
+ DCL j INT;
+ DO FOR j IN a WHILE j > 0;
+ ...
+ OD;
+ The 'j' referenced in the while is the loc-identity 'j'
+ created inside the loop''s scope, and NOT the 'j' declared
+ before the loop.
+#endif
+
+/*
+ * The following routines are called directly by the
+ * CHILL parser.
+ */
+void
+push_loop_block ()
+{
+ LOOP *temp = (LOOP *)xmalloc (sizeof (LOOP));
+
+ /* push a new loop onto the stack */
+ temp->nxt_level = loop_stack;
+ temp->iter_list = (ITERATOR *)0;
+ loop_stack = temp;
+}
+
+void
+pop_loop_block ()
+{
+ LOOP *do_temp = loop_stack;
+ ITERATOR *ip;
+
+ /* pop loop block off the list */
+ loop_stack = do_temp->nxt_level;
+
+ /* free the loop's iterator blocks */
+ ip = do_temp->iter_list;
+ while (ip != NULL)
+ {
+ ITERATOR *temp = ip->next;
+ free (ip);
+ ip = temp;
+ }
+ free (do_temp);
+}
+
+void
+begin_loop_scope ()
+{
+ ITERATOR *firstp = loop_stack->iter_list;
+
+ if (pass < 2)
+ return;
+
+ /*
+ * We need to classify the loop and declare its temporaries
+ * here, so as to define them before the WHILE condition
+ * (if any) is parsed. The WHILE expression may refer to
+ * a temporary.
+ */
+ if (classify_loop ())
+ return;
+
+ if (firstp->itype != DO_OD)
+ declare_temps ();
+
+ clear_last_expr ();
+ push_momentary ();
+ expand_start_bindings (0);
+}
+
+
+void
+end_loop_scope (opt_label)
+ tree opt_label;
+{
+ if (opt_label)
+ possibly_define_exit_label (opt_label);
+ poplevel (0, 0, 0);
+
+ if (pass < 2)
+ return;
+
+ expand_end_bindings (getdecls (), kept_level_p (), 0);
+ pop_momentary ();
+}
+
+/* The iterator structure records all aspects of a
+ * 'FOR i := start [DOWN] TO end' clause or
+ * 'FOR i IN modename' or 'FOR i IN powerset' clause.
+ * It's saved on the iter_list of the current LOOP.
+ */
+void
+build_loop_iterator (user_var, start_exp, step_exp, end_exp,
+ down_flag, in_flag, ever_flag)
+ tree user_var, start_exp, step_exp, end_exp;
+ int down_flag, in_flag, ever_flag;
+{
+ ITERATOR *ip = (ITERATOR *)xmalloc (sizeof (ITERATOR));
+
+ /* chain this iterator onto the current loop */
+ if (loop_stack->iter_list == NULL)
+ loop_stack->iter_list = ip;
+ else
+ {
+ ITERATOR *temp = loop_stack->iter_list;
+ while (temp->next != NULL)
+ temp = temp->next;
+ temp->next = ip;
+ }
+
+ ip->itype = DO_UNUSED;
+ ip->user_var = user_var;
+ ip->start_exp = start_exp;
+ ip->step_exp = step_exp;
+ ip->end_exp = end_exp;
+ ip->condition = NULL_TREE;
+ ip->start_temp = NULL_TREE;
+ ip->end_temp = NULL_TREE;
+ ip->step_temp = NULL_TREE;
+ ip->down_flag = down_flag;
+ ip->powerset_temp = NULL_TREE;
+ ip->iter_var = NULL_TREE;
+ ip->iter_type = NULL_TREE;
+ ip->loc_ptr_temp = NULL_TREE;
+ ip->error_flag = 1; /* assume error will be found */
+ ip->next = (ITERATOR *)0;
+
+ if (ever_flag)
+ ip->itype = DO_FOREVER;
+ else if (in_flag && start_exp != NULL_TREE)
+ {
+ if (TREE_CODE (start_exp) == ERROR_MARK)
+ return;
+ if (TREE_CODE (TREE_TYPE (start_exp)) == SET_TYPE)
+ ip->itype = DO_POWERSET;
+ else if (discrete_type_p (TREE_TYPE (ip->start_exp)))
+ ip->itype = DO_RANGE;
+ else if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ARRAY_TYPE)
+ ip->itype = DO_LOC;
+ else if (chill_varying_type_p (TREE_TYPE (ip->start_exp)))
+ ip->itype = DO_LOC_VARYING;
+ else
+ {
+ error ("Loop's IN expression is not a composite object");
+ return;
+ }
+ }
+ else if (start_exp == NULL_TREE && end_exp == NULL_TREE
+ && step_exp == NULL_TREE && !down_flag)
+ ip->itype = DO_OD;
+ else
+ {
+ /* FIXME: Move this to the lexer? */
+#define CST_FITS_INT(NODE) (TREE_CODE(NODE) == INTEGER_CST &&\
+ int_fits_type_p (NODE, integer_type_node))
+
+ tree max_prec_type = integer_type_node;
+
+ if (! discrete_type_p (TREE_TYPE (ip->start_exp)))
+ {
+ error ("start expr must have discrete mode");
+ return;
+ }
+ if (TREE_CODE (TREE_TYPE (ip->start_exp)) == ENUMERAL_TYPE
+ && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->start_exp)))
+ {
+ error ("DO FOR start expression is a numbered SET");
+ return;
+ }
+ if (TREE_CODE (TREE_TYPE (ip->end_exp)) == ENUMERAL_TYPE
+ && CH_ENUM_IS_NUMBERED (TREE_TYPE (ip->end_exp)))
+ {
+ error ("TO expression is a numbered SET");
+ return;
+ }
+ /* Convert all three expressions to a common precision,
+ which is the largest precision they exhibit, but
+ INTEGER_CST nodes are built in the lexer as
+ long_integer_type nodes. We'll treat convert them to
+ integer_type_nodes if possible, for faster loop times. */
+
+ if (TYPE_PRECISION (max_prec_type) <
+ TYPE_PRECISION (TREE_TYPE (ip->start_exp))
+ && !CST_FITS_INT (ip->start_exp))
+ max_prec_type = TREE_TYPE (ip->start_exp);
+ if (! discrete_type_p (TREE_TYPE (ip->end_exp)))
+ {
+ error ("TO expr must have discrete mode");
+ return;
+ }
+ if (! CH_COMPATIBLE (ip->start_exp,
+ TREE_TYPE (ip->end_exp)))
+ {
+ error ("start expr and TO expr must be compatible");
+ return;
+ }
+ if (TYPE_PRECISION (max_prec_type) <
+ TYPE_PRECISION (TREE_TYPE (ip->end_exp))
+ && !CST_FITS_INT (ip->end_exp))
+ max_prec_type = TREE_TYPE (ip->end_exp);
+ if (ip->step_exp != NULL_TREE)
+ {
+ /* assure that default 'BY 1' gets a useful type */
+ if (ip->step_exp == integer_one_node)
+ ip->step_exp = convert (TREE_TYPE (ip->start_exp),
+ ip->step_exp);
+ if (! discrete_type_p (TREE_TYPE (ip->step_exp)))
+ {
+ error ("BY expr must have discrete mode");
+ return;
+ }
+ if (! CH_COMPATIBLE (ip->start_exp,
+ TREE_TYPE (ip->step_exp)))
+ {
+ error ("start expr and BY expr must be compatible");
+ return;
+ }
+ if (TYPE_PRECISION (max_prec_type) <
+ TYPE_PRECISION (TREE_TYPE (ip->step_exp))
+ && !CST_FITS_INT (ip->step_exp))
+ max_prec_type = TREE_TYPE (ip->step_exp);
+ }
+ if (TREE_CODE (ip->start_exp) == INTEGER_CST
+ && TREE_CODE (ip->end_exp) == INTEGER_CST
+ && compare_int_csts (ip->down_flag ? LT_EXPR : GT_EXPR,
+ ip->start_exp, ip->end_exp))
+ warning ("body of DO FOR will never execute");
+
+ ip->start_exp =
+ convert (max_prec_type, ip->start_exp);
+ ip->end_exp =
+ convert (max_prec_type, ip->end_exp);
+
+ if (ip->step_exp != NULL_TREE)
+ {
+ ip->step_exp =
+ convert (max_prec_type, ip->step_exp);
+
+ if (TREE_CODE (ip->step_exp) != INTEGER_CST)
+ {
+ /* generate runtime check for negative BY expr */
+ ip->step_exp =
+ check_range (ip->step_exp, ip->step_exp,
+ integer_zero_node, NULL_TREE);
+ }
+ else if (compare_int_csts (LE_EXPR, ip->step_exp, integer_zero_node))
+ {
+ error ("BY expression is negative or zero");
+ return;
+ }
+ }
+ ip->itype = DO_STEP;
+ }
+
+ ip->error_flag = 0; /* no errors! */
+}
+
+void
+build_loop_start (while_control, start_label)
+ tree while_control, start_label;
+{
+ ITERATOR *firstp = loop_stack->iter_list;
+
+ firstp->condition = while_control;
+
+ if (firstp->error_flag)
+ return;
+
+ /* We didn't know at begin_loop_scope time about the condition;
+ adjust iterator type now. */
+ if (firstp->itype == DO_OD && firstp->condition)
+ firstp->itype = DO_WHILE;
+
+ if (initialize_iter_var ())
+ return;
+
+ if (maybe_skip_loop ())
+ return;
+
+ /* use the label as an 'exit' label,
+ 'goto' needs another sort of label */
+ expand_start_loop (start_label != NULL_TREE);
+
+ if (top_loop_end_check ())
+ return;
+ emit_line_note (input_filename, lineno);
+}
+
+/*
+ * Called after the last action of the loop body
+ * has been parsed.
+ */
+void
+build_loop_end ()
+{
+ ITERATOR *ip = loop_stack->iter_list;
+
+ emit_line_note (input_filename, lineno);
+
+ if (ip->error_flag)
+ return;
+
+ if (bottom_loop_end_check ())
+ return;
+
+ if (increment_temps ())
+ return;
+
+ if (ip->itype != DO_OD)
+ {
+ expand_end_loop ();
+
+ for (; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_LOC_VARYING:
+ case DO_STEP:
+ expand_end_cond ();
+ break;
+ default:
+ break;
+ }
+ }
+ }
+}
+
+/*
+ * The rest of the routines in this file are called from
+ * the above three routines.
+ */
+static int
+classify_loop ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ firstp->error_flag = 0;
+ if (firstp->itype == DO_UNUSED || firstp->itype == DO_OD)
+ {
+ /* if we have just DO .. OD, do nothing - this is just a
+ BEGIN .. END without creating a new scope, and no looping */
+ if (firstp->condition != NULL_TREE)
+ firstp->itype = DO_WHILE;
+ else
+ firstp->itype = DO_OD;
+ }
+
+ /* Issue a warning if the any loop counter is mentioned more
+ than once in the iterator list. */
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ break;
+ case DO_STEP:
+ case DO_RANGE:
+ case DO_POWERSET:
+ case DO_LOC:
+ case DO_LOC_VARYING:
+ /* FIXME: check for name uniqueness */
+ break;
+ default:
+ ;
+ }
+ }
+ return firstp->error_flag;
+}
+
+/*
+ * Reserve space for any loop-control temporaries, initialize them
+ */
+static int
+declare_temps ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+ tree start_ptr;
+
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ break;
+ case DO_STEP:
+ ip->iter_type = chill_unsigned_type (TREE_TYPE (ip->start_exp));
+
+ /* create, initialize temporaries if expressions aren't constant */
+ ip->start_temp = maybe_make_for_temp (ip->start_exp, "for_start",
+ ip->iter_type);
+ ip->end_temp = maybe_make_for_temp (ip->end_exp, "for_end",
+ ip->iter_type);
+ /* this is just the step-expression */
+ ip->step_temp = maybe_make_for_temp (ip->step_exp, "for_step",
+ ip->iter_type);
+ goto do_step_range;
+
+ case DO_RANGE:
+ ip->iter_type = chill_unsigned_type_node;
+
+ ip->start_temp =
+ (ip->down_flag ? build_chill_upper : build_chill_lower)(TREE_TYPE (ip->start_exp));
+ ip->end_temp =
+ (ip->down_flag ? build_chill_lower : build_chill_upper)(TREE_TYPE (ip->start_exp));
+
+ ip->step_temp = integer_one_node;
+
+ do_step_range:
+ if (flag_local_loop_counter)
+ {
+ /* (re-)declare the user's iteration variable in the
+ loop's scope. */
+ tree id_node = ip->user_var;
+ IDENTIFIER_LOCAL_VALUE (id_node) = ip->user_var =
+ decl_temp1 (id_node, ip->iter_type, 0, NULL_TREE,
+ 0, 0);
+ }
+ else
+ {
+ /* in this case, it's a previously-declared
+ VAR_DECL node, checked in build_loop_iterator. */
+ if (TREE_CODE (ip->user_var) == IDENTIFIER_NODE)
+ ip->user_var = lookup_name (ip->user_var);
+ if (ip->user_var == NULL_TREE)
+ {
+ error ("loop identifier undeclared");
+ ip->error_flag = 1;
+ return 1;
+ }
+ }
+ ip->iter_var =
+ decl_temp1 (get_unique_identifier ("iter_var"),
+ ip->iter_type, 0, NULL_TREE, 0, 0);
+ break;
+
+ case DO_POWERSET:
+ ip->iter_type = chill_unsigned_type (
+ TYPE_DOMAIN (TREE_TYPE (ip->start_exp)));
+ if (flag_local_loop_counter)
+ {
+ /* declare the user's iteration variable in the loop's scope. */
+ /* in this case, it's just an IDENTIFIER_NODE */
+ ip->user_var =
+ decl_temp1 (ip->user_var, ip->iter_type, 0, NULL_TREE, 0, 0);
+ }
+ else
+ {
+ /* in this case, it's a previously-declared VAR_DECL node */
+ ip->user_var = lookup_name (ip->user_var);
+ }
+ /* the user's powerset-expression, evaluated and saved in a temp */
+ ip->powerset_temp = maybe_make_for_temp (ip->start_exp, "for_set",
+ TREE_TYPE (ip->start_exp));
+ mark_addressable (ip->powerset_temp);
+ break;
+
+ case DO_LOC:
+ case DO_LOC_VARYING:
+ ip->iter_type = chill_unsigned_type_node;
+ /* create the counter temp */
+ ip->iter_var =
+ build_temporary_variable ("iter_var", ip->iter_type);
+
+ if (!CH_LOCATION_P (ip->start_exp))
+ ip->start_exp
+ = decl_temp1 (get_unique_identifier ("iter_loc"),
+ TREE_TYPE (ip->start_exp), 0,
+ ip->start_exp, 0, 0);
+
+ if (ip->itype == DO_LOC)
+ {
+ tree array_type = TREE_TYPE (ip->start_exp);
+ tree ptr_type;
+ tree temp;
+
+ if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
+ {
+ error ("Can't iterate through array of BOOL");
+ ip->error_flag = 1;
+ return ip->error_flag;
+ }
+
+ /* FIXME: check for array type in ip->start_exp */
+
+ /* create pointer temporary */
+ ip->base_type = TREE_TYPE (array_type);
+ ptr_type = build_pointer_type (ip->base_type);
+ ip->loc_ptr_temp =
+ build_temporary_variable ("loc_ptr_tmp", ptr_type);
+
+ /* declare the user's iteration variable in
+ the loop's scope, as an expression, to be
+ passed to build_component_ref later */
+ save_expr_under_name (ip->user_var,
+ build1 (INDIRECT_REF, ip->base_type,
+ ip->loc_ptr_temp));
+
+ /* FIXME: see stor_layout */
+ ip->step_temp = size_in_bytes (ip->base_type);
+
+ temp = TYPE_DOMAIN (array_type);
+
+ /* pointer to first array entry to look at */
+ start_ptr = build1 (ADDR_EXPR, ptr_type, ip->start_exp);
+ mark_addressable (ip->start_exp);
+ ip->start_temp = ip->down_flag ?
+ fold (build (PLUS_EXPR, ptr_type,
+ start_ptr,
+ fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
+ fold (build (MINUS_EXPR, integer_type_node,
+ TYPE_MAX_VALUE (temp),
+ TYPE_MIN_VALUE (temp)))))))
+ : start_ptr;
+ }
+ else
+ {
+ tree array_length =
+ convert (integer_type_node,
+ build_component_ref (ip->start_exp, var_length_id));
+ tree array_type = TREE_TYPE (TREE_CHAIN (
+ TYPE_FIELDS (TREE_TYPE (ip->start_exp))));
+ tree array_data_ptr =
+ build_component_ref (ip->start_exp, var_data_id);
+ tree ptr_type;
+
+ if (TREE_CODE (TREE_TYPE (array_type)) == BOOLEAN_TYPE)
+ {
+ error ("Can't iterate through array of BOOL");
+ firstp->error_flag = 1;
+ return firstp->error_flag;
+ }
+
+ /* create pointer temporary */
+ ip->base_type = TREE_TYPE (array_type);
+ ptr_type = build_pointer_type (ip->base_type);
+ ip->loc_ptr_temp =
+ build_temporary_variable ("loc_ptr_temp", ptr_type);
+
+
+ /* declare the user's iteration variable in
+ the loop's scope, as an expression, to be
+ passed to build_component_ref later */
+ save_expr_under_name (ip->user_var,
+ build1 (INDIRECT_REF, ip->base_type,
+ ip->loc_ptr_temp));
+
+ /* FIXME: see stor_layout */
+ ip->step_temp = size_in_bytes (ip->base_type);
+
+ /* pointer to first array entry to look at */
+ start_ptr = build1 (ADDR_EXPR, ptr_type, array_data_ptr);
+ mark_addressable (array_data_ptr);
+ ip->start_temp = ip->down_flag ?
+ fold (build (PLUS_EXPR, ptr_type,
+ start_ptr,
+ fold (build (MULT_EXPR, integer_type_node, ip->step_temp,
+ fold (build (MINUS_EXPR, integer_type_node,
+ array_length,
+ integer_one_node))))))
+ : start_ptr;
+ }
+ default:
+ ;
+ }
+ }
+ return firstp->error_flag;
+}
+
+/*
+ * Initialize the hidden iteration-control variables,
+ * and the user's explicit loop variable.
+ */
+static int
+initialize_iter_var ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ break;
+ case DO_STEP:
+ case DO_RANGE:
+ {
+ tree count =
+ fold (build (PLUS_EXPR, ip->iter_type, integer_one_node,
+ fold (build (TRUNC_DIV_EXPR, ip->iter_type,
+ convert (ip->iter_type,
+ fold (build (MINUS_EXPR, ip->iter_type,
+ ip->down_flag ? ip->start_temp : ip->end_temp,
+ ip->down_flag ? ip->end_temp : ip->start_temp))),
+ ip->step_temp))));
+ /* initialize the loop's hidden counter variable */
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->iter_var, count));
+
+ /* initialize user's variable */
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->user_var, ip->start_temp));
+ }
+ break;
+ case DO_POWERSET:
+ break;
+ case DO_LOC:
+ {
+ tree array_type = TREE_TYPE (ip->start_exp);
+ tree array_length =
+ fold (build (TRUNC_DIV_EXPR, integer_type_node,
+ size_in_bytes (array_type),
+ size_in_bytes (TREE_TYPE (array_type))));
+
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->iter_var, array_length));
+ goto do_loc_common;
+ }
+
+ case DO_LOC_VARYING:
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->iter_var,
+ convert (integer_type_node,
+ build_component_ref (ip->start_exp, var_length_id))));
+
+ do_loc_common:
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->loc_ptr_temp,
+ ip->start_temp));
+ break;
+
+ default:
+ ;
+ }
+ }
+ return firstp->error_flag;
+}
+
+/* Generate code to skip the whole loop, if start expression not
+ * <= end expression (or >= for DOWN loops). This comparison must
+ * *NOT* be done in unsigned mode, or it will fail.
+ * Also, skip processing an empty VARYING array.
+ */
+static int
+maybe_skip_loop ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_STEP:
+ expand_start_cond (
+ build (ip->down_flag ? GE_EXPR : LE_EXPR,
+ TREE_TYPE (ip->start_exp),
+ ip->start_exp, ip->end_exp), 0);
+ break;
+
+ case DO_LOC_VARYING:
+ { tree array_length =
+ convert (integer_type_node,
+ build_component_ref (ip->start_exp, var_length_id));
+ expand_start_cond (
+ build (NE_EXPR, TREE_TYPE (array_length),
+ array_length, integer_zero_node), 0);
+ break;
+ }
+ default:
+ break;
+ }
+ }
+ return 0;
+}
+
+/*
+ * Check at the top of the loop for a termination
+ */
+static int
+top_loop_end_check ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ /* now, exit the loop if the condition isn't TRUE. */
+ if (firstp->condition)
+ {
+ expand_exit_loop_if_false (0,
+ chill_truthvalue_conversion (firstp->condition));
+ }
+
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ case DO_STEP:
+ case DO_RANGE:
+ break;
+ case DO_POWERSET:
+ {
+ tree temp1;
+ char *func_name;
+
+ if (ip->down_flag)
+ func_name = "__flsetclrpowerset";
+ else
+ func_name = "__ffsetclrpowerset";
+
+ temp1 = TYPE_MIN_VALUE
+ (TYPE_DOMAIN (TREE_TYPE (ip->powerset_temp)));
+ expand_exit_loop_if_false (0,
+ build_chill_function_call (lookup_name (get_identifier (func_name)),
+ tree_cons (NULL_TREE, force_addr_of (ip->powerset_temp),
+ tree_cons (NULL_TREE, powersetlen (ip->powerset_temp),
+ tree_cons (NULL_TREE, force_addr_of (ip->user_var),
+ tree_cons (NULL_TREE, size_in_bytes (TREE_TYPE (ip->user_var)),
+ tree_cons (NULL_TREE,
+ convert (long_integer_type_node, temp1),
+ NULL_TREE)))))));
+ }
+ break;
+ case DO_LOC:
+ case DO_LOC_VARYING:
+ break;
+ default:
+ ;
+ }
+ }
+ return firstp->error_flag;
+}
+
+/*
+ * Check generated temporaries for loop's end
+ */
+static int
+bottom_loop_end_check ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ emit_line_note (input_filename, lineno);
+
+ /* now, generate code to check each loop counter for termination */
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ break;
+ case DO_STEP:
+ case DO_RANGE:
+ case DO_LOC:
+ case DO_LOC_VARYING:
+ /* decrement iteration counter by one */
+ chill_expand_assignment (ip->iter_var, MINUS_EXPR, integer_one_node);
+ /* exit if it's zero */
+ expand_exit_loop_if_false (0,
+ build (NE_EXPR, boolean_type_node,
+ ip->iter_var,
+ integer_zero_node));
+ break;
+ case DO_POWERSET:
+ break;
+ default:
+ ;
+ }
+ }
+
+ return firstp->error_flag;
+}
+
+/*
+ * increment the loop-control variables.
+ */
+static int
+increment_temps ()
+{
+ ITERATOR *firstp = loop_stack->iter_list, *ip;
+
+ for (ip = firstp; ip != NULL; ip = ip->next)
+ {
+ switch (ip->itype)
+ {
+ case DO_FOREVER:
+ case DO_WHILE:
+ break;
+ case DO_STEP:
+ case DO_RANGE:
+ {
+ tree delta =
+ fold (build (ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
+ TREE_TYPE (ip->user_var), ip->user_var,
+ ip->step_temp));
+ expand_expr_stmt (
+ build_chill_modify_expr (ip->user_var, delta));
+ }
+ break;
+ case DO_LOC:
+ case DO_LOC_VARYING:
+ /* This statement uses the C semantics, so that
+ the pointer is actually incremented by the
+ length of the object pointed to. */
+#if 1
+ expand_expr_stmt (
+ build_modify_expr (ip->loc_ptr_temp,
+ ip->down_flag ? MINUS_EXPR : PLUS_EXPR,
+ integer_one_node));
+#else
+ {
+ enum tree_code op = ip->down_flag ? MINUS_EXPR : PLUS_EXPR;
+ tree el_type = TREE_TYPE (TREE_TYPE (ip->loc_ptr_temp));
+ chill_expand_assignment (ip->loc_ptr_temp, NOP_EXPR,
+ build (op,
+ TREE_TYPE (ip->loc_ptr_temp),
+ ip->loc_ptr_temp,
+ size_in_bytes (el_type)));
+ }
+#endif
+ break;
+ case DO_POWERSET:
+ break;
+ default:
+ ;
+ }
+ }
+ return firstp->error_flag;
+}
+
+/*
+ * Generate a (temporary) unique identifier_node of
+ * the form "__tmp_%s_%d"
+ */
+tree
+get_unique_identifier (lead)
+ char *lead;
+{
+ char idbuf [256];
+ static int idcount = 0;
+
+ sprintf (idbuf, "__tmp_%s_%d", lead ? lead : "", idcount++);
+ return get_identifier (idbuf);
+}
+
+/*
+ * build a temporary variable, given its NAME and TYPE.
+ * The name will have a number appended to assure uniqueness.
+ * return its DECL node.
+ */
+static tree
+build_temporary_variable (name, type)
+ char *name;
+ tree type;
+{
+ return decl_temp1 (get_unique_identifier (name), type, 0, NULL_TREE, 0, 0);
+}
+
+
+/*
+ * If the given expression isn't a constant, build a temp for it
+ * and evaluate the expression into the temp. Return the tree
+ * representing either the original constant expression or the
+ * temp which now contains the expression's value.
+ */
+static tree
+maybe_make_for_temp (exp, temp_name, exp_type)
+ tree exp;
+ char *temp_name;
+ tree exp_type;
+{
+ tree result = exp;
+
+ if (exp != NULL_TREE)
+ {
+ /* if exp isn't constant, create a temporary for its value */
+ if (TREE_CONSTANT (exp))
+ {
+ /* FIXME: assure that TREE_TYPE (result) == ip->exp_type */
+ result = convert (exp_type, exp);
+ }
+ else {
+ /* build temp, assign the value */
+ result = decl_temp1 (get_unique_identifier (temp_name), exp_type, 0,
+ exp, 0, 0);
+ }
+ }
+ return result;
+}
+
+
+/*
+ * Adapt the C unsigned_type function to CHILL - we need to
+ * account for any CHILL-specific integer types here. So far,
+ * the 16-bit integer type is the only one.
+ */
+static tree
+chill_unsigned_type (type)
+ tree type;
+{
+ extern tree chill_unsigned_type_node;
+ tree type1 = TYPE_MAIN_VARIANT (type);
+
+ if (type1 == chill_integer_type_node)
+ return chill_unsigned_type_node;
+ else
+ return unsigned_type (type);
+}