This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp4.5] Linear clause modifiers
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org, fortran at gcc dot gnu dot org
- Date: Tue, 24 May 2016 19:56:51 +0200
- Subject: [gomp4.5] Linear clause modifiers
- Authentication-results: sourceware.org; auth=none
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
This patch adds parsing/resolving/translation of linear clause
modifiers, adds support for linear-step that is a uniform dummy argument
and tweaks a couple of further linear clause related things.
Tested on x86_64-linux, committed to gomp-4_5-branch.
2016-05-24 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (enum gfc_omp_linear_op): New.
(struct gfc_omp_namelist): Add u.linear_op field.
* openmp.c (gfc_match_omp_clauses): Add support for parsing
linear clause modifiers.
(resolve_omp_clauses): Diagnose linear clause modifiers when not
in declare simd. Only check for integer type if ref modifier is not
used. Remove diagnostics for required VALUE attribute. Diagnose
VALUE attribute with ref or uval modifiers. Allow non-constant
linear-step, if it is a dummy argument alone and is mentioned in
uniform clause.
* dump-parse-tree.c (show_omp_namelist): Print linear clause
modifiers.
* trans-openmp.c (gfc_trans_omp_clauses): Test declare_simd
instead of block == NULL_TREE. Translate linear clause modifiers
and clause with uniform dummy argument linear-step.
* gfortran.dg/gomp/declare-simd-2.f90: New test.
* gfortran.dg/gomp/linear-1.f90: New test.
--- gcc/fortran/gfortran.h.jj 2016-05-13 12:37:21.000000000 +0200
+++ gcc/fortran/gfortran.h 2016-05-23 17:20:09.508803607 +0200
@@ -1134,6 +1134,14 @@ enum gfc_omp_map_op
OMP_MAP_ALWAYS_TOFROM
};
+enum gfc_omp_linear_op
+{
+ OMP_LINEAR_DEFAULT,
+ OMP_LINEAR_REF,
+ OMP_LINEAR_VAL,
+ OMP_LINEAR_UVAL
+};
+
/* For use in OpenMP clauses in case we need extra information
(aligned clause alignment, linear clause step, etc.). */
@@ -1146,6 +1154,7 @@ typedef struct gfc_omp_namelist
gfc_omp_reduction_op reduction_op;
gfc_omp_depend_op depend_op;
gfc_omp_map_op map_op;
+ gfc_omp_linear_op linear_op;
} u;
struct gfc_omp_namelist_udr *udr;
struct gfc_omp_namelist *next;
--- gcc/fortran/openmp.c.jj 2016-05-16 17:56:25.000000000 +0200
+++ gcc/fortran/openmp.c 2016-05-24 17:40:34.636152910 +0200
@@ -1092,13 +1092,50 @@ gfc_match_omp_clauses (gfc_omp_clauses *
end_colon = false;
head = NULL;
if ((mask & OMP_CLAUSE_LINEAR)
- && gfc_match_omp_variable_list ("linear (",
- &c->lists[OMP_LIST_LINEAR],
- false, &end_colon,
- &head) == MATCH_YES)
+ && gfc_match ("linear (") == MATCH_YES)
{
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
gfc_expr *step = NULL;
+ if (gfc_match_omp_variable_list (" ref (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_REF;
+ else if (gfc_match_omp_variable_list (" val (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_VAL;
+ else if (gfc_match_omp_variable_list (" uval (",
+ &c->lists[OMP_LIST_LINEAR],
+ false, NULL, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_UVAL;
+ else if (gfc_match_omp_variable_list ("",
+ &c->lists[OMP_LIST_LINEAR],
+ false, &end_colon, &head)
+ == MATCH_YES)
+ linear_op = OMP_LINEAR_DEFAULT;
+ else
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ {
+ if (gfc_match (" :") == MATCH_YES)
+ end_colon = true;
+ else if (gfc_match (" )") != MATCH_YES)
+ {
+ gfc_free_omp_namelist (*head);
+ gfc_current_locus = old_loc;
+ *head = NULL;
+ break;
+ }
+ }
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head);
@@ -1114,6 +1151,9 @@ gfc_match_omp_clauses (gfc_omp_clauses *
mpz_set_si (step->value.integer, 1);
}
(*head)->expr = step;
+ if (linear_op != OMP_LINEAR_DEFAULT)
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ n->u.linear_op = linear_op;
continue;
}
if ((mask & OMP_CLAUSE_LINK)
@@ -3641,6 +3681,7 @@ resolve_omp_clauses (gfc_code *code, gfc
int list;
int ifc;
bool if_without_mod = false;
+ gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
@@ -4225,12 +4266,26 @@ resolve_omp_clauses (gfc_code *code, gfc
}
break;
case OMP_LIST_LINEAR:
- if (n->sym->ts.type != BT_INTEGER)
+ if (code
+ && n->u.linear_op != OMP_LINEAR_DEFAULT
+ && n->u.linear_op != linear_op)
+ {
+ gfc_error ("LINEAR clause modifier used on DO or SIMD"
+ " construct at %L", &n->where);
+ linear_op = n->u.linear_op;
+ }
+ else if (n->u.linear_op != OMP_LINEAR_REF
+ && n->sym->ts.type != BT_INTEGER)
gfc_error ("LINEAR variable %qs must be INTEGER "
"at %L", n->sym->name, &n->where);
- else if (!code && !n->sym->attr.value)
- gfc_error ("LINEAR dummy argument %qs must have VALUE "
- "attribute at %L", n->sym->name, &n->where);
+ else if ((n->u.linear_op == OMP_LINEAR_REF
+ || n->u.linear_op == OMP_LINEAR_UVAL)
+ && n->sym->attr.value)
+ gfc_error ("LINEAR dummy argument %qs with VALUE "
+ "attribute with %s modifier at %L",
+ n->sym->name,
+ n->u.linear_op == OMP_LINEAR_REF
+ ? "REF" : "UVAL", &n->where);
else if (n->expr)
{
gfc_expr *expr = n->expr;
@@ -4241,9 +4296,25 @@ resolve_omp_clauses (gfc_code *code, gfc
"a scalar integer linear-step expression",
n->sym->name, &n->where);
else if (!code && expr->expr_type != EXPR_CONSTANT)
- gfc_error ("%qs in LINEAR clause at %L requires "
- "a constant integer linear-step expression",
- n->sym->name, &n->where);
+ {
+ if (expr->expr_type == EXPR_VARIABLE
+ && expr->symtree->n.sym->attr.dummy
+ && expr->symtree->n.sym->ns == ns)
+ {
+ gfc_omp_namelist *n2;
+ for (n2 = omp_clauses->lists[OMP_LIST_UNIFORM];
+ n2; n2 = n2->next)
+ if (n2->sym == expr->symtree->n.sym)
+ break;
+ if (n2)
+ break;
+ }
+ gfc_error ("%qs in LINEAR clause at %L requires "
+ "a constant integer linear-step "
+ "expression or dummy argument "
+ "specified in UNIFORM clause",
+ n->sym->name, &n->where);
+ }
}
break;
/* Workaround for PR middle-end/26316, nothing really needs
--- gcc/fortran/dump-parse-tree.c.jj 2016-05-13 12:32:53.000000000 +0200
+++ gcc/fortran/dump-parse-tree.c 2016-05-23 17:57:14.380835918 +0200
@@ -1061,7 +1061,17 @@ show_omp_namelist (int list_type, gfc_om
case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
default: break;
}
+ else if (list_type == OMP_LIST_LINEAR)
+ switch (n->u.linear_op)
+ {
+ case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
+ case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
+ case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
+ default: break;
+ }
fprintf (dumpfile, "%s", n->sym->name);
+ if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
+ fputc (')', dumpfile);
if (n->expr)
{
fputc (':', dumpfile);
--- gcc/fortran/trans-openmp.c.jj 2016-05-20 16:33:23.000000000 +0200
+++ gcc/fortran/trans-openmp.c 2016-05-24 19:07:23.388872695 +0200
@@ -1828,7 +1828,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
tree alignment_var;
- if (block == NULL)
+ if (declare_simd)
alignment_var = gfc_conv_constant_to_tree (n->expr);
else
{
@@ -1848,6 +1848,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
gfc_expr *last_step_expr = NULL;
tree last_step = NULL_TREE;
+ bool last_step_parm = false;
for (; n != NULL; n = n->next)
{
@@ -1855,6 +1856,7 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
{
last_step_expr = n->expr;
last_step = NULL_TREE;
+ last_step_parm = false;
}
if (n->sym->attr.referenced || declare_simd)
{
@@ -1864,12 +1866,28 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
tree node = build_omp_clause (input_location,
OMP_CLAUSE_LINEAR);
OMP_CLAUSE_DECL (node) = t;
+ omp_clause_linear_kind kind;
+ switch (n->u.linear_op)
+ {
+ case OMP_LINEAR_DEFAULT:
+ kind = OMP_CLAUSE_LINEAR_DEFAULT;
+ break;
+ case OMP_LINEAR_REF:
+ kind = OMP_CLAUSE_LINEAR_REF;
+ break;
+ case OMP_LINEAR_VAL:
+ kind = OMP_CLAUSE_LINEAR_VAL;
+ break;
+ case OMP_LINEAR_UVAL:
+ kind = OMP_CLAUSE_LINEAR_UVAL;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ OMP_CLAUSE_LINEAR_KIND (node) = kind;
if (last_step_expr && last_step == NULL_TREE)
{
- if (block == NULL)
- last_step
- = gfc_conv_constant_to_tree (last_step_expr);
- else
+ if (!declare_simd)
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, last_step_expr);
@@ -1877,10 +1895,27 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
last_step = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
+ else if (last_step_expr->expr_type == EXPR_VARIABLE)
+ {
+ gfc_symbol *s = last_step_expr->symtree->n.sym;
+ last_step = gfc_trans_omp_variable (s, true);
+ last_step_parm = true;
+ }
+ else
+ last_step
+ = gfc_conv_constant_to_tree (last_step_expr);
+ }
+ if (last_step_parm)
+ {
+ OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
+ OMP_CLAUSE_LINEAR_STEP (node) = last_step;
+ }
+ else
+ {
+ tree type = gfc_typenode_for_spec (&n->sym->ts);
+ OMP_CLAUSE_LINEAR_STEP (node)
+ = fold_convert (type, last_step);
}
- OMP_CLAUSE_LINEAR_STEP (node)
- = fold_convert (gfc_typenode_for_spec (&n->sym->ts),
- last_step);
if (n->sym->attr.dimension || n->sym->attr.allocatable)
OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
--- gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90.jj 2016-05-24 17:10:54.191515557 +0200
+++ gcc/testsuite/gfortran.dg/gomp/declare-simd-2.f90 2016-05-24 17:12:18.649406430 +0200
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+function f1 (a, b, c, d, e, f)
+ integer, value :: a, b, c
+ integer :: d, e, f, f1
+!$omp declare simd (f1) uniform(b) linear(c, d) linear(uval(e)) linear(ref(f))
+ a = a + 1
+ b = b + 1
+ c = c + 1
+ d = d + 1
+ e = e + 1
+ f = f + 1
+ f1 = a + b + c + d + e + f
+end function f1
--- gcc/testsuite/gfortran.dg/gomp/linear-1.f90.jj 2016-05-24 16:48:23.876194202 +0200
+++ gcc/testsuite/gfortran.dg/gomp/linear-1.f90 2016-05-24 17:02:29.000000000 +0200
@@ -0,0 +1,58 @@
+subroutine foo (x, y)
+ integer :: i, x, y
+ common /i/ i
+ interface
+ function bar (x, y)
+ integer :: x, y, bar
+ !$omp declare simd (bar) linear (ref (x) : 1) linear (uval (y))
+ end function bar
+ end interface
+ !$omp simd linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (x : y + 1)
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (val (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (ref (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+ !$omp do simd linear (uval (x) : y + 1) ! { dg-error "LINEAR clause modifier used on DO or SIMD construct" }
+ do i = 1, 10
+ x = x + y + 1
+ end do
+end
Jakub