aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-openmp.c
diff options
context:
space:
mode:
authorTobias Burnus <tobias@codesourcery.com>2021-06-04 12:06:59 +0200
committerTobias Burnus <tobias@codesourcery.com>2021-06-04 12:08:24 +0200
commit178191e1dfafd8db149edcdef7a39e9e2c00f216 (patch)
tree85549e8299e3e53dc2446dcd95ee738945c8ee81 /gcc/fortran/trans-openmp.c
parentb7dd2e4eeb44bc8678ecde8a6c7401de85e63561 (diff)
downloadgcc-178191e1dfafd8db149edcdef7a39e9e2c00f216.zip
gcc-178191e1dfafd8db149edcdef7a39e9e2c00f216.tar.gz
gcc-178191e1dfafd8db149edcdef7a39e9e2c00f216.tar.bz2
Fortran/OpenMP: Add omp loop [PR99928]
PR middle-end/99928 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle bind clause. (show_omp_node): Handle loop directive. * frontend-passes.c (gfc_code_walker): Likewise. * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. (enum gfc_omp_bind_type): New. (gfc_omp_clauses): Use it. (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_teams_loop): New. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. (gfc_match_omp_clauses): Handle it. (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, gfc_match_omp_target_parallel_loop): New. (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, gfc_resolve_omp_directive): Handle omp loop. * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, parse_omp_do, parse_executable): Likewise. (parse_omp_structured_block): Remove ST_ which use parse_omp_do. * resolve.c (gfc_resolve_blocks): Add omp loop. * st.c (gfc_free_statement): Likewise. * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): Handle loop directive. (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate and (in_)reduction for taskloop. * trans.c (trans_code): Handle omp loop directive. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99928-3.f90: Add 'default(none)', following C/C++ version of the patch. * gfortran.dg/gomp/loop-1.f90: New test. * gfortran.dg/gomp/loop-2.f90: New test. * gfortran.dg/gomp/pr99928-1.f90: New test; based on C/C++ test. * gfortran.dg/gomp/pr99928-11.f90: Likewise. * gfortran.dg/gomp/pr99928-2.f90: Likewise. * gfortran.dg/gomp/pr99928-4.f90: Likewise. * gfortran.dg/gomp/pr99928-5.f90: Likewise. * gfortran.dg/gomp/pr99928-6.f90: Likewise. * gfortran.dg/gomp/pr99928-8.f90: Likewise. * gfortran.dg/goacc/omp.f95: Use 'acc kernels loops' instead of 'acc loops' to hide unrelated bug for now. * gfortran.dg/goacc/omp-fixed.f: Likewise
Diffstat (limited to 'gcc/fortran/trans-openmp.c')
-rw-r--r--gcc/fortran/trans-openmp.c117
1 files changed, 99 insertions, 18 deletions
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 2917d3d..1e22cdb 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4195,6 +4195,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
}
}
+ if (clauses->bind != OMP_BIND_UNSET)
+ {
+ c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND);
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ switch (clauses->bind)
+ {
+ case OMP_BIND_TEAMS:
+ OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS;
+ break;
+ case OMP_BIND_PARALLEL:
+ OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL;
+ break;
+ case OMP_BIND_THREAD:
+ OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ }
return nreverse (omp_clauses);
}
@@ -5083,6 +5102,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
+ case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break;
case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break;
case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
default: gcc_unreachable ();
@@ -5343,6 +5363,7 @@ gfc_split_omp_clauses (gfc_code *code,
gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
{
int mask = 0, innermost = 0;
+ bool is_loop = false;
memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
switch (code->op)
{
@@ -5363,6 +5384,7 @@ gfc_split_omp_clauses (gfc_code *code,
innermost = GFC_OMP_SPLIT_SIMD;
break;
case EXEC_OMP_DO:
+ case EXEC_OMP_LOOP:
innermost = GFC_OMP_SPLIT_DO;
break;
case EXEC_OMP_DO_SIMD:
@@ -5373,6 +5395,7 @@ gfc_split_omp_clauses (gfc_code *code,
innermost = GFC_OMP_SPLIT_PARALLEL;
break;
case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_LOOP:
mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
innermost = GFC_OMP_SPLIT_DO;
break;
@@ -5399,6 +5422,7 @@ gfc_split_omp_clauses (gfc_code *code,
innermost = GFC_OMP_SPLIT_PARALLEL;
break;
case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
innermost = GFC_OMP_SPLIT_DO;
break;
@@ -5435,6 +5459,10 @@ gfc_split_omp_clauses (gfc_code *code,
| GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
innermost = GFC_OMP_SPLIT_SIMD;
break;
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
+ innermost = GFC_OMP_SPLIT_DO;
+ break;
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_TASKLOOP:
innermost = GFC_OMP_SPLIT_TASKLOOP;
@@ -5465,6 +5493,10 @@ gfc_split_omp_clauses (gfc_code *code,
mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
innermost = GFC_OMP_SPLIT_SIMD;
break;
+ case EXEC_OMP_TEAMS_LOOP:
+ mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
+ innermost = GFC_OMP_SPLIT_DO;
+ break;
default:
gcc_unreachable ();
}
@@ -5473,6 +5505,18 @@ gfc_split_omp_clauses (gfc_code *code,
clausesa[innermost] = *code->ext.omp_clauses;
return;
}
+ /* Loops are similar to DO but still a bit different. */
+ switch (code->op)
+ {
+ case EXEC_OMP_LOOP:
+ case EXEC_OMP_PARALLEL_LOOP:
+ case EXEC_OMP_TEAMS_LOOP:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ is_loop = true;
+ default:
+ break;
+ }
if (code->ext.omp_clauses != NULL)
{
if (mask & GFC_OMP_MASK_TARGET)
@@ -5540,7 +5584,7 @@ gfc_split_omp_clauses (gfc_code *code,
clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
= code->ext.omp_clauses->if_expr;
}
- if (mask & GFC_OMP_MASK_DO)
+ if ((mask & GFC_OMP_MASK_DO) && !is_loop)
{
/* First the clauses that are unique to some constructs. */
clausesa[GFC_OMP_SPLIT_DO].ordered
@@ -5560,6 +5604,11 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->chunk_size;
clausesa[GFC_OMP_SPLIT_DO].nowait
= code->ext.omp_clauses->nowait;
+ }
+ if (mask & GFC_OMP_MASK_DO)
+ {
+ clausesa[GFC_OMP_SPLIT_DO].bind
+ = code->ext.omp_clauses->bind;
/* Duplicate collapse. */
clausesa[GFC_OMP_SPLIT_DO].collapse
= code->ext.omp_clauses->collapse;
@@ -5621,7 +5670,7 @@ gfc_split_omp_clauses (gfc_code *code,
it is enough to put it on the innermost one. For
!$ omp parallel do put it on parallel though,
as that's what we did for OpenMP 3.1. */
- clausesa[innermost == GFC_OMP_SPLIT_DO
+ clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop
? (int) GFC_OMP_SPLIT_PARALLEL
: innermost].lists[OMP_LIST_PRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
@@ -5637,19 +5686,25 @@ gfc_split_omp_clauses (gfc_code *code,
else if (mask & GFC_OMP_MASK_DISTRIBUTE)
clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+ if (mask & GFC_OMP_MASK_TASKLOOP)
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
if (mask & GFC_OMP_MASK_PARALLEL)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- else if (mask & GFC_OMP_MASK_DO)
+ else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- /* Lastprivate is allowed on distribute, do and simd.
+ /* Lastprivate is allowed on distribute, do, simd, taskloop and loop.
In parallel do{, simd} we actually want to put it on
parallel rather than do. */
if (mask & GFC_OMP_MASK_DISTRIBUTE)
clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- if (mask & GFC_OMP_MASK_PARALLEL)
+ if (mask & GFC_OMP_MASK_TASKLOOP)
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
+ = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+ if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
else if (mask & GFC_OMP_MASK_DO)
@@ -5658,17 +5713,25 @@ gfc_split_omp_clauses (gfc_code *code,
if (mask & GFC_OMP_MASK_SIMD)
clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
= code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- /* Reduction is allowed on simd, do, parallel and teams.
- Duplicate it on all of them, but omit on do if
- parallel is present; additionally, inscan applies to do/simd only. */
+ /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop.
+ Duplicate it on all of them, but
+ - omit on do if parallel is present;
+ - omit on task and parallel if loop is present;
+ additionally, inscan applies to do/simd only. */
for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
{
- if (mask & GFC_OMP_MASK_TEAMS
+ if (mask & GFC_OMP_MASK_TASKLOOP
&& i != OMP_LIST_REDUCTION_INSCAN)
+ clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i]
+ = code->ext.omp_clauses->lists[i];
+ if (mask & GFC_OMP_MASK_TEAMS
+ && i != OMP_LIST_REDUCTION_INSCAN
+ && !is_loop)
clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
= code->ext.omp_clauses->lists[i];
if (mask & GFC_OMP_MASK_PARALLEL
- && i != OMP_LIST_REDUCTION_INSCAN)
+ && i != OMP_LIST_REDUCTION_INSCAN
+ && !is_loop)
clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
= code->ext.omp_clauses->lists[i];
else if (mask & GFC_OMP_MASK_DO)
@@ -5689,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code,
clausesa[innermost].lists[OMP_LIST_LINEAR]
= code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
}
- if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
- == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+ if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+ == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+ && !is_loop)
clausesa[GFC_OMP_SPLIT_DO].nowait = true;
}
@@ -5740,7 +5804,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
}
static tree
-gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
+gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
gfc_omp_clauses *clausesa)
{
stmtblock_t block, *new_pblock = pblock;
@@ -5768,8 +5832,9 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
else
pushlevel ();
}
- stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock,
- &clausesa[GFC_OMP_SPLIT_DO], omp_clauses);
+ stmt = gfc_trans_omp_do (code, is_loop ? EXEC_OMP_LOOP : EXEC_OMP_DO,
+ new_pblock, &clausesa[GFC_OMP_SPLIT_DO],
+ omp_clauses);
if (pblock == NULL)
{
if (TREE_CODE (stmt) != BIND_EXPR)
@@ -6006,7 +6071,7 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
+ stmt = gfc_trans_omp_parallel_do (code, false, &block, clausesa);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
@@ -6083,6 +6148,12 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
&clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
NULL);
break;
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ case EXEC_OMP_TEAMS_LOOP:
+ stmt = gfc_trans_omp_do (code, EXEC_OMP_LOOP, NULL,
+ &clausesa[GFC_OMP_SPLIT_DO],
+ NULL);
+ break;
default:
stmt = gfc_trans_omp_distribute (code, clausesa);
break;
@@ -6140,7 +6211,11 @@ gfc_trans_omp_target (gfc_code *code)
}
break;
case EXEC_OMP_TARGET_PARALLEL_DO:
- stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
+ stmt = gfc_trans_omp_parallel_do (code,
+ (code->op
+ == EXEC_OMP_TARGET_PARALLEL_LOOP),
+ &block, clausesa);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
else
@@ -6611,6 +6686,7 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_depobj (code);
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DO:
+ case EXEC_OMP_LOOP:
case EXEC_OMP_SIMD:
case EXEC_OMP_TASKLOOP:
return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
@@ -6633,7 +6709,9 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_PARALLEL:
return gfc_trans_omp_parallel (code);
case EXEC_OMP_PARALLEL_DO:
- return gfc_trans_omp_parallel_do (code, NULL, NULL);
+ return gfc_trans_omp_parallel_do (code, false, NULL, NULL);
+ case EXEC_OMP_PARALLEL_LOOP:
+ return gfc_trans_omp_parallel_do (code, true, NULL, NULL);
case EXEC_OMP_PARALLEL_DO_SIMD:
return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
case EXEC_OMP_PARALLEL_MASTER:
@@ -6652,12 +6730,14 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_PARALLEL_DO:
case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
case EXEC_OMP_TARGET_SIMD:
case EXEC_OMP_TARGET_TEAMS:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
return gfc_trans_omp_target (code);
case EXEC_OMP_TARGET_DATA:
return gfc_trans_omp_target_data (code);
@@ -6682,6 +6762,7 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TEAMS_LOOP:
return gfc_trans_omp_teams (code, NULL, NULL_TREE);
case EXEC_OMP_WORKSHARE:
return gfc_trans_omp_workshare (code, code->ext.omp_clauses);