OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Gigi support for OpenACC pragmas

Browse Source 
Matching front-end bits to support Acc_Kernels, Acc_Parallel,
Acc_Loop and Acc_Data.

2018-12-03  Olivier Hainque  <hainque@adacore.com>

gcc/ada/

	* gcc-interface/lang.opt (fopenacc): New option for Ada.
	* gcc-interface/misc.c (gnat_handle_option): Handle it.
	* gcc-interface/trans.c (struct loop_info_d): Add OMP
	attributes.
	(Iterate_Acc_Clause_Arg, Acc_gnat_to_gnu): New functions,
	helpers for OpenACC pragmas processing in Pragma_to_gnu.
	(Acc_Var_to_gnu, Acc_Reduc_Var_to_gnu, Acc_Reduc_to_gnu):
	Likewise.
	(Acc_Size_Expr_to_gnu, Acc_Size_List_to_gnu): Likewise.
	(Pragma_Acc_Data_to_gnu): Likewise.
	(Pragma_to_gnu): Handle Pragma_Acc_Loop, Pragma_Acc_Data,
	Pragma_Acc_Kernels and Pragma_Acc_Parallel.
	(Acc_Loop_to_gnu, Regular_Loop_to_gnu): New functions. Helpers
	for ...
	(Loop_Statement_to_gnu): Rework to handle OpenACC loops.

From-SVN: r266748
This commit is contained in:
Olivier Hainque 2018-12-03 15:47:57 +00:00 committed by Pierre-Marie de Rodat
parent e663d4d985
commit 7beb2b9dd2
4 changed files with 739 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/ChangeLog
View File

@ -1,3 +1,21 @@
2018-12-03 Olivier Hainque <hainque@adacore.com>
* gcc-interface/lang.opt (fopenacc): New option for Ada.
* gcc-interface/misc.c (gnat_handle_option): Handle it.
* gcc-interface/trans.c (struct loop_info_d): Add OMP
attributes.
(Iterate_Acc_Clause_Arg, Acc_gnat_to_gnu): New functions,
helpers for OpenACC pragmas processing in Pragma_to_gnu.
(Acc_Var_to_gnu, Acc_Reduc_Var_to_gnu, Acc_Reduc_to_gnu):
Likewise.
(Acc_Size_Expr_to_gnu, Acc_Size_List_to_gnu): Likewise.
(Pragma_Acc_Data_to_gnu): Likewise.
(Pragma_to_gnu): Handle Pragma_Acc_Loop, Pragma_Acc_Data,
Pragma_Acc_Kernels and Pragma_Acc_Parallel.
(Acc_Loop_to_gnu, Regular_Loop_to_gnu): New functions. Helpers
for ...
(Loop_Statement_to_gnu): Rework to handle OpenACC loops.
2018-12-03 Olivier Hainque <hainque@adacore.com>
* gcc-interface/targtyps.c (MALLOC_OBSERVABLE_ALIGNMENT): Set to

4
gcc/ada/gcc-interface/lang.opt
View File

@ -100,4 +100,8 @@ fbuiltin-printf
Ada Undocumented
Ignored.
fopenacc
Ada LTO
; Documented in C but it should be: Enable OpenACC support
; This comment is to ensure we retain the blank line above.

1
gcc/ada/gcc-interface/misc.c
View File

@ -166,6 +166,7 @@ gnat_handle_option (size_t scode, const char *arg, HOST_WIDE_INT value,
/* These are handled by the front-end. */
break;
case OPT_fopenacc:
case OPT_fshort_enums:
case OPT_fsigned_char:
case OPT_funsigned_char:

736
gcc/ada/gcc-interface/trans.c
View File

@ -47,6 +47,7 @@
#include "gimplify.h"
#include "opts.h"
#include "common/common-target.h"
#include "gomp-constants.h"
#include "stringpool.h"
#include "attribs.h"
@ -196,6 +197,9 @@ struct GTY(()) loop_info_d {
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;
};
@ -1249,6 +1253,226 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
return gnu_result;
}
/* 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. */
@ -1309,6 +1533,274 @@ Pragma_to_gnu (Node_Id gnat_node)
}
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);
@ -2838,32 +3330,174 @@ independent_iterations_p (tree stmt_list)
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 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);
start_stmt_group ();
gnat_pushlevel ();
/* 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 ();
/* 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);
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;
tree gnu_low = NULL_TREE, gnu_high = NULL_TREE;
/* Push the loop_info structure associated with the LOOP_STMT. */
vec_safe_push (gnu_loop_stack, gnu_loop_info);
tree gnu_cond_expr = *gnu_cond_expr_p;
/* 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);
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. */
@ -3203,6 +3837,68 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
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)