MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Remove OpenACC support

Browse Source 
2020-06-04  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* back_end.adb, opt.ads, par-prag.adb, sem_ch5.adb,
	sem_prag.adb, sinfo.adb, sinfo.ads, snames.ads-tmpl,
	doc/gnat_rm/implementation_defined_pragmas.rst: Remove
	experimental support for OpenACC.
	* gcc-interface/misc.c, gcc-interface/trans.c,
	gcc-interface/lang.opt: Ditto.
	* gnat_rm.texi: Regenerate.

gcc/testsuite/

	* gnat.dg/openacc1.adb: Remove testcase.
This commit is contained in:
Arnaud Charlet 2020-01-26 15:32:43 -05:00 committed by Pierre-Marie de Rodat
parent a6b37ab0ac
commit e5e53c73a0
14 changed files with 836 additions and 2677 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gcc/ada/back_end.adb
View File

@ -385,9 +385,6 @@ package body Back_End is
elsif Is_Front_End_Switch (Argv) then
Scan_Front_End_Switches (Argv, Args, Next_Arg);
elsif Argv (Argv'First + 1 .. Argv'Last) = "fopenacc" then
Opt.OpenAcc_Enabled := True;
-- All non-front-end switches are back-end switches
else

152
gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
View File

@ -89,158 +89,6 @@ Syntax:
For the semantics of this pragma, see the entry for aspect ``Abstract_State`` in
the SPARK 2014 Reference Manual, section 7.1.4.
Pragma Acc_Parallel
===================
Syntax:
.. code-block:: ada
pragma Acc_Parallel [( ACC_PARALLEL_CLAUSE [, ACC_PARALLEL_CLAUSE... ])];
ACC_PARALLEL_CLAUSE ::=
Acc_If => boolean_EXPRESSION
| Acc_Private => IDENTIFIERS
| Async => integer_EXPRESSION
| Copy => IDENTIFIERS
| Copy_In => IDENTIFIERS
| Copy_Out => IDENTIFIERS
| Create => IDENTIFIERS
| Default => None
| Device_Ptr => IDENTIFIERS
| First_Private => IDENTIFIERS
| Num_Gangs => integer_EXPRESSION
| Num_Workers => integer_EXPRESSION
| Present => IDENTIFIERS
| Reduction => (REDUCTION_RECORD)
| Vector_Length => integer_EXPRESSION
| Wait => INTEGERS
REDUCTION_RECORD ::=
"+" => IDENTIFIERS
| "*" => IDENTIFIERS
| "min" => IDENTIFIERS
| "max" => IDENTIFIERS
| "or" => IDENTIFIERS
| "and" => IDENTIFIERS
IDENTIFIERS ::=
| IDENTIFIER
| (IDENTIFIER, IDENTIFIERS)
INTEGERS ::=
| integer_EXPRESSION
| (integer_EXPRESSION, INTEGERS)
Requires the :switch:`-fopenacc` flag.
Equivalent to the ``parallel`` directive of the OpenAcc standard. This pragma
should be placed in loops. It offloads the content of the loop to an
accelerator device.
For more information about the effect of the clauses, see the OpenAcc
specification.
Pragma Acc_Loop
===============
Syntax:
.. code-block:: ada
pragma Acc_Loop [( ACC_LOOP_CLAUSE [, ACC_LOOP_CLAUSE... ])];
ACC_LOOP_CLAUSE ::=
Auto
| Collapse => INTEGER_LITERAL
| Gang [=> GANG_ARG]
| Independent
| Private => IDENTIFIERS
| Reduction => (REDUCTION_RECORD)
| Seq
| Tile => SIZE_EXPRESSION
| Vector [=> integer_EXPRESSION]
| Worker [=> integer_EXPRESSION]
GANG_ARG ::=
integer_EXPRESSION
| Static => SIZE_EXPRESSION
SIZE_EXPRESSION ::=
*
| integer_EXPRESSION
Requires the :switch:`-fopenacc` flag.
Equivalent to the ``loop`` directive of the OpenAcc standard. This pragma
should be placed in for loops after the "Acc_Parallel" pragma. It tells the
compiler how to parallelize the loop.
For more information about the effect of the clauses, see the OpenAcc
specification.
Pragma Acc_Kernels
==================
Syntax:
.. code-block:: ada
pragma Acc_Kernels [( ACC_KERNELS_CLAUSE [, ACC_KERNELS_CLAUSE...])];
ACC_KERNELS_CLAUSE ::=
Acc_If => boolean_EXPRESSION
| Async => integer_EXPRESSION
| Copy => IDENTIFIERS
| Copy_In => IDENTIFIERS
| Copy_Out => IDENTIFIERS
| Create => IDENTIFIERS
| Default => None
| Device_Ptr => IDENTIFIERS
| Num_Gangs => integer_EXPRESSION
| Num_Workers => integer_EXPRESSION
| Present => IDENTIFIERS
| Vector_Length => integer_EXPRESSION
| Wait => INTEGERS
IDENTIFIERS ::=
| IDENTIFIER
| (IDENTIFIER, IDENTIFIERS)
INTEGERS ::=
| integer_EXPRESSION
| (integer_EXPRESSION, INTEGERS)
Requires the :switch:`-fopenacc` flag.
Equivalent to the kernels directive of the OpenAcc standard. This pragma should
be placed in loops.
For more information about the effect of the clauses, see the OpenAcc
specification.
Pragma Acc_Data
===============
Syntax:
.. code-block:: ada
pragma Acc_Data ([ ACC_DATA_CLAUSE [, ACC_DATA_CLAUSE...]]);
ACC_DATA_CLAUSE ::=
Copy => IDENTIFIERS
| Copy_In => IDENTIFIERS
| Copy_Out => IDENTIFIERS
| Create => IDENTIFIERS
| Device_Ptr => IDENTIFIERS
| Present => IDENTIFIERS
Requires the :switch:`-fopenacc` flag.
Equivalent to the ``data`` directive of the OpenAcc standard. This pragma
should be placed in loops.
For more information about the effect of the clauses, see the OpenAcc
specification.
Pragma Ada_83
=============

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

@ -104,8 +104,4 @@ 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

@ -164,7 +164,6 @@ 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:

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

@ -1336,234 +1336,6 @@ 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)
{
const enum gomp_map_kind kind = *((enum gomp_map_kind*) data);
tree 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)
{
const enum omp_clause_code kind = *((enum omp_clause_code*) data);
tree 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)
{
const tree_code code = *((tree_code*) data);
tree 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
= build_omp_clause (EXPR_LOCATION (gnu_loop_stack->last ()->stmt),
OMP_CLAUSE_TILE);
tree 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. */
@ -1635,279 +1407,6 @@ Pragma_to_gnu (Node_Id gnat_node)
}
break;
case Pragma_Acc_Loop:
{
if (!flag_openacc)
break;
tree gnu_clauses = gnu_loop_stack->last ()->omp_loop_clauses;
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 (id == Pragma_Acc_Data)
gnu_loop_stack->last ()->omp_code = OACC_DATA;
else if (id == Pragma_Acc_Kernels)
gnu_loop_stack->last ()->omp_code = OACC_KERNELS;
else if (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);
@ -3462,148 +2961,6 @@ independent_iterations_p (tree stmt_list)
return true;
}
/* 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
Acc_Loop_to_gnu (Node_Id gnat_loop)
{
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 acc_bind_expr;
}
/* 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.
@ -4003,34 +3360,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
gnu_loop_info->stmt = gnu_loop_stmt;
/* 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;
}
gnu_loop_stmt = Regular_Loop_to_gnu (gnat_node, &gnu_cond_expr);
/* 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. */

1839
gcc/ada/gnat_rm.texi
View File

File diff suppressed because it is too large Load Diff

5
gcc/ada/opt.ads
View File

@ -1253,11 +1253,6 @@ package Opt is
-- cannot be simultaneous compilations with the object files in the same
-- object directory, if project files are used.
OpenAcc_Enabled : Boolean := False;
-- GNAT
-- Indicates whether OpenAcc pragmas should be taken into account. Set to
-- True by the use of -fopenacc.
type Operating_Mode_Type is (Check_Syntax, Check_Semantics, Generate_Code);
pragma Ordered (Operating_Mode_Type);
Operating_Mode : Operating_Mode_Type := Generate_Code;

4
gcc/ada/par-prag.adb
View File

@ -1315,10 +1315,6 @@ begin
when Pragma_Abort_Defer
| Pragma_Abstract_State
| Pragma_Acc_Data
| Pragma_Acc_Kernels
| Pragma_Acc_Loop
| Pragma_Acc_Parallel
| Pragma_Aggregate_Individually_Assign
| Pragma_Async_Readers
| Pragma_Async_Writers

32
gcc/ada/sem_ch5.adb
View File

@ -3388,13 +3388,6 @@ package body Sem_Ch5 is
-- The following exception is raised by routine Prepare_Loop_Statement
-- to avoid further analysis of a transformed loop.
function Disable_Constant (N : Node_Id) return Traverse_Result;
-- If N represents an E_Variable entity, set Is_True_Constant To False
procedure Disable_Constants is new Traverse_Proc (Disable_Constant);
-- Helper for Analyze_Loop_Statement, to unset Is_True_Constant on
-- variables referenced within an OpenACC construct.
procedure Prepare_Loop_Statement
(Iter : Node_Id;
Stop_Processing : out Boolean);
@ -3402,22 +3395,6 @@ package body Sem_Ch5 is
-- transformed prior to analysis, and if so, perform it.
-- If Stop_Processing is set to True, should stop further processing.
----------------------
-- Disable_Constant --
----------------------
function Disable_Constant (N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Ekind (Entity (N)) = E_Variable
then
Set_Is_True_Constant (Entity (N), False);
end if;
return OK;
end Disable_Constant;
----------------------------
-- Prepare_Loop_Statement --
----------------------------
@ -4035,15 +4012,6 @@ package body Sem_Ch5 is
if No (Iter) and then not Has_Exit (Ent) then
Check_Unreachable_Code (Stmt);
end if;
-- Variables referenced within a loop subject to possible OpenACC
-- offloading may be implicitly written to as part of the OpenACC
-- transaction. Clear flags possibly conveying that they are constant,
-- set for example when the code does not explicitly assign them.
if Is_OpenAcc_Environment (Stmt) then
Disable_Constants (Stmt);
end if;
end Analyze_Loop_Statement;
----------------------------

695
gcc/ada/sem_prag.adb
View File

@ -3787,12 +3787,6 @@ package body Sem_Prag is
-- Local Subprograms --
-----------------------
function Acc_First (N : Node_Id) return Node_Id;
-- Helper function to iterate over arguments given to OpenAcc pragmas
function Acc_Next (N : Node_Id) return Node_Id;
-- Helper function to iterate over arguments given to OpenAcc pragmas
procedure Ada_2005_Pragma;
-- Called for pragmas defined in Ada 2005, that are not in Ada 95. In
-- Ada 95 mode, these are implementation defined pragmas, so should be
@ -4340,89 +4334,6 @@ package body Sem_Prag is
-- which is used for error messages on any constructs violating the
-- profile.
procedure Validate_Acc_Condition_Clause (Clause : Node_Id);
-- Make sure the argument of a given Acc_If clause is a Boolean
procedure Validate_Acc_Data_Clause (Clause : Node_Id);
-- Make sure the argument of an OpenAcc data clause (e.g. Copy, Copyin,
-- Copyout...) is an identifier or an aggregate of identifiers.
procedure Validate_Acc_Int_Expr_Clause (Clause : Node_Id);
-- Make sure the argument of an OpenAcc clause is an Integer expression
procedure Validate_Acc_Int_Expr_List_Clause (Clause : Node_Id);
-- Make sure the argument of an OpenAcc clause is an Integer expression
-- or a list of Integer expressions.
procedure Validate_Acc_Loop_Collapse (Clause : Node_Id);
-- Make sure that the parent loop of the Acc_Loop(Collapse => N) pragma
-- contains at least N-1 nested loops.
procedure Validate_Acc_Loop_Gang (Clause : Node_Id);
-- Make sure the argument of the Gang clause of a Loop directive is
-- either an integer expression or a (Static => integer expressions)
-- aggregate.
procedure Validate_Acc_Loop_Vector (Clause : Node_Id);
-- When this procedure is called in a construct offloaded by an
-- Acc_Kernels pragma, makes sure that a Vector_Length clause does
-- not exist on said pragma. In all cases, make sure the argument
-- is an Integer expression.
procedure Validate_Acc_Loop_Worker (Clause : Node_Id);
-- When this procedure is called in a construct offloaded by an
-- Acc_Parallel pragma, makes sure that no argument has been given.
-- When this procedure is called in a construct offloaded by an
-- Acc_Kernels pragma and if Loop_Worker was given an argument,
-- makes sure that the Num_Workers clause does not appear on the
-- Acc_Kernels pragma and that the argument is an integer.
procedure Validate_Acc_Name_Reduction (Clause : Node_Id);
-- Make sure the reduction clause is an aggregate made of a string
-- representing a supported reduction operation (i.e. "+", "*", "and",
-- "or", "min" or "max") and either an identifier or aggregate of
-- identifiers.
procedure Validate_Acc_Size_Expressions (Clause : Node_Id);
-- Makes sure that Clause is either an integer expression or an
-- association with a Static as name and a list of integer expressions
-- or "*" strings on the right hand side.
---------------
-- Acc_First --
---------------
function Acc_First (N : Node_Id) return Node_Id is
begin
if Nkind (N) = N_Aggregate then
if Present (Expressions (N)) then
return First (Expressions (N));
elsif Present (Component_Associations (N)) then
return Expression (First (Component_Associations (N)));
end if;
end if;
return N;
end Acc_First;
--------------
-- Acc_Next --
--------------
function Acc_Next (N : Node_Id) return Node_Id is
begin
if Nkind (Parent (N)) = N_Component_Association then
return Expression (Next (Parent (N)));
elsif Nkind (Parent (N)) = N_Aggregate then
return Next (N);
else
return Empty;
end if;
end Acc_Next;
---------------------
-- Ada_2005_Pragma --
---------------------
@ -11419,308 +11330,6 @@ package body Sem_Prag is
end if;
end Set_Ravenscar_Profile;
-----------------------------------
-- Validate_Acc_Condition_Clause --
-----------------------------------
procedure Validate_Acc_Condition_Clause (Clause : Node_Id) is
begin
Analyze_And_Resolve (Clause);
if not Is_Boolean_Type (Etype (Clause)) then
Error_Pragma ("expected a boolean");
end if;
end Validate_Acc_Condition_Clause;
------------------------------
-- Validate_Acc_Data_Clause --
------------------------------
procedure Validate_Acc_Data_Clause (Clause : Node_Id) is
Expr : Node_Id;
begin
Expr := Acc_First (Clause);
while Present (Expr) loop
if Nkind (Expr) /= N_Identifier then
Error_Pragma ("expected an identifer");
end if;
Analyze_And_Resolve (Expr);
Expr := Acc_Next (Expr);
end loop;
end Validate_Acc_Data_Clause;
----------------------------------
-- Validate_Acc_Int_Expr_Clause --
----------------------------------
procedure Validate_Acc_Int_Expr_Clause (Clause : Node_Id) is
begin
Analyze_And_Resolve (Clause);
if not Is_Integer_Type (Etype (Clause)) then
Error_Pragma_Arg ("expected an integer", Clause);
end if;
end Validate_Acc_Int_Expr_Clause;
---------------------------------------
-- Validate_Acc_Int_Expr_List_Clause --
---------------------------------------
procedure Validate_Acc_Int_Expr_List_Clause (Clause : Node_Id) is
Expr : Node_Id;
begin
Expr := Acc_First (Clause);
while Present (Expr) loop
Analyze_And_Resolve (Expr);
if not Is_Integer_Type (Etype (Expr)) then
Error_Pragma ("expected an integer");
end if;
Expr := Acc_Next (Expr);
end loop;
end Validate_Acc_Int_Expr_List_Clause;
--------------------------------
-- Validate_Acc_Loop_Collapse --
--------------------------------
procedure Validate_Acc_Loop_Collapse (Clause : Node_Id) is
Count : Uint;
Par_Loop : Node_Id;
Stmt : Node_Id;
begin
-- Make sure the argument is a positive integer
Analyze_And_Resolve (Clause);
Count := Static_Integer (Clause);
if Count = No_Uint or else Count < 1 then
Error_Pragma_Arg ("expected a positive integer", Clause);
end if;
-- Then, make sure we have at least Count-1 tightly-nested loops
-- (i.e. loops with no statements in between).
Par_Loop := Parent (Parent (Parent (Clause)));
Stmt := First (Statements (Par_Loop));
-- Skip first pragmas in the parent loop
while Present (Stmt) and then Nkind (Stmt) = N_Pragma loop
Next (Stmt);
end loop;
if not Present (Next (Stmt)) then
while Nkind (Stmt) = N_Loop_Statement and Count > 1 loop
Stmt := First (Statements (Stmt));
exit when Present (Next (Stmt));
Count := Count - 1;
end loop;
end if;
if Count > 1 then
Error_Pragma_Arg
("Collapse argument too high or loops not tightly nested",
Clause);
end if;
end Validate_Acc_Loop_Collapse;
----------------------------
-- Validate_Acc_Loop_Gang --
----------------------------
procedure Validate_Acc_Loop_Gang (Clause : Node_Id) is
begin
Error_Pragma_Arg ("Loop_Gang not implemented", Clause);
end Validate_Acc_Loop_Gang;
------------------------------
-- Validate_Acc_Loop_Vector --
------------------------------
procedure Validate_Acc_Loop_Vector (Clause : Node_Id) is
begin
Error_Pragma_Arg ("Loop_Vector not implemented", Clause);
end Validate_Acc_Loop_Vector;
-------------------------------
-- Validate_Acc_Loop_Worker --
-------------------------------
procedure Validate_Acc_Loop_Worker (Clause : Node_Id) is
begin
Error_Pragma_Arg ("Loop_Worker not implemented", Clause);
end Validate_Acc_Loop_Worker;
---------------------------------
-- Validate_Acc_Name_Reduction --
---------------------------------
procedure Validate_Acc_Name_Reduction (Clause : Node_Id) is
-- ??? On top of the following operations, the OpenAcc spec adds the
-- "bitwise and", "bitwise or" and modulo for C and ".eqv" and
-- ".neqv" for Fortran. Can we, should we and how do we support them
-- in Ada?
type Reduction_Op is (Add_Op, Mul_Op, Max_Op, Min_Op, And_Op, Or_Op);
function To_Reduction_Op (Op : String) return Reduction_Op;
-- Convert operator Op described by a String into its corresponding
-- enumeration value.
---------------------
-- To_Reduction_Op --
---------------------
function To_Reduction_Op (Op : String) return Reduction_Op is
begin
if Op = "+" then
return Add_Op;
elsif Op = "*" then
return Mul_Op;
elsif Op = "max" then
return Max_Op;
elsif Op = "min" then
return Min_Op;
elsif Op = "and" then
return And_Op;
elsif Op = "or" then
return Or_Op;
else
Error_Pragma ("unsuported reduction operation");
end if;
end To_Reduction_Op;
-- Local variables
Seen : constant Elist_Id := New_Elmt_List;
Expr : Node_Id;
Reduc_Op : Node_Id;
Reduc_Var : Node_Id;
-- Start of processing for Validate_Acc_Name_Reduction
begin
-- Reduction operations appear in the following form:
-- ("+" => (a, b), "*" => c)
Expr := First (Component_Associations (Clause));
while Present (Expr) loop
Reduc_Op := First (Choices (Expr));
String_To_Name_Buffer (Strval (Reduc_Op));
case To_Reduction_Op (Name_Buffer (1 .. Name_Len)) is
when Add_Op
| Mul_Op
| Max_Op
| Min_Op
=>
Reduc_Var := Acc_First (Expression (Expr));
while Present (Reduc_Var) loop
Analyze_And_Resolve (Reduc_Var);
if Contains (Seen, Entity (Reduc_Var)) then
Error_Pragma ("variable used in multiple reductions");
else
if Nkind (Reduc_Var) /= N_Identifier
or not Is_Numeric_Type (Etype (Reduc_Var))
then
Error_Pragma
("expected an identifier for a Numeric");
end if;
Append_Elmt (Entity (Reduc_Var), Seen);
end if;
Reduc_Var := Acc_Next (Reduc_Var);
end loop;
when And_Op
| Or_Op
=>
Reduc_Var := Acc_First (Expression (Expr));
while Present (Reduc_Var) loop
Analyze_And_Resolve (Reduc_Var);
if Contains (Seen, Entity (Reduc_Var)) then
Error_Pragma ("variable used in multiple reductions");
else
if Nkind (Reduc_Var) /= N_Identifier
or not Is_Boolean_Type (Etype (Reduc_Var))
then
Error_Pragma
("expected a variable of type boolean");
end if;
Append_Elmt (Entity (Reduc_Var), Seen);
end if;
Reduc_Var := Acc_Next (Reduc_Var);
end loop;
end case;
Next (Expr);
end loop;
end Validate_Acc_Name_Reduction;
-----------------------------------
-- Validate_Acc_Size_Expressions --
-----------------------------------
procedure Validate_Acc_Size_Expressions (Clause : Node_Id) is
function Validate_Size_Expr (Expr : Node_Id) return Boolean;
-- A size expr is either an integer expression or "*"
------------------------
-- Validate_Size_Expr --
------------------------
function Validate_Size_Expr (Expr : Node_Id) return Boolean is
begin
if Nkind (Expr) = N_Operator_Symbol then
return Get_String_Char (Strval (Expr), 1) = Get_Char_Code ('*');
end if;
Analyze_And_Resolve (Expr);
return Is_Integer_Type (Etype (Expr));
end Validate_Size_Expr;
-- Local variables
Expr : Node_Id;
-- Start of processing for Validate_Acc_Size_Expressions
begin
Expr := Acc_First (Clause);
while Present (Expr) loop
if not Validate_Size_Expr (Expr) then
Error_Pragma
("Size expressions should be either integers or '*'");
end if;
Expr := Acc_Next (Expr);
end loop;
end Validate_Acc_Size_Expressions;
-- Start of processing for Analyze_Pragma
begin
@ -12664,306 +12273,6 @@ package body Sem_Prag is
Analyze_If_Present (Pragma_Initial_Condition);
end Abstract_State;
--------------
-- Acc_Data --
--------------
when Pragma_Acc_Data => Acc_Data : declare
Clause_Names : constant Name_List :=
(Name_Attach,
Name_Copy,
Name_Copy_In,
Name_Copy_Out,
Name_Create,
Name_Delete,
Name_Detach,
Name_Device_Ptr,
Name_No_Create,
Name_Present);
Clause : Node_Id;
Clauses : Args_List (Clause_Names'Range);
begin
if not OpenAcc_Enabled then
return;
end if;
GNAT_Pragma;
if Nkind (Parent (N)) /= N_Loop_Statement then
Error_Pragma
("Acc_Data pragma should be placed in loop or block "
& "statements");
end if;
Gather_Associations (Clause_Names, Clauses);
for Id in Clause_Names'First .. Clause_Names'Last loop
Clause := Clauses (Id);
if Present (Clause) then
case Clause_Names (Id) is
when Name_Copy
| Name_Copy_In
| Name_Copy_Out
| Name_Create
| Name_Device_Ptr
| Name_Present
=>
Validate_Acc_Data_Clause (Clause);
when Name_Attach
| Name_Detach
| Name_Delete
| Name_No_Create
=>
Error_Pragma ("unsupported pragma clause");
when others =>
raise Program_Error;
end case;
end if;
end loop;
Set_Is_OpenAcc_Environment (Parent (N));
end Acc_Data;
--------------
-- Acc_Loop --
--------------
when Pragma_Acc_Loop => Acc_Loop : declare
Clause_Names : constant Name_List :=
(Name_Auto,
Name_Collapse,
Name_Gang,
Name_Independent,
Name_Acc_Private,
Name_Reduction,
Name_Seq,
Name_Tile,
Name_Vector,
Name_Worker);
Clause : Node_Id;
Clauses : Args_List (Clause_Names'Range);
Par : Node_Id;
begin
if not OpenAcc_Enabled then
return;
end if;
GNAT_Pragma;
-- Make sure the pragma is in an openacc construct
Check_Loop_Pragma_Placement;
Par := Parent (N);
while Present (Par)
and then (Nkind (Par) /= N_Loop_Statement
or else not Is_OpenAcc_Environment (Par))
loop
Par := Parent (Par);
end loop;
if not Is_OpenAcc_Environment (Par) then
Error_Pragma
("Acc_Loop directive must be associated with an OpenAcc "
& "construct region");
end if;
Gather_Associations (Clause_Names, Clauses);
for Id in Clause_Names'First .. Clause_Names'Last loop
Clause := Clauses (Id);
if Present (Clause) then
case Clause_Names (Id) is
when Name_Auto
| Name_Independent
| Name_Seq
=>
null;
when Name_Collapse =>
Validate_Acc_Loop_Collapse (Clause);
when Name_Gang =>
Validate_Acc_Loop_Gang (Clause);
when Name_Acc_Private =>
Validate_Acc_Data_Clause (Clause);
when Name_Reduction =>
Validate_Acc_Name_Reduction (Clause);
when Name_Tile =>
Validate_Acc_Size_Expressions (Clause);
when Name_Vector =>
Validate_Acc_Loop_Vector (Clause);
when Name_Worker =>
Validate_Acc_Loop_Worker (Clause);
when others =>
raise Program_Error;
end case;
end if;
end loop;
Set_Is_OpenAcc_Loop (Parent (N));
end Acc_Loop;
----------------------------------
-- Acc_Parallel and Acc_Kernels --
----------------------------------
when Pragma_Acc_Parallel
| Pragma_Acc_Kernels
=>
Acc_Kernels_Or_Parallel : declare
Clause_Names : constant Name_List :=
(Name_Acc_If,
Name_Async,
Name_Copy,
Name_Copy_In,
Name_Copy_Out,
Name_Create,
Name_Default,
Name_Device_Ptr,
Name_Device_Type,
Name_Num_Gangs,
Name_Num_Workers,
Name_Present,
Name_Vector_Length,
Name_Wait,
-- Parallel only
Name_Acc_Private,
Name_First_Private,
Name_Reduction,
-- Kernels only
Name_Attach,
Name_No_Create);
Clause : Node_Id;
Clauses : Args_List (Clause_Names'Range);
begin
if not OpenAcc_Enabled then
return;
end if;
GNAT_Pragma;
Check_Loop_Pragma_Placement;
if Nkind (Parent (N)) /= N_Loop_Statement then
Error_Pragma
("pragma should be placed in loop or block statements");
end if;
Gather_Associations (Clause_Names, Clauses);
for Id in Clause_Names'First .. Clause_Names'Last loop
Clause := Clauses (Id);
if Present (Clause) then
if Chars (Parent (Clause)) = No_Name then
Error_Pragma ("all arguments should be associations");
else
case Clause_Names (Id) is
-- Note: According to the OpenAcc Standard v2.6,
-- Async's argument should be optional. Because this
-- complicates parsing the clause, the argument is
-- made mandatory. The standard defines two negative
-- values, acc_async_noval and acc_async_sync. When
-- given acc_async_noval as value, the clause should
-- behave as if no argument was given. According to
-- the standard, acc_async_noval is defined in header
-- files for C and Fortran, thus this value should
-- probably be defined in the OpenAcc Ada library once
-- it is implemented.
when Name_Async
| Name_Num_Gangs
| Name_Num_Workers
| Name_Vector_Length
=>
Validate_Acc_Int_Expr_Clause (Clause);
when Name_Acc_If =>
Validate_Acc_Condition_Clause (Clause);
-- Unsupported by GCC
when Name_Attach
| Name_No_Create
=>
Error_Pragma ("unsupported clause");
when Name_Acc_Private
| Name_First_Private
=>
if Prag_Id /= Pragma_Acc_Parallel then
Error_Pragma
("argument is only available for 'Parallel' "
& "construct");
else
Validate_Acc_Data_Clause (Clause);
end if;
when Name_Copy
| Name_Copy_In
| Name_Copy_Out
| Name_Create
| Name_Device_Ptr
| Name_Present
=>
Validate_Acc_Data_Clause (Clause);
when Name_Reduction =>
if Prag_Id /= Pragma_Acc_Parallel then
Error_Pragma
("argument is only available for 'Parallel' "
& "construct");
else
Validate_Acc_Name_Reduction (Clause);
end if;
when Name_Default =>
if Chars (Clause) /= Name_None then
Error_Pragma ("expected none");
end if;
when Name_Device_Type =>
Error_Pragma ("unsupported pragma clause");
-- Similar to Name_Async, Name_Wait's arguments should
-- be optional. However, this can be simulated using
-- acc_async_noval, hence, we do not bother making the
-- argument optional for now.
when Name_Wait =>
Validate_Acc_Int_Expr_List_Clause (Clause);
when others =>
raise Program_Error;
end case;
end if;
end if;
end loop;
Set_Is_OpenAcc_Environment (Parent (N));
end Acc_Kernels_Or_Parallel;
------------
-- Ada_83 --
------------
@ -31173,10 +30482,6 @@ package body Sem_Prag is
Sig_Flags : constant array (Pragma_Id) of Int :=
(Pragma_Abort_Defer => -1,
Pragma_Abstract_State => -1,
Pragma_Acc_Data => 0,
Pragma_Acc_Kernels => 0,
Pragma_Acc_Loop => 0,
Pragma_Acc_Parallel => 0,
Pragma_Ada_83 => -1,
Pragma_Ada_95 => -1,
Pragma_Ada_05 => -1,

32
gcc/ada/sinfo.adb
View File

@ -2089,22 +2089,6 @@ package body Sinfo is
return Flag16 (N);
end Is_Null_Loop;
function Is_OpenAcc_Environment
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Loop_Statement);
return Flag13 (N);
end Is_OpenAcc_Environment;
function Is_OpenAcc_Loop
(N : Node_Id) return Boolean is
begin
pragma Assert (False
or else NT (N).Nkind = N_Loop_Statement);
return Flag14 (N);
end Is_OpenAcc_Loop;
function Is_Overloaded
(N : Node_Id) return Boolean is
begin
@ -5581,22 +5565,6 @@ package body Sinfo is
Set_Flag16 (N, Val);
end Set_Is_Null_Loop;
procedure Set_Is_OpenAcc_Environment
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Loop_Statement);
Set_Flag13 (N, Val);
end Set_Is_OpenAcc_Environment;
procedure Set_Is_OpenAcc_Loop
(N : Node_Id; Val : Boolean := True) is
begin
pragma Assert (False
or else NT (N).Nkind = N_Loop_Statement);
Set_Flag14 (N, Val);
end Set_Is_OpenAcc_Loop;
procedure Set_Is_Overloaded
(N : Node_Id; Val : Boolean := True) is
begin

26
gcc/ada/sinfo.ads
View File

@ -1841,14 +1841,6 @@ package Sinfo is
-- can be determined to be null at compile time. This is used to remove
-- the loop entirely at expansion time.
-- Is_OpenAcc_Environment (Flag13-Sem)
-- This flag is set in an N_Loop_Statement node if it contains an
-- Acc_Data, Acc_Parallel or Add_Kernels pragma.
-- Is_OpenAcc_Loop (Flag14-Sem)
-- This flag is set in an N_Loop_Statement node if it contains an
-- OpenAcc_Loop pragma.
-- Is_Overloaded (Flag5-Sem)
-- A flag present in all expression nodes. Used temporarily during
-- overloading determination. The setting of this flag is not relevant
@ -5054,8 +5046,6 @@ package Sinfo is
-- Iteration_Scheme (Node2) (set to Empty if no iteration scheme)
-- Statements (List3)
-- End_Label (Node4)
-- Is_OpenAcc_Environment (Flag13-Sem)
-- Is_OpenAcc_Loop (Flag14-Sem)
-- Has_Created_Identifier (Flag15)
-- Is_Null_Loop (Flag16)
-- Suppress_Loop_Warnings (Flag17)
@ -9784,12 +9774,6 @@ package Sinfo is
function Is_Null_Loop
(N : Node_Id) return Boolean; -- Flag16
function Is_OpenAcc_Environment
(N : Node_Id) return Boolean; -- Flag13
function Is_OpenAcc_Loop
(N : Node_Id) return Boolean; -- Flag14
function Is_Overloaded
(N : Node_Id) return Boolean; -- Flag5
@ -10896,12 +10880,6 @@ package Sinfo is
procedure Set_Is_Null_Loop
(N : Node_Id; Val : Boolean := True); -- Flag16
procedure Set_Is_OpenAcc_Environment
(N : Node_Id; Val : Boolean := True); -- Flag13
procedure Set_Is_OpenAcc_Loop
(N : Node_Id; Val : Boolean := True); -- Flag14
procedure Set_Is_Overloaded
(N : Node_Id; Val : Boolean := True); -- Flag5
@ -13432,8 +13410,6 @@ package Sinfo is
pragma Inline (Is_Known_Guaranteed_ABE);
pragma Inline (Is_Machine_Number);
pragma Inline (Is_Null_Loop);
pragma Inline (Is_OpenAcc_Environment);
pragma Inline (Is_OpenAcc_Loop);
pragma Inline (Is_Overloaded);
pragma Inline (Is_Power_Of_2_For_Shift);
pragma Inline (Is_Prefixed_Call);
@ -13798,8 +13774,6 @@ package Sinfo is
pragma Inline (Set_Is_Known_Guaranteed_ABE);
pragma Inline (Set_Is_Machine_Number);
pragma Inline (Set_Is_Null_Loop);
pragma Inline (Set_Is_OpenAcc_Environment);
pragma Inline (Set_Is_OpenAcc_Loop);
pragma Inline (Set_Is_Overloaded);
pragma Inline (Set_Is_Power_Of_2_For_Shift);
pragma Inline (Set_Is_Prefixed_Call);

36
gcc/ada/snames.ads-tmpl
View File

@ -486,10 +486,6 @@ package Snames is
Name_Abort_Defer : constant Name_Id := N + $; -- GNAT
Name_Abstract_State : constant Name_Id := N + $; -- GNAT
Name_Acc_Data : constant Name_Id := N + $;
Name_Acc_Kernels : constant Name_Id := N + $;
Name_Acc_Loop : constant Name_Id := N + $;
Name_Acc_Parallel : constant Name_Id := N + $;
Name_All_Calls_Remote : constant Name_Id := N + $;
Name_Assert : constant Name_Id := N + $; -- Ada 05
Name_Assert_And_Cut : constant Name_Id := N + $; -- GNAT
@ -871,35 +867,9 @@ package Snames is
Name_Warn : constant Name_Id := N + $;
Name_Working_Storage : constant Name_Id := N + $;
-- OpenAcc-specific clause names for Parallel, Kernels, Data
-- used by Repinfo JSON I/O
Name_Acc_If : constant Name_Id := N + $;
Name_Acc_Private : constant Name_Id := N + $;
Name_Attach : constant Name_Id := N + $;
Name_Copy_In : constant Name_Id := N + $;
Name_Copy_Out : constant Name_Id := N + $;
Name_Create : constant Name_Id := N + $;
Name_Delete : constant Name_Id := N + $;
Name_Detach : constant Name_Id := N + $;
Name_Device_Ptr : constant Name_Id := N + $;
Name_Device_Type : constant Name_Id := N + $;
Name_First_Private : constant Name_Id := N + $;
Name_No_Create : constant Name_Id := N + $;
Name_Num_Gangs : constant Name_Id := N + $;
Name_Num_Workers : constant Name_Id := N + $;
Name_Present : constant Name_Id := N + $;
Name_Reduction : constant Name_Id := N + $;
Name_Vector_Length : constant Name_Id := N + $;
Name_Wait : constant Name_Id := N + $;
-- Loop
Name_Auto : constant Name_Id := N + $;
Name_Collapse : constant Name_Id := N + $;
Name_Gang : constant Name_Id := N + $;
Name_Seq : constant Name_Id := N + $;
Name_Tile : constant Name_Id := N + $;
Name_Worker : constant Name_Id := N + $;
-- Names of recognized attributes. The entries with the comment "Ada 83"
-- are attributes that are defined in Ada 83, but not in Ada 95. These
@ -1934,10 +1904,6 @@ package Snames is
Pragma_Abort_Defer,
Pragma_Abstract_State,
Pragma_Acc_Data,
Pragma_Acc_Kernels,
Pragma_Acc_Loop,
Pragma_Acc_Parallel,
Pragma_All_Calls_Remote,
Pragma_Assert,
Pragma_Assert_And_Cut,

12
gcc/testsuite/gnat.dg/openacc1.adb
View File

@ -1,12 +0,0 @@
-- { dg-do compile }
procedure OpenAcc1 is
type Integer_Array is array (1 .. 32) of Integer;
Data : Integer_Array;
begin
for i in Data'Range loop
pragma Acc_Parallel;
pragma Acc_Loop(Worker);
Data (i) := i;
end loop;
end;