#include "gimplify.h"
#include "opts.h"
#include "common/common-target.h"
+#include "gomp-constants.h"
#include "stringpool.h"
#include "attribs.h"
tree loop_var;
tree low_bound;
tree high_bound;
+ tree omp_loop_clauses;
+ tree omp_construct_clauses;
+ enum tree_code omp_code;
vec<range_check_info, va_gc> *checks;
bool artificial;
};
return gnu_result;
}
\f
+
+/* If GNAT_EXPR is an N_Identifier, N_Integer_Literal or N_Operator_Symbol,
+ call FN on it. If GNAT_EXPR is an aggregate, call FN on each of its
+ elements. In both cases, pass GNU_EXPR and DATA as additional arguments.
+
+ This function is used everywhere OpenAcc pragmas are processed if these
+ pragmas can accept aggregates. */
+
+static tree
+Iterate_Acc_Clause_Arg (Node_Id gnat_expr, tree gnu_expr,
+ tree (*fn)(Node_Id, tree, void*),
+ void* data)
+{
+ switch (Nkind (gnat_expr))
+ {
+ case N_Aggregate:
+ if (Present (Expressions (gnat_expr)))
+ {
+ for (Node_Id gnat_list_expr = First (Expressions (gnat_expr));
+ Present (gnat_list_expr);
+ gnat_list_expr = Next (gnat_list_expr))
+ gnu_expr = fn (gnat_list_expr, gnu_expr, data);
+ }
+ else if (Present (Component_Associations (gnat_expr)))
+ {
+ for (Node_Id gnat_list_expr = First (Component_Associations
+ (gnat_expr));
+ Present (gnat_list_expr);
+ gnat_list_expr = Next (gnat_list_expr))
+ gnu_expr = fn (Expression (gnat_list_expr), gnu_expr, data);
+ }
+ else
+ gcc_unreachable();
+ break;
+ case N_Identifier:
+ case N_Integer_Literal:
+ case N_Operator_Symbol:
+ gnu_expr = fn (gnat_expr, gnu_expr, data);
+ break;
+ default:
+ gcc_unreachable();
+ }
+ return gnu_expr;
+}
+
+/* Same as gnat_to_gnu for a GNAT_NODE referenced within an OpenAcc directive,
+ undoing transformations that are inappropriate for such context. */
+
+tree
+Acc_gnat_to_gnu (Node_Id gnat_node)
+{
+ tree gnu_result = gnat_to_gnu (gnat_node);
+
+ /* If gnat_node is an identifier for a boolean, gnat_to_gnu might have
+ turned it into `identifier != 0`. Since arguments to OpenAcc pragmas
+ need to be writable, we need to return the identifier residing in such
+ expressions rather than the expression itself. */
+ if (Nkind (gnat_node) == N_Identifier
+ && TREE_CODE (gnu_result) == NE_EXPR
+ && TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_result, 0))) == BOOLEAN_TYPE
+ && integer_zerop (TREE_OPERAND (gnu_result, 1)))
+ gnu_result = TREE_OPERAND (gnu_result, 0);
+
+ return gnu_result;
+}
+
+/* Turn GNAT_EXPR into a tree node representing an OMP data clause and chain
+ it to GNU_CLAUSES, a list of pre-existing OMP clauses. GNAT_EXPR should be
+ a N_Identifier, this is enforced by the frontend.
+
+ This function is called every time translation of an argument for an OpenAcc
+ clause (e.g. Acc_Parallel(Copy => My_Identifier)) is needed. */
+
+static tree
+Acc_Data_to_gnu (Node_Id gnat_expr, tree gnu_clauses, void* data)
+{
+ tree gnu_clause;
+ enum gomp_map_kind kind = *((enum gomp_map_kind*) data);
+ gnu_clause = build_omp_clause (EXPR_LOCATION(gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_MAP);
+
+ gcc_assert (Nkind (gnat_expr) == N_Identifier);
+ OMP_CLAUSE_DECL (gnu_clause) =
+ gnat_to_gnu_entity (Entity (gnat_expr), NULL_TREE, false);
+
+ TREE_ADDRESSABLE (OMP_CLAUSE_DECL (gnu_clause)) = 1;
+ OMP_CLAUSE_SET_MAP_KIND (gnu_clause, kind);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ return gnu_clause;
+}
+
+/* Turn GNAT_EXPR into a tree node representing an OMP clause and chain it to
+ GNU_CLAUSES, a list of existing OMP clauses.
+
+ This function is used for parsing arguments of non-data clauses (e.g.
+ Acc_Parallel(Wait => gnatexpr)). */
+
+static tree
+Acc_Var_to_gnu (Node_Id gnat_expr, tree gnu_clauses, void* data)
+{
+ tree gnu_clause;
+ enum omp_clause_code kind = *((enum omp_clause_code*) data);
+ gnu_clause =
+ build_omp_clause (EXPR_LOCATION (gnu_loop_stack->last ()->stmt), kind);
+
+ OMP_CLAUSE_DECL (gnu_clause) = Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ return gnu_clause;
+}
+
+/* Turn GNAT_EXPR into a tree OMP clause representing a reduction clause.
+ GNAT_EXPR has to be a N_Identifier, this is enforced by the frontend.
+
+ For example, GNAT_EXPR could be My_Identifier in the following pragma:
+ Acc_Parallel(Reduction => ("+" => My_Identifier)). */
+
+static tree
+Acc_Reduc_Var_to_gnu (Node_Id gnat_expr, tree gnu_clauses, void* data)
+{
+ tree gnu_clause;
+ tree_code code = *((tree_code*) data);
+ gnu_clause = build_omp_clause (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_REDUCTION);
+ OMP_CLAUSE_DECL (gnu_clause) = Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_REDUCTION_CODE (gnu_clause) = code;
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ return gnu_clause;
+}
+
+/* Turn GNAT_EXPR into a list of OMP reduction clauses. GNAT_EXPR has to
+ follow the structure of a reduction clause, e.g. ("+" => Identifier). */
+
+static tree
+Acc_Reduc_to_gnu (Node_Id gnat_expr)
+{
+ tree gnu_clauses = NULL_TREE;
+ for (Node_Id gnat_op = First (Component_Associations (gnat_expr));
+ Present (gnat_op);
+ gnat_op = Next (gnat_op))
+ {
+ tree_code code = ERROR_MARK;
+ String_Id str = Strval (First (Choices (gnat_op)));
+ switch (Get_String_Char (str, 1))
+ {
+ case '+':
+ code = PLUS_EXPR;
+ break;
+ case '*':
+ code = MULT_EXPR;
+ break;
+ case 'm':
+ if (Get_String_Char (str, 2) == 'i'
+ && Get_String_Char (str, 3) == 'n')
+ code = MIN_EXPR;
+ else if (Get_String_Char (str, 2) == 'a'
+ && Get_String_Char (str, 3) == 'x')
+ code = MAX_EXPR;
+ break;
+ case 'a':
+ if (Get_String_Char (str, 2) == 'n'
+ && Get_String_Char (str, 3) == 'd')
+ code = TRUTH_ANDIF_EXPR;
+ break;
+ case 'o':
+ if (Get_String_Char (str, 2) == 'r')
+ code = TRUTH_ORIF_EXPR;
+ break;
+ default:
+ gcc_unreachable();
+ }
+ /* Unsupported reduction operation. This should have been
+ caught in sem_prag.adb. */
+ gcc_assert (code != ERROR_MARK);
+
+ gnu_clauses = Iterate_Acc_Clause_Arg (Expression (gnat_op),
+ gnu_clauses,
+ Acc_Reduc_Var_to_gnu,
+ &code);
+ }
+ return gnu_clauses;
+}
+
+/* Turn GNAT_EXPR, either '*' or an integer literal, into a tree_cons. This is
+ only used by Acc_Size_List_to_gnu. */
+
+static tree
+Acc_Size_Expr_to_gnu (Node_Id gnat_expr, tree gnu_clauses, void *)
+{
+ tree gnu_expr;
+
+ if (Nkind (gnat_expr) == N_Operator_Symbol
+ && Get_String_Char (Strval (gnat_expr), 1) == '*')
+ gnu_expr = integer_zero_node;
+ else
+ gnu_expr = Acc_gnat_to_gnu (gnat_expr);
+
+ return tree_cons (NULL_TREE, gnu_expr, gnu_clauses);
+}
+
+/* Turn GNAT_EXPR, an aggregate of either '*' or integer literals, into an OMP
+ clause node.
+
+ This function is used for the Tile clause of the Loop directive. This is
+ what GNAT_EXPR might look like: (1, 1, '*'). */
+
+static tree
+Acc_Size_List_to_gnu (Node_Id gnat_expr)
+{
+ tree gnu_clause;
+ tree gnu_list;
+
+ gnu_clause = build_omp_clause (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_TILE);
+ gnu_list = Iterate_Acc_Clause_Arg (gnat_expr, NULL_TREE,
+ Acc_Size_Expr_to_gnu,
+ NULL);
+ OMP_CLAUSE_TILE_LIST (gnu_clause) = nreverse (gnu_list);
+ return gnu_clause;
+}
+
/* Subroutine of gnat_to_gnu to process gnat_node, an N_Pragma. Return
any statements we generate. */
}
break;
+ case Pragma_Acc_Loop:
+ {
+ tree gnu_clauses = gnu_loop_stack->last ()->omp_loop_clauses;
+ if (!flag_openacc)
+ break;
+ if (!Present (Pragma_Argument_Associations (gnat_node)))
+ break;
+ for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
+ Present (gnat_temp);
+ gnat_temp = Next (gnat_temp))
+ {
+ Node_Id gnat_expr = Expression (gnat_temp);
+ tree gnu_clause = NULL_TREE;
+ enum omp_clause_code kind;
+
+ if (Chars (gnat_temp) == No_Name)
+ {
+ /* The clause is an identifier without a parameter. */
+ switch (Chars (gnat_expr))
+ {
+ case Name_Auto:
+ kind = OMP_CLAUSE_AUTO;
+ break;
+ case Name_Gang:
+ kind = OMP_CLAUSE_GANG;
+ break;
+ case Name_Independent:
+ kind = OMP_CLAUSE_INDEPENDENT;
+ break;
+ case Name_Seq:
+ kind = OMP_CLAUSE_SEQ;
+ break;
+ case Name_Vector:
+ kind = OMP_CLAUSE_VECTOR;
+ break;
+ case Name_Worker:
+ kind = OMP_CLAUSE_WORKER;
+ break;
+ default:
+ gcc_unreachable();
+ }
+ gnu_clause = build_omp_clause (EXPR_LOCATION
+ (gnu_loop_stack->last ()->stmt),
+ kind);
+ }
+ else
+ {
+ /* The clause is an identifier parameter(s). */
+ switch (Chars (gnat_temp))
+ {
+ case Name_Collapse:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_COLLAPSE);
+ OMP_CLAUSE_COLLAPSE_EXPR (gnu_clause) =
+ Acc_gnat_to_gnu (gnat_expr);
+ break;
+ case Name_Device_Type:
+ /* Unimplemented by GCC yet. */
+ gcc_unreachable();
+ break;
+ case Name_Independent:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_INDEPENDENT);
+ break;
+ case Name_Acc_Private:
+ kind = OMP_CLAUSE_PRIVATE;
+ gnu_clause = Iterate_Acc_Clause_Arg (gnat_expr, 0,
+ Acc_Var_to_gnu,
+ &kind);
+ break;
+ case Name_Reduction:
+ gnu_clause = Acc_Reduc_to_gnu (gnat_expr);
+ break;
+ case Name_Tile:
+ gnu_clause = Acc_Size_List_to_gnu (gnat_expr);
+ break;
+ case Name_Gang:
+ case Name_Vector:
+ case Name_Worker:
+ /* These are for the Loop+Kernel combination, which is
+ unimplemented by the frontend for now. */
+ default:
+ gcc_unreachable();
+ }
+ }
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ }
+ gnu_loop_stack->last ()->omp_loop_clauses = gnu_clauses;
+ }
+ break;
+ /* Grouping the transformation of these pragmas together makes sense
+ because they are mutually exclusive, share most of their clauses and
+ the verification that each clause can legally appear for the pragma has
+ been done in the frontend. */
+ case Pragma_Acc_Data:
+ case Pragma_Acc_Kernels:
+ case Pragma_Acc_Parallel:
+ {
+ if (!flag_openacc)
+ break;
+
+ tree gnu_clauses = gnu_loop_stack->last ()->omp_construct_clauses;
+ if (pragma_id == Pragma_Acc_Data)
+ gnu_loop_stack->last ()->omp_code = OACC_DATA;
+ else if (pragma_id == Pragma_Acc_Kernels)
+ gnu_loop_stack->last ()->omp_code = OACC_KERNELS;
+ else if (pragma_id == Pragma_Acc_Parallel)
+ gnu_loop_stack->last ()->omp_code = OACC_PARALLEL;
+ else
+ gcc_unreachable ();
+
+ if (!Present (Pragma_Argument_Associations (gnat_node)))
+ break;
+
+ for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
+ Present (gnat_temp);
+ gnat_temp = Next (gnat_temp))
+ {
+ Node_Id gnat_expr = Expression (gnat_temp);
+ tree gnu_clause;
+ enum omp_clause_code clause_code;
+ enum gomp_map_kind map_kind;
+
+ switch (Chars (gnat_temp))
+ {
+ case Name_Async:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_ASYNC);
+ OMP_CLAUSE_ASYNC_EXPR (gnu_clause) =
+ Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Num_Gangs:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_NUM_GANGS);
+ OMP_CLAUSE_NUM_GANGS_EXPR (gnu_clause) =
+ Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Num_Workers:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_NUM_WORKERS);
+ OMP_CLAUSE_NUM_WORKERS_EXPR (gnu_clause) =
+ Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Vector_Length:
+ gnu_clause = build_omp_clause
+ (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_VECTOR_LENGTH);
+ OMP_CLAUSE_VECTOR_LENGTH_EXPR (gnu_clause) =
+ Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Wait:
+ clause_code = OMP_CLAUSE_WAIT;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Var_to_gnu,
+ &clause_code);
+ break;
+
+ case Name_Acc_If:
+ gnu_clause = build_omp_clause (EXPR_LOCATION
+ (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_IF);
+ OMP_CLAUSE_IF_MODIFIER (gnu_clause) = ERROR_MARK;
+ OMP_CLAUSE_IF_EXPR (gnu_clause) = Acc_gnat_to_gnu (gnat_expr);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Copy:
+ map_kind = GOMP_MAP_FORCE_TOFROM;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Copy_In:
+ map_kind = GOMP_MAP_FORCE_TO;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Copy_Out:
+ map_kind = GOMP_MAP_FORCE_FROM;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Present:
+ map_kind = GOMP_MAP_FORCE_PRESENT;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Create:
+ map_kind = GOMP_MAP_FORCE_ALLOC;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Device_Ptr:
+ map_kind = GOMP_MAP_FORCE_DEVICEPTR;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Data_to_gnu,
+ &map_kind);
+ break;
+
+ case Name_Acc_Private:
+ clause_code = OMP_CLAUSE_PRIVATE;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Var_to_gnu,
+ &clause_code);
+ break;
+
+ case Name_First_Private:
+ clause_code = OMP_CLAUSE_FIRSTPRIVATE;
+ gnu_clauses = Iterate_Acc_Clause_Arg (gnat_expr, gnu_clauses,
+ Acc_Var_to_gnu,
+ &clause_code); break;
+
+ case Name_Default:
+ gnu_clause = build_omp_clause (EXPR_LOCATION
+ (gnu_loop_stack->last ()->stmt),
+ OMP_CLAUSE_DEFAULT);
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ /* The standard also accepts "present" but this isn't
+ implemented in GCC yet. */
+ OMP_CLAUSE_DEFAULT_KIND (gnu_clause) = OMP_CLAUSE_DEFAULT_NONE;
+ OMP_CLAUSE_CHAIN (gnu_clause) = gnu_clauses;
+ gnu_clauses = gnu_clause;
+ break;
+
+ case Name_Reduction:
+ gnu_clauses = Acc_Reduc_to_gnu(gnat_expr);
+ break;
+
+ case Name_Detach:
+ case Name_Attach:
+ case Name_Device_Type:
+ /* Unimplemented by GCC. */
+ default:
+ gcc_unreachable ();
+ }
+ }
+ gnu_loop_stack->last ()->omp_construct_clauses = gnu_clauses;
+ }
+ break;
+
case Pragma_Loop_Optimize:
for (gnat_temp = First (Pragma_Argument_Associations (gnat_node));
Present (gnat_temp);
return true;
}
-/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
- to a GCC tree, which is returned. */
+/* Helper for Loop_Statement_to_gnu to translate the body of a loop,
+ designated by GNAT_LOOP, to which an Acc_Loop pragma applies. The pragma
+ arguments might instruct us to collapse a nest of loops, where computation
+ statements are expected only within the innermost loop, as in:
+
+ for I in 1 .. 5 loop
+ pragma Acc_Parallel;
+ pragma Acc_Loop(Collapse => 3);
+ for J in 1 .. 8 loop
+ for K in 1 .. 4 loop
+ X (I, J, K) := Y (I, J, K) + 2;
+ end loop;
+ end loop;
+ end loop;
+
+ We expect the top of gnu_loop_stack to hold a pointer to the loop info
+ setup for the translation of GNAT_LOOP, which holds a pointer to the
+ initial gnu loop stmt node. We return the new gnu loop statement to
+ use. */
static tree
-Loop_Statement_to_gnu (Node_Id gnat_node)
+Acc_Loop_to_gnu (Node_Id gnat_loop)
{
- const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
- struct loop_info_d *gnu_loop_info = ggc_cleared_alloc<loop_info_d> ();
- tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
- NULL_TREE, NULL_TREE, NULL_TREE);
- tree gnu_loop_label = create_artificial_label (input_location);
- tree gnu_cond_expr = NULL_TREE, gnu_low = NULL_TREE, gnu_high = NULL_TREE;
- tree gnu_result;
+ const struct loop_info_d * const gnu_loop_info = gnu_loop_stack->last ();
+ tree gnu_loop_stmt = gnu_loop_info->stmt;
+
+ tree acc_loop = make_node (OACC_LOOP);
+ tree acc_bind_expr = NULL_TREE;
+ Node_Id cur_loop = gnat_loop;
+ int collapse_count = 1;
+ tree initv;
+ tree condv;
+ tree incrv;
+
+ /* Parse the pragmas, adding clauses to the current gnu_loop_stack through
+ side effects. */
+ for (Node_Id tmp = First (Statements (gnat_loop));
+ Present (tmp) && Nkind (tmp) == N_Pragma;
+ tmp = Next (tmp))
+ Pragma_to_gnu(tmp);
+
+ /* Find the number of loops that should be collapsed. */
+ for (tree tmp = gnu_loop_stack->last ()->omp_loop_clauses; tmp ;
+ tmp = OMP_CLAUSE_CHAIN (tmp))
+ if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_COLLAPSE)
+ collapse_count = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (tmp));
+ else if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_TILE)
+ collapse_count = list_length (OMP_CLAUSE_TILE_LIST (tmp));
+
+ initv = make_tree_vec (collapse_count);
+ condv = make_tree_vec (collapse_count);
+ incrv = make_tree_vec (collapse_count);
- /* Push the loop_info structure associated with the LOOP_STMT. */
- vec_safe_push (gnu_loop_stack, gnu_loop_info);
+ start_stmt_group ();
+ gnat_pushlevel ();
- /* Set location information for statement and end label. */
- set_expr_location_from_node (gnu_loop_stmt, gnat_node);
- Sloc_to_locus (Sloc (End_Label (gnat_node)),
- &DECL_SOURCE_LOCATION (gnu_loop_label));
- LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
+ /* For each nested loop that should be collapsed ... */
+ for (int count = 0; count < collapse_count; ++count)
+ {
+ Node_Id lps =
+ Loop_Parameter_Specification (Iteration_Scheme (cur_loop));
+ tree low =
+ Acc_gnat_to_gnu (Low_Bound (Discrete_Subtype_Definition (lps)));
+ tree high =
+ Acc_gnat_to_gnu (High_Bound (Discrete_Subtype_Definition (lps)));
+ tree variable =
+ gnat_to_gnu_entity (Defining_Identifier (lps), NULL_TREE, true);
+
+ /* Build the initial value of the variable of the invariant. */
+ TREE_VEC_ELT (initv, count) = build2 (MODIFY_EXPR,
+ TREE_TYPE (variable),
+ variable,
+ low);
+ add_stmt (TREE_VEC_ELT (initv, count));
+
+ /* Build the invariant of the loop. */
+ TREE_VEC_ELT (condv, count) = build2 (LE_EXPR,
+ boolean_type_node,
+ variable,
+ high);
+
+ /* Build the incrementation expression of the loop. */
+ TREE_VEC_ELT (incrv, count) =
+ build2 (MODIFY_EXPR,
+ TREE_TYPE (variable),
+ variable,
+ build2 (PLUS_EXPR,
+ TREE_TYPE (variable),
+ variable,
+ build_int_cst (TREE_TYPE (variable), 1)));
+
+ /* Don't process the innermost loop because its statements belong to
+ another statement group. */
+ if (count < collapse_count - 1)
+ /* Process the current loop's body. */
+ for (Node_Id stmt = First (Statements (cur_loop));
+ Present (stmt); stmt = Next (stmt))
+ {
+ /* If we are processsing the outermost loop, it is ok for it to
+ contain pragmas. */
+ if (Nkind (stmt) == N_Pragma && count == 0)
+ ;
+ /* The frontend might have inserted a N_Object_Declaration in the
+ loop's body to declare the iteration variable of the next loop.
+ It will need to be hoisted before the collapsed loops. */
+ else if (Nkind (stmt) == N_Object_Declaration)
+ Acc_gnat_to_gnu (stmt);
+ else if (Nkind (stmt) == N_Loop_Statement)
+ cur_loop = stmt;
+ /* Every other kind of statement is prohibited in collapsed
+ loops. */
+ else if (count < collapse_count - 1)
+ gcc_unreachable();
+ }
+ }
+ gnat_poplevel ();
+ acc_bind_expr = end_stmt_group ();
- /* Save the statement for later reuse. */
- gnu_loop_info->stmt = gnu_loop_stmt;
- gnu_loop_info->artificial = !Comes_From_Source (gnat_node);
+ /* Parse the innermost loop. */
+ start_stmt_group();
+ for (Node_Id stmt = First (Statements (cur_loop));
+ Present (stmt);
+ stmt = Next (stmt))
+ {
+ /* When the innermost loop is the only loop, do not parse the pragmas
+ again. */
+ if (Nkind (stmt) == N_Pragma && collapse_count == 1)
+ continue;
+ add_stmt (Acc_gnat_to_gnu (stmt));
+ }
+
+ TREE_TYPE (acc_loop) = void_type_node;
+ OMP_FOR_INIT (acc_loop) = initv;
+ OMP_FOR_COND (acc_loop) = condv;
+ OMP_FOR_INCR (acc_loop) = incrv;
+ OMP_FOR_BODY (acc_loop) = end_stmt_group ();
+ OMP_FOR_PRE_BODY (acc_loop) = NULL;
+ OMP_FOR_ORIG_DECLS (acc_loop) = NULL;
+ OMP_FOR_CLAUSES (acc_loop) = gnu_loop_stack->last ()->omp_loop_clauses;
+
+ BIND_EXPR_BODY (acc_bind_expr) = acc_loop;
+
+ return gnu_loop_stmt;
+}
+
+/* Helper for Loop_Statement_to_gnu, to translate the body of a loop not
+ subject to any sort of parallelization directive or restriction, designated
+ by GNAT_NODE.
+
+ We expect the top of gnu_loop_stack to hold a pointer to the loop info
+ setup for the translation, which holds a pointer to the initial gnu loop
+ stmt node. We return the new gnu loop statement to use.
+
+ We might also set *GNU_COND_EXPR_P to request a variant of the translation
+ scheme in Loop_Statement_to_gnu. */
+
+static tree
+Regular_Loop_to_gnu (Node_Id gnat_node, tree *gnu_cond_expr_p)
+{
+ struct loop_info_d * const gnu_loop_info = gnu_loop_stack->last ();
+ tree gnu_loop_stmt = gnu_loop_info->stmt;
+
+ const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
+ tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+
+ tree gnu_cond_expr = *gnu_cond_expr_p;
+
+ tree gnu_loop_label = LOOP_STMT_LABEL (gnu_loop_stmt);
/* Set the condition under which the loop must keep going.
For the case "LOOP .... END LOOP;" the condition is always true. */
gnu_loop_stmt = end_stmt_group ();
}
+ *gnu_cond_expr_p = gnu_cond_expr;
+
+ return gnu_loop_stmt;
+}
+
+/* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
+ to a GCC tree, which is returned. */
+
+static tree
+Loop_Statement_to_gnu (Node_Id gnat_node)
+{
+ struct loop_info_d *gnu_loop_info = ggc_cleared_alloc<loop_info_d> ();
+
+ tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
+ NULL_TREE, NULL_TREE, NULL_TREE);
+ tree gnu_cond_expr = NULL_TREE;
+ tree gnu_loop_label = create_artificial_label (input_location);
+ tree gnu_result;
+
+ /* Push the loop_info structure associated with the LOOP_STMT. */
+ vec_safe_push (gnu_loop_stack, gnu_loop_info);
+
+ /* Set location information for statement and end label. */
+ set_expr_location_from_node (gnu_loop_stmt, gnat_node);
+ Sloc_to_locus (Sloc (End_Label (gnat_node)),
+ &DECL_SOURCE_LOCATION (gnu_loop_label));
+ LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
+
+ /* Save the statement for later reuse. */
+ gnu_loop_info->stmt = gnu_loop_stmt;
+ gnu_loop_info->artificial = !Comes_From_Source (gnat_node);
+
+ /* Perform the core loop body translation. */
+ if (Is_OpenAcc_Loop (gnat_node))
+ gnu_loop_stmt = Acc_Loop_to_gnu (gnat_node);
+ else
+ gnu_loop_stmt = Regular_Loop_to_gnu (gnat_node, &gnu_cond_expr);
+
+ /* A gnat_node that has its OpenAcc_Environment flag set needs to be
+ offloaded. Note that the OpenAcc_Loop flag is not necessarily set. */
+ if (Is_OpenAcc_Environment (gnat_node))
+ {
+ tree_code code = gnu_loop_stack->last ()->omp_code;
+ tree tmp = make_node (code);
+ TREE_TYPE (tmp) = void_type_node;
+ if (code == OACC_PARALLEL || code == OACC_KERNELS)
+ {
+ OMP_BODY (tmp) = gnu_loop_stmt;
+ OMP_CLAUSES (tmp) = gnu_loop_stack->last ()->omp_construct_clauses;
+ }
+ else if (code == OACC_DATA)
+ {
+ OACC_DATA_BODY (tmp) = gnu_loop_stmt;
+ OACC_DATA_CLAUSES (tmp) =
+ gnu_loop_stack->last ()->omp_construct_clauses;
+ }
+ else
+ gcc_unreachable();
+ set_expr_location_from_node (tmp, gnat_node);
+ gnu_loop_stmt = tmp;
+ }
+
/* If we have an outer COND_EXPR, that's our result and this loop is its
"true" statement. Otherwise, the result is the LOOP_STMT. */
if (gnu_cond_expr)
projects / gcc.git / commitdiff